Lionheart008
11-12-2009, 23:06
hi all, dear petr,
here my first tbgl example with new "thinbasic_freeimage.inc" pure :)
anybody else have fun with new freeimage features, test or explore it, if you like it.
my thinbasic example:
' ----------------------------------------------------------------------------
' franks TBGL FreeImage sample with new "thinbasic_freeimage.inc", dez.12,2009
' ----------------------------------------------------------------------------
Uses "TBGL"
#INCLUDE "thinbasic_freeimage.inc"
Begin Const
' -- Scene IDs
%sScene = 1
' -- Entity IDs
%eCamera = 1
%eLight
%eBox
%eBox2
%eBox3
%eBox4
%eBox5
' -- Texture IDs
%tTexture1 = 1
%tTexture2 = 2
%tTexture3 = 3
%tTexture4 = 4
End Const
Function TBMAIN()
Local hWnd As DWord
Local FrameRate As Double
MsgBox 0, "uses => Up, Down, Left, Right, Pageup, Pagedown arrows", %MB_ICONINFORMATION, "..frankos freeimage example"
' -- Create and show window
hWnd = TBGL_CreateWindowEx("frankos tbgl freeImage example - press ESC to quit", 640, 480, 32, %TBGL_WS_WINDOWED Or %TBGL_WS_CLOSEBOX Or %TBGL_WS_MINIMIZEBOX Or %TBGL_WS_MAXIMIZEBOX)
TBGL_ShowWindow
' -- Create scene
TBGL_SceneCreate(%sScene)
' -- Create basic entities
TBGL_EntityCreateCamera(%sScene, %eCamera)
TBGL_EntitySetPos(%sScene, %eCamera, 9, 6, 9)
TBGL_EntitySetTargetPos(%sScene, %eCamera, 0, 0, 0)
' -- Create point light
TBGL_EntityCreateLight(%sScene, %eLight)
TBGL_EntitySetPos(%sScene, %eLight, 15, 10, 5)
' -- Create something to look at
FreeImage_LoadTexture(APP_SourcePath+"Textures\birdara.jpg", %tTexture1, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox, 0, 2, 2, 2, 0, 255, 0, 255)
TBGL_EntitySetPos(%sScene, %eBox, 0, 2, 0)
TBGL_EntitySetTexture(%sScene, %eBox, %tTexture1)
FreeImage_LoadTexture(APP_SourcePath+"Textures\heart.jpg", %tTexture3, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox2, 0, 2, 2, 2, 0, 255, 255, 0)
TBGL_EntitySetPos(%sScene, %eBox2, 3, 1, 2)
TBGL_EntitySetTexture(%sScene, %eBox2, %tTexture3)
FreeImage_LoadTexture(APP_SourcePath+"Textures\birdara.jpg", %tTexture1, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox3, 0, 2, 2, 2, 0, 0, 255, 255)
TBGL_EntitySetPos(%sScene, %eBox3, -5, 0, 1)
TBGL_EntitySetTexture(%sScene, %eBox3, %tTexture1)
FreeImage_LoadTexture(APP_SourcePath+"Textures\leoparden2.jpg", %tTexture4, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox4, 0, 2, 2, 2, 0, 255, 0, 255)
TBGL_EntitySetPos(%sScene, %eBox4, 4, 3, 1)
TBGL_EntitySetTexture(%sScene, %eBox4, %tTexture4)
FreeImage_LoadTexture(APP_SourcePath+"Textures\batmanbatgirl.jpg", %tTexture2, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox5, 0, 10, 1, 10, 0, 255, 255, 155)
TBGL_EntitySetPos(%sScene, %eBox5, 0, -4, 0)
TBGL_EntitySetTexture(%sScene, %eBox5, %tTexture2)
' -- Resets status of all keys
TBGL_ResetKeyState()
' -- Main loop
While TBGL_IsWindow(hWnd)
FrameRate = TBGL_GetFrameRate
TBGL_ClearFrame
TBGL_SceneRender(%sScene)
TBGL_DrawFrame
' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While
If TBGL_GetWindowKeyState(hWnd, %VK_LEFT) Then
TBGL_EntityTurn(%sScene, %eBox, 0,-90/FrameRate, 0)
TBGL_EntityTurn(%sScene, %eBox, 0,0, -90/FrameRate)
TBGL_EntityTurn(%sScene, %eBox2, 0,0, -70/FrameRate)
TBGL_EntityTurn(%sScene, %eBox3, 0,0, -50/FrameRate)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_RIGHT) Then
TBGL_EntityTurn(%sScene, %eBox, 0, 90/FrameRate, 0)
TBGL_EntityTurn(%sScene, %eBox, 0, 0, 90/FrameRate)
TBGL_EntityTurn(%sScene, %eBox2, 0, 0, 70/FrameRate)
TBGL_EntityTurn(%sScene, %eBox3, 0, 0, 50/FrameRate)
TBGL_EntityTurn(%sScene, %eBox5, 0, 0, 40/FrameRate)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_UP) Then
TBGL_EntityPush(%sScene, %eBox2, 0, 5/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox3, 0, 3/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox4, 0, 2/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox5, 0, 3/FrameRate, 0)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_DOWN) Then
TBGL_EntityPush(%sScene, %eBox2, 0, -5/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox3, 0, -3/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox4, 0, -2/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox5, 0, -1/FrameRate, 0)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_PGUP) Then
TBGL_EntityPush(%sScene, %eBox5, 0, 15/FrameRate, 10/FrameRate)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_PGDN) Then
TBGL_EntityPush(%sScene, %eBox5, 0, -15/FrameRate, -10/FrameRate)
End If
Wend
TBGL_DestroyWindow
End Function
Function FreeImage_LoadTexture(TextureFile As String, TextureIndex As Long, TextureFiltering As Long, Optional AnisotropicLevel As Long, TransparentColor As Long)
Local hBitmap As Long
Local iType As Long
Local width, height As Long
iType = FreeImage_GetFileType(TextureFile, 0)
hBitmap = FreeImage_Load(iType, TextureFile)
FreeImage_ConvertTo24Bits(hBitmap)
width = FreeImage_GetWidth(hBitmap)
height = FreeImage_GetHeight(hBitmap)
Dim sBuffer As String = PEEK$(FreeImage_GetBits(hBitmap), width*height*3)
TBGL_MakeTexture sBuffer, %TBGL_DATA_BGR, width, height, TextureIndex, TextureFiltering, AnisotropicLevel, TransparentColor
FreeImage_Unload(hBitmap)
End Function
best regards, frank
here my first tbgl example with new "thinbasic_freeimage.inc" pure :)
anybody else have fun with new freeimage features, test or explore it, if you like it.
my thinbasic example:
' ----------------------------------------------------------------------------
' franks TBGL FreeImage sample with new "thinbasic_freeimage.inc", dez.12,2009
' ----------------------------------------------------------------------------
Uses "TBGL"
#INCLUDE "thinbasic_freeimage.inc"
Begin Const
' -- Scene IDs
%sScene = 1
' -- Entity IDs
%eCamera = 1
%eLight
%eBox
%eBox2
%eBox3
%eBox4
%eBox5
' -- Texture IDs
%tTexture1 = 1
%tTexture2 = 2
%tTexture3 = 3
%tTexture4 = 4
End Const
Function TBMAIN()
Local hWnd As DWord
Local FrameRate As Double
MsgBox 0, "uses => Up, Down, Left, Right, Pageup, Pagedown arrows", %MB_ICONINFORMATION, "..frankos freeimage example"
' -- Create and show window
hWnd = TBGL_CreateWindowEx("frankos tbgl freeImage example - press ESC to quit", 640, 480, 32, %TBGL_WS_WINDOWED Or %TBGL_WS_CLOSEBOX Or %TBGL_WS_MINIMIZEBOX Or %TBGL_WS_MAXIMIZEBOX)
TBGL_ShowWindow
' -- Create scene
TBGL_SceneCreate(%sScene)
' -- Create basic entities
TBGL_EntityCreateCamera(%sScene, %eCamera)
TBGL_EntitySetPos(%sScene, %eCamera, 9, 6, 9)
TBGL_EntitySetTargetPos(%sScene, %eCamera, 0, 0, 0)
' -- Create point light
TBGL_EntityCreateLight(%sScene, %eLight)
TBGL_EntitySetPos(%sScene, %eLight, 15, 10, 5)
' -- Create something to look at
FreeImage_LoadTexture(APP_SourcePath+"Textures\birdara.jpg", %tTexture1, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox, 0, 2, 2, 2, 0, 255, 0, 255)
TBGL_EntitySetPos(%sScene, %eBox, 0, 2, 0)
TBGL_EntitySetTexture(%sScene, %eBox, %tTexture1)
FreeImage_LoadTexture(APP_SourcePath+"Textures\heart.jpg", %tTexture3, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox2, 0, 2, 2, 2, 0, 255, 255, 0)
TBGL_EntitySetPos(%sScene, %eBox2, 3, 1, 2)
TBGL_EntitySetTexture(%sScene, %eBox2, %tTexture3)
FreeImage_LoadTexture(APP_SourcePath+"Textures\birdara.jpg", %tTexture1, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox3, 0, 2, 2, 2, 0, 0, 255, 255)
TBGL_EntitySetPos(%sScene, %eBox3, -5, 0, 1)
TBGL_EntitySetTexture(%sScene, %eBox3, %tTexture1)
FreeImage_LoadTexture(APP_SourcePath+"Textures\leoparden2.jpg", %tTexture4, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox4, 0, 2, 2, 2, 0, 255, 0, 255)
TBGL_EntitySetPos(%sScene, %eBox4, 4, 3, 1)
TBGL_EntitySetTexture(%sScene, %eBox4, %tTexture4)
FreeImage_LoadTexture(APP_SourcePath+"Textures\batmanbatgirl.jpg", %tTexture2, %TBGL_TEX_LINEAR)
TBGL_EntityCreateBox(%sScene, %eBox5, 0, 10, 1, 10, 0, 255, 255, 155)
TBGL_EntitySetPos(%sScene, %eBox5, 0, -4, 0)
TBGL_EntitySetTexture(%sScene, %eBox5, %tTexture2)
' -- Resets status of all keys
TBGL_ResetKeyState()
' -- Main loop
While TBGL_IsWindow(hWnd)
FrameRate = TBGL_GetFrameRate
TBGL_ClearFrame
TBGL_SceneRender(%sScene)
TBGL_DrawFrame
' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While
If TBGL_GetWindowKeyState(hWnd, %VK_LEFT) Then
TBGL_EntityTurn(%sScene, %eBox, 0,-90/FrameRate, 0)
TBGL_EntityTurn(%sScene, %eBox, 0,0, -90/FrameRate)
TBGL_EntityTurn(%sScene, %eBox2, 0,0, -70/FrameRate)
TBGL_EntityTurn(%sScene, %eBox3, 0,0, -50/FrameRate)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_RIGHT) Then
TBGL_EntityTurn(%sScene, %eBox, 0, 90/FrameRate, 0)
TBGL_EntityTurn(%sScene, %eBox, 0, 0, 90/FrameRate)
TBGL_EntityTurn(%sScene, %eBox2, 0, 0, 70/FrameRate)
TBGL_EntityTurn(%sScene, %eBox3, 0, 0, 50/FrameRate)
TBGL_EntityTurn(%sScene, %eBox5, 0, 0, 40/FrameRate)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_UP) Then
TBGL_EntityPush(%sScene, %eBox2, 0, 5/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox3, 0, 3/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox4, 0, 2/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox5, 0, 3/FrameRate, 0)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_DOWN) Then
TBGL_EntityPush(%sScene, %eBox2, 0, -5/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox3, 0, -3/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox4, 0, -2/FrameRate, 0)
TBGL_EntityPush(%sScene, %eBox5, 0, -1/FrameRate, 0)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_PGUP) Then
TBGL_EntityPush(%sScene, %eBox5, 0, 15/FrameRate, 10/FrameRate)
ElseIf TBGL_GetWindowKeyState(hWnd, %VK_PGDN) Then
TBGL_EntityPush(%sScene, %eBox5, 0, -15/FrameRate, -10/FrameRate)
End If
Wend
TBGL_DestroyWindow
End Function
Function FreeImage_LoadTexture(TextureFile As String, TextureIndex As Long, TextureFiltering As Long, Optional AnisotropicLevel As Long, TransparentColor As Long)
Local hBitmap As Long
Local iType As Long
Local width, height As Long
iType = FreeImage_GetFileType(TextureFile, 0)
hBitmap = FreeImage_Load(iType, TextureFile)
FreeImage_ConvertTo24Bits(hBitmap)
width = FreeImage_GetWidth(hBitmap)
height = FreeImage_GetHeight(hBitmap)
Dim sBuffer As String = PEEK$(FreeImage_GetBits(hBitmap), width*height*3)
TBGL_MakeTexture sBuffer, %TBGL_DATA_BGR, width, height, TextureIndex, TextureFiltering, AnisotropicLevel, TransparentColor
FreeImage_Unload(hBitmap)
End Function
best regards, frank