Uses "UI", "TBGL"
'Uses "Console"
' -- Control-Flags, just for me
Const %ME_IsNotDialog = &H00000000
Const %ME_ShowAlways = &H00000001 ' closing this will end program
Const %ME_ShowModeless = &H00000002
Const %ME_ShowModal = &H00000004
' not a ControlID
Const %no_Focus = -1
' -- ID numbers of controls
Begin ControlID
%Screen = 1 ' store desktop-info in here
' - Dialogs
%dlg_Main
%dlg_TBGL
%dlg_Tools
%dlg_HelpAbout
' - Menu on Main-Dialog
%men_Main
%men_FileMenu
%men_FileNew
%men_FileExit
%men_EditMenu
%men_EditCopy
%men_EditCut
%men_EditPaste
%men_ViewMenu
%men_ViewTools
%men_HelpMenu
%men_HelpAbout
' - other common UI-Controls
%status_Main
%canvas_TBGL
' %btn_HelpAboutOK ' no Help-"About..." window yet
%Control_LAST
' - internal controls with special treatment
%tmr_TBGL ' timer applied on TBGL-Dialog
End ControlID
' -- Scene-Entity related ids
Begin Const
' -- Scene IDs
%sScene = 1
' -- Entity IDs
%eCamera = 1
%eLight
%eBox
End Const
' create a type for common control-properties
Type tControl
hndl As DWord
XPos As DWord
YPos As DWord
Width As DWord
Height As DWord
Caption As String
Visible As Boolean
Enabled As Boolean
Checked As Boolean
ME_Flags As Long
WS_Flags As Long
End Type
Dim ctrl(%Control_LAST - 1) As tControl
Dim FocusOnDlg As DWord ' store Hndl of the current focussed Dialog
Dim FocusOnCtrl As DWord ' and current focussed Control (not yet available)
Function TBMain()
If Not meets_requirements() Then End
MENU New Bar To ctrl(%men_Main).hndl
MENU New Popup To ctrl(%men_FileMenu).hndl
MENU Add Popup, ctrl(%men_Main).hndl, _
ctrl(%men_FileMenu).Caption, _
ctrl(%men_FileMenu).hndl, _
%MF_ENABLED
MENU Add String, ctrl(%men_FileMenu).hndl, _
ctrl(%men_FileNew).Caption, _
%men_FileNew, %MF_ENABLED
'seperator
MENU Add String, ctrl(%men_FileMenu).hndl, "-", 0, 0
MENU Add String, ctrl(%men_FileMenu).hndl, _
ctrl(%men_FileExit).Caption, _
%men_FileExit, %MF_ENABLED
MENU New Popup To ctrl(%men_EditMenu).hndl
MENU Add Popup, ctrl(%men_Main).hndl, _
ctrl(%men_EditMenu).Caption, _
ctrl(%men_EditMenu).hndl, %MF_ENABLED
MENU Add String, ctrl(%men_EditMenu).hndl, _
ctrl(%men_EditCopy).Caption, _
%men_EditCopy, %MF_GRAYED
MENU Add String, ctrl(%men_EditMenu).hndl, _
ctrl(%men_EditCut).Caption, _
%men_EditCut, %MF_GRAYED
MENU Add String, ctrl(%men_EditMenu).hndl, _
ctrl(%men_EditPaste).Caption, _
%men_EditPaste, %MF_GRAYED
MENU New Popup To ctrl(%men_ViewMenu).hndl
MENU Add Popup, ctrl(%men_Main).hndl, _
ctrl(%men_ViewMenu).Caption, _
ctrl(%men_ViewMenu).hndl, %MF_ENABLED
MENU Add String, ctrl(%men_ViewMenu).hndl, _
ctrl(%men_ViewTools).Caption, _
%men_ViewTools, %MF_ENABLED
MENU New Popup To ctrl(%men_HelpMenu).hndl
MENU Add Popup, ctrl(%men_Main).hndl, _
ctrl(%men_HelpMenu).Caption, _
ctrl(%men_HelpMenu).hndl, %MF_ENABLED Or %MF_CHECKED
MENU Add String, ctrl(%men_HelpMenu).hndl, _
ctrl(%men_HelpAbout).Caption, _
%men_HelpAbout, %MF_ENABLED
Dialog New Pixels, 0, ctrl(%dlg_Main).Caption, _
ctrl(%dlg_Main).Xpos, ctrl(%dlg_Main).Ypos, _
ctrl(%dlg_Main).Width,ctrl(%dlg_Main).Height, _
ctrl(%dlg_Main).WS_Flags, _
0 To ctrl(%dlg_Main).hndl
MENU Attach ctrl(%men_Main).hndl, ctrl(%dlg_Main).hndl
ctrl(%status_Main).hndl = Control Add Statusbar, _
ctrl(%dlg_Main).hndl, _
%status_Main, "", _
0,0,0, 24, %CCS_BOTTOM, _
%WS_EX_STATICEDGE
Dialog Show Modal ctrl(%dlg_Main).hndl, Call dlgCallbackMain
End Function
CallBack Function dlgCallbackMain()
Select Case CBMSG
Case %WM_INITDIALOG
Dialog New Pixels, ctrl(%dlg_Main).hndl, ctrl(%dlg_TBGL).Caption, _
ctrl(%dlg_TBGL).Xpos, ctrl(%dlg_TBGL).Ypos, _
ctrl(%dlg_TBGL).Width,ctrl(%dlg_TBGL).Height, _
ctrl(%dlg_TBGL).WS_Flags, _
0 To ctrl(%dlg_TBGL).hndl
ctrl(%canvas_TBGL).hndl = Control Add Label, _
ctrl(%dlg_TBGL).hndl, _
%canvas_TBGL, "", _
0, 0, ctrl(%dlg_TBGL).Width, ctrl(%dlg_TBGL).Height
Control Set Color ctrl(%dlg_TBGL).hndl, %canvas_TBGL, %BLACK, %BLACK
Control Set Resize ctrl(%dlg_TBGL).hndl, %canvas_TBGL, 1, 1, 1, 1
Dialog Show Modeless ctrl(%dlg_TBGL).hndl, Call dlgCallbackTBGL
Case %WM_SIZE, %WM_SIZING
Case %WM_TIMER
Case %WM_CLOSE
End
Case %WM_COMMAND
Select Case CBCTL
Case %men_FileExit
End
End Select
End Select
End Function
CallBack Function dlgCallbackTBGL()
Static hCtrl As DWord
Select Case CBMSG
Case %WM_INITDIALOG
Dialog Set Timer CBHNDL, %tmr_TBGL, 16, %NULL
Control Handle CBHNDL, %canvas_TBGL To hCtrl
' -- Init OpenGL
TBGL_BindCanvas(hCtrl)
' -- Create scene
TBGL_SceneCreate(%sScene)
' -- Create basic entities
' -- Create camera to look from 5, 5, 5 to 0, 0, 0
TBGL_EntityCreateCamera(%sScene, %eCamera)
TBGL_EntitySetPos(%sScene, %eCamera, 5, 5, 5)
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
TBGL_EntityCreateBox(%sScene, %eBox, 0, 1, 1, 1, 0, 255, 255, 255)
TBGL_EntitySetPos(%sScene, %eBox, 0, 0, 0)
Case %WM_SIZE, %WM_SIZING
TBGL_UpdateCanvasProportions(hCtrl)
RenderMyImage(hCtrl)
Case %WM_TIMER
RenderMyImage(hCtrl)
Case %WM_CLOSE
End Select
End Function
Function RenderMyImage( hCtrl As DWord )
Static FrameRate As Double
If TBGL_CanvasBound(hCtrl) Then
FrameRate = TBGL_GetFrameRate
TBGL_ClearFrame
TBGL_SceneRender(%sScene)
TBGL_DrawFrame
End If
End Function
Function meets_requirements() As Boolean
' check for available desktop-size
' also apply sizes and captions in advance
' might be done by an extra sub which loads localized strings later
TBGL_GetDesktopInfo _
( ctrl(%Screen).Width, ctrl(%Screen).Height, ctrl(%Screen).WS_Flags )
Select Case ctrl(%Screen).Width
Case > 1024
ctrl(%dlg_TBGL).Width = 1024
Case > 800
ctrl(%dlg_TBGL).Width = 800
Case > 640
ctrl(%dlg_TBGL).Width = 640
Case Else
' PrintL "can not run because screen is not wide enough"
' Console_WaitKey
Return FALSE
End Select
Select Case ctrl(%Screen).Height
Case > 768
ctrl(%dlg_TBGL).Height = 768
Case > 600
ctrl(%dlg_TBGL).Height = 600
Case > 480
ctrl(%dlg_TBGL).Height = 480
Case Else
'PrintL "can not run because screen is not high enough"
'Console_WaitKey
Return FALSE
End Select
If ctrl(%Screen).WS_Flags < 16 Then
'PrintL "can not run because color-depth is too low"
'Console_WaitKey
Return FALSE
EndIf
ctrl(%dlg_Main).XPos = 24
ctrl(%dlg_Main).YPos = 24
ctrl(%dlg_Main).Width = 512
ctrl(%dlg_Main).Height = 56
ctrl(%dlg_Main).Caption = "Main-Menu"
ctrl(%dlg_Main).Visible = TRUE
ctrl(%dlg_Main).ME_Flags = %ME_ShowAlways
ctrl(%dlg_Main).WS_Flags = %WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %WS_CAPTION Or _
%WS_SYSMENU Or %WS_MINIMIZEBOX
ctrl(%dlg_TBGL).XPos = -1
ctrl(%dlg_TBGL).YPos = -1
' width and height are determined above already
ctrl(%dlg_TBGL).Caption = "Render-Window"
ctrl(%dlg_TBGL).Visible = TRUE
ctrl(%dlg_TBGL).ME_Flags = %ME_ShowAlways
ctrl(%dlg_TBGL).WS_Flags = %WS_VISIBLE Or %WS_CHILD Or _
%DS_CENTER Or %DS_CONTROL
ctrl(%dlg_Tools).Xpos = 16
ctrl(%dlg_Tools).Ypos = 128
ctrl(%dlg_Tools).Width = 64
ctrl(%dlg_Tools).Height = 192
ctrl(%dlg_Tools).Caption = "Tools"
ctrl(%dlg_Tools).Visible = TRUE
ctrl(%dlg_Tools).ME_Flags = %ME_ShowModeless
ctrl(%dlg_Tools).WS_Flags = %WS_VISIBLE Or %WS_CHILD Or _
%DS_CONTROL
ctrl(%dlg_HelpAbout).XPos = -1
ctrl(%dlg_HelpAbout).YPos = -1
ctrl(%dlg_HelpAbout).Width = 200
ctrl(%dlg_HelpAbout).Height = 200
ctrl(%dlg_HelpAbout).Caption = "About"
ctrl(%dlg_HelpAbout).Visible = FALSE
ctrl(%dlg_HelpAbout).ME_Flags = %ME_ShowModal
ctrl(%dlg_HelpAbout).WS_Flags = %WS_VISIBLE Or %WS_CHILD Or _
%DS_CONTROL
ctrl(%men_FileMenu).Caption = "&File"
ctrl(%men_FileMenu).Visible = TRUE
ctrl(%men_FileMenu).Enabled = TRUE
ctrl(%men_FileMenu).Checked = FALSE
ctrl(%men_FileNew).Caption = "&New"
ctrl(%men_FileNew).Visible = TRUE
ctrl(%men_FileNew).Enabled = TRUE
ctrl(%men_FileNew).Checked = FALSE
ctrl(%men_FileExit).Caption = "&Exit"
ctrl(%men_FileExit).Visible = TRUE
ctrl(%men_FileExit).Enabled = TRUE
ctrl(%men_FileExit).Checked = FALSE
ctrl(%men_EditMenu).Caption = "&Edit"
ctrl(%men_EditMenu).Visible = TRUE
ctrl(%men_EditMenu).Enabled = TRUE
ctrl(%men_EditMenu).Checked = FALSE
ctrl(%men_EditCopy).Caption = "&Copy"
ctrl(%men_EditCopy).Visible = TRUE
ctrl(%men_EditCopy).Enabled = FALSE
ctrl(%men_EditCopy).Checked = FALSE
ctrl(%men_EditCut).Caption = "Cu&t"
ctrl(%men_EditCut).Visible = TRUE
ctrl(%men_EditCut).Enabled = FALSE
ctrl(%men_EditCut).Checked = FALSE
ctrl(%men_EditPaste).Caption = "&Paste"
ctrl(%men_EditPaste).Visible = TRUE
ctrl(%men_EditPaste).Enabled = FALSE
ctrl(%men_EditPaste).Checked = FALSE
ctrl(%men_ViewMenu).Caption = "&View"
ctrl(%men_ViewMenu).Visible = TRUE
ctrl(%men_ViewMenu).Enabled = TRUE
ctrl(%men_ViewMenu).Checked = FALSE
ctrl(%men_ViewTools).Caption = "&Tools"
ctrl(%men_ViewTools).Visible = TRUE
ctrl(%men_ViewTools).Enabled = TRUE
ctrl(%men_ViewTools).Checked = TRUE
ctrl(%men_HelpMenu).Caption = "&Help"
ctrl(%men_HelpMenu).Visible = TRUE
ctrl(%men_HelpMenu).Enabled = TRUE
ctrl(%men_HelpMenu).Checked = FALSE
ctrl(%men_HelpAbout).Caption = "&About..."
ctrl(%men_HelpAbout).Visible = TRUE
ctrl(%men_HelpAbout).Enabled = TRUE
ctrl(%men_HelpAbout).Checked = TRUE
Return TRUE
End Function
Bookmarks