FreeImage: TBGL example by LionheartLionheart008

[Lionheart008]

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:
[code=thinbasic]' ----------------------------------------------------------------------------
' 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[/code]

best regards, frank