Lionheart008
07-05-2009, 12:42
good morning to the oxygen-tbgl front :)
hi charles, petr, kent, michael, all who are working also with oxygen module...
to learn more about tbgl and oxygen cooperation I have just add a new tbgl button 4 and again some little things to this damned good choosing color example created by oxygen power ...
1) if you like push in every tbgl window (1-4) extra
the "R", "G", "B" Keys to see what happen to the models... ;)
(little hint for eros: I cannot write words like this one as [R],[G], "B",... into this post text box says to me everything is now bold after this "B" put into this =>[] brackets...) ?
2) click "choose color", choose a color you like, close color picker and notice the rgb values of the models are changing... very, very nice one ! :)
ciao, best regards, Lionheart
have fun with it :D
'
'UI CALLBACKS TBGL AND OXYGEN WORKING TOGETHER
'--modified with new tbgl button 4 :) by lionheart, mai 2009
#MINVERSION 1.7.0.0
uses "TBGL", "UI","OXYGEN"
global hCtrl as dword
global ExitProgram as long
global TBGL_TestFunction as string
global hDlg AS DWORD
global lcolor,fr,fg,fb,br,bg,bb as long
fr=128 : fg=258 : fb=228
br=042 : bg=042 : bb=045
' -- ID numbers of controls
Begin Const
%btnClose = 1000
%btnCanvasOn
%btnCanvasOff
%btn_test01
%btn_test02
%btn_test03
%btn_test04
%btn_test05
%btn_ColorPik
%btn_colorPikB
%btn_read
%btn_exec
%txt_box
%gCanvas
%IDC_TIMER = 100
%TIMER_DELAY = 1 ' Timer delay (in milliseconds, not very accurate below about 100)
End Const
'------------------------------------------------------------
' Main function
'------------------------------------------------------------
function TBMAIN() as long
DIALOG New 0, "Callbacks for Colors using Oxygen by Lionheart", 100, 100, 640, 450, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %ws_clipsiblings or %WS_CAPTION OR _
%WS_SYSMENU Or %WS_MINIMIZEBOX or %WS_THICKFRAME, 0 To hDlg
' -- Place controls here
hCtrl = CONTROL ADD label, hDlg, %gCanvas, "This is LABEL control, press ON to use this label as TBGL canvas", 6, 6, 520, 420
control set color hDlg, %gCanvas, %YELLOW, %BLACK
CONTROL ADD BUTTON, hDlg, %btnCanvasOn , "On" , 530, 5, 100, 24,,, call CanvasButton
CONTROL ADD BUTTON, hDlg, %btnCanvasOff , "Off" , 530, 35, 100, 24,,, call CanvasButton
CONTROL ADD BUTTON, hDlg, %btn_test01 , "TBGL Test 1" , 530, 80, 100, 24,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test02 , "TBGL Test 2" , 530, 106, 100, 24,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test03 , "TBGL Test 3" , 530, 130, 100, 24,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test04 , "TBGL Test 4" , 530, 156, 100, 24,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_colorpik , "Choose Color" , 530, 204, 100, 20,,, call cbColorpik
CONTROL ADD BUTTON, hDlg, %btn_colorpikB , "Choose Back Color" , 530, 226, 100, 20,,, call cbColorpikB
dim est as long=%ES_MULTILINE or %WS_HSCROLL or %WS_VSCROLL
dim s as string="; Oxygen Script:"+$crlf+"; Choosing Colors"+$crlf+"; Click GET DATA to read current data"
CONTROL ADD TEXTBOX, hDlg, %txt_box , s , 530, 255, 100, 90,est,', 0
CONTROL ADD BUTTON, hDlg, %btn_read , "Get Data" , 530, 350, 050, 20,,, call cbReado
CONTROL ADD BUTTON, hDlg, %btn_exec , "Exec" , 580, 350, 050, 20,,, call cbExeco
CONTROL ADD BUTTON, hDlg, %btnClose , "Click to close" , 530, 370, 100, 30,,, call CloseButton
' -- Set anchors
CONTROL Set RESIZE hDlg, %btnClose , 0, 1, 0, 1
CONTROL Set RESIZE hDlg, %btnCanvasOn , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btnCanvasOff, 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %gCanvas , 1, 1, 1, 1
CONTROL disable hDlg, %btnCanvasOff
CONTROL disable hDlg, %btn_test01, %btn_test02, %btn_test03, %btn_test04
CONTROL Set RESIZE hDlg, %btn_test01 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test02 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test03 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test04 , 0, 1, 1, 0
dialog set minsize hDlg, 400, 300
TBGL_TestFunction = "Render_01"
DIALOG SHOW MODal hDlg, call DlgProc
End Function
'------------------------------------------------------------
' Callback function for main window
'------------------------------------------------------------
callback function DlgProc() as long
select case cbmsg
case %WM_CREATE
case %WM_INITDIALOG
dialog Set Timer cbhndl, %IDC_TIMER, %TIMER_DELAY
case %WM_SIZE
TBGL_UpdateCanvasProportions(hCtrl)
call TBGL_TestFunction
case %WM_SIZING
TBGL_UpdateCanvasProportions(hCtrl)
call TBGL_TestFunction
case %WM_TIMER
'---Dynamically call a function whose name is composed at run-time
'---In this case function name to be executed is inside TBGL_TestFunction string variable
call TBGL_TestFunction
case %WM_DESTROY
if TBGL_CanvasBound(hCtrl) then TBGL_ReleaseCanvas(hCtrl)
dialog Kill Timer cbhndl, %IDC_TIMER
case %WM_RBUTTONDOWN
end select
end function
'------------------------------------------------------------
' Callback function handling Close button
'------------------------------------------------------------
callback function CloseButton() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then DIALOG End cbhndl
end if
end function
'------------------------------------------------------------
' Callback function handling Canvas activation/deactivation
'------------------------------------------------------------
callback function CanvasButton() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
select case cbctl
case %btnCanvasOn
TBGL_TestFunction = "Render_01"
CONTROL disable cbhndl, %btnCanvasOn
TBGL_BindCanvas(hCtrl)
CONTROL enable cbhndl, %btnCanvasOff, %btn_test02, %btn_test03, %btn_test04
case %btnCanvasOff
CONTROL disable cbhndl, %btnCanvasOff
TBGL_ReleaseCanvas(hCtrl)
CONTROL disable cbhndl, %btn_test01, %btn_test02, %btn_test03, %btn_test04
CONTROL enable cbhndl, %btnCanvasOn
end select
end if
end if
end function
'------------------------------------------------------------
' Callback function handling test type
'------------------------------------------------------------
callback function cbChangeTest() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
select case cbctl
case %btn_test01
CONTROL disable cbhndl, %btn_test01
CONTROL enable cbhndl, %btn_test02, %btn_test03, %btn_test04
TBGL_TestFunction = "Render_01"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test02
CONTROL disable cbhndl, %btn_test02
CONTROL enable cbhndl, %btn_test01, %btn_test03, %btn_test04
TBGL_TestFunction = "Render_02"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test03
CONTROL disable cbhndl, %btn_test03
CONTROL enable cbhndl, %btn_test01, %btn_test02, %btn_test04
TBGL_TestFunction = "Render_03"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test04
CONTROL disable cbhndl, %btn_test04
CONTROL enable cbhndl, %btn_test01, %btn_test02, %btn_test04
TBGL_TestFunction = "Render_04"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test04
CONTROL disable cbhndl, %btn_test04
CONTROL enable cbhndl, %btn_test01, %btn_test02, %btn_test04
end select
end if
end if
end function
'------------------------------------------------------------
' Callback function handling color picker
'------------------------------------------------------------
callback function cbColorpik() as long
dim c as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
c = Dialog_ChooseColor(hDlg, rgb(fr,fg,fb), %CC_RGBINIT OR %CC_FULLOPEN )
if c<>-1 then
lcolor=c
fr =lcolor and 255 : fg=lcolor : fb=lcolor
shift right fg, 8 : fg = fg and 255
shift right fb, 16 : fb = fb and 255
end if
end if
end if
end function
'------------------------------------------------------------
' Callback function handling color picker Background
'------------------------------------------------------------
callback function cbColorpikB() as long
dim c as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
c = Dialog_ChooseColor(hDlg, rgb(br,bg,bb), %CC_RGBINIT OR %CC_FULLOPEN )
if c<>-1 then
lcolor=c
br =lcolor and 255 : bg=lcolor : bb=lcolor
shift right bg, 8 : bg = bg and 255
shift right bb, 16 : bb = bb and 255
end if
end if
end if
end function
'-------------------------------------------------
' Callback function to read in script from textbox
'-------------------------------------------------
callback function cbReado() as long
dim s as string
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
s="; Enter new values literally"+$crlf+_
"; or as Expressions"+$crlf+_
"; then click EXEC"+$crlf+$crlf+_
" fr ="+$tab+str$(fr)+$crlf+_
" fg ="+$tab+str$(fg)+$crlf+_
" fb ="+$tab+str$(fb)+$crlf+_
" br ="+$tab+str$(br)+$crlf+_
" bg ="+$tab+str$(bg)+$crlf+_
" bb ="+$tab+str$(bb)+$crlf
Control_Settext(hDlg, %txt_box,s)
end if
end if
end function
'---------------------------------------------------
' Callback function to compile and execute o2 script
'---------------------------------------------------
callback function cbExeco() as long
dim s as string
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
s=Control_Gettext(hDlg, %txt_box)
s="dim fr at #fr, fg at #fg, fb at #fb, br at #br, bg at #bg, bb at #bb"+$cr+s+"terminate"+$cr
o2_basic s
o2_exec
end if
end if
end function
'------------------------------------------------------------
' TBGL render function 1
'------------------------------------------------------------
function Render_01() as long
static x, y, z as double
Static BoxColor as long
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
TBGL_BackColor br,bg,bb
if tbgl_GetwindowKeyState(hCtrl, %VK_R) then fr=255 : fg=0 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_G) then fr=0 : fg=255 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_B) then fr=0 : fg=0 : fb=255
if tbgl_GetwindowKeyState(hCtrl, %VK_A) then fr=0 : fg=0 : fb=0
TBGL_COLOR fr,fg,fb
TBGL_ClearFrame
tbgl_Camera 0,0,5,0,1,0
tbgl_translate 0,0.25,0
tbgl_Rotate GetTickCount/25,1,1,2
tbgl_Box 1,1.75,1
tbgl_Color fr, fg, 255
tbgl_Rotate GetTickCount/20,-1,2,1
tbgl_Box 0.25,0.45,2.5
tbgl_GetPixelInfo tbgl_MouseGetPosX, tbgl_MouseGetPosy, %TBGL_PINFO_XYZ, x, y, z
tbgl_Translate x,y,z
tbgl_color 255,fg,fb
tbgl_Sphere 0.295
TBGL_DrawFrame
end function
'------------------------------------------------------------
' TBGL render function 2
'------------------------------------------------------------
function Render_02() as long
static i, j as long
TBGL_COLOR 255, 255, 255
TBGL_BackColor br,bg,bb
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
' -- Erases previous frame
tbgl_ClearFrame
' -- Sets camera to look from 3,3,3 to 0,-1,0
tbgl_Camera 3, 3, 3, _
0, 0, 0
' -- All following geometry will be rotated around vector 0,1,0
' -- That is - Y axis
tbgl_Rotate gettickcount/100, 0, 1, 0
' -- Now we will try to render kind of spider
' -- It has ...
' .. One big head
tbgl_Color fr,fg,fb
tbgl_Sphere 0.25
' .. And eight legs
' .. We will draw them each 60°
for i = 0 to 359 step 45
tbgl_PushMatrix
tbgl_Rotate i, 0, 1, 0 ' 60, 120, 180, ...
' -- Legs will raise from bottom of head
tbgl_Translate 0, -0.25, 0
' -- With 3 part tentacle
tbgl_PushMatrix
for j = 1 to 3
tbgl_Color fr/j, fg/j, fb/j
' -- Some harmonic rotations will be provided by Sinus
tbgl_Rotate 70+sin(GetTickCount/1000+i+j)*20, 1, 0, 0
' -- Each tentacle part will be shorter and thinner than that before
tbgl_Cylinder ( 0.1/j, 0.1/(j+1), 1/j )
' -- When drawn, we need to move "cursor" at its end to bind new part
tbgl_Translate 0, 1/j, 0
next
tbgl_PopMatrix
tbgl_PopMatrix
next
if tbgl_GetwindowKeyState(hCtrl, %VK_R) then fr=255 : fg=0 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_G) then fr=0 : fg=255 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_B) then fr=0 : fg=0 : fb=255
if tbgl_GetwindowKeyState(hCtrl, %VK_A) then fr=0 : fg=0 : fb=0
' -- Finishes drawing
tbgl_DrawFrame
end function
'------------------------------------------------------------
' TBGL render function 3
'------------------------------------------------------------
function Render_03() as long
' Rotation Variable
static angle as single
' Timing Variables
static FrameRate as number
TBGL_BackColor br,bg,bb
FrameRate = tbgl_GetFrameRate
tbgl_clearframe ' Clear Screen
tbgl_resetmatrix ' Reset the Current Matrix
tbgl_camera 0, 0, 1, 0, 0, 0 ' Default Camera Position
tbgl_translate 0, 0, -4 ' Move Pyramid to Centre of Screen
tbgl_rotate angle, 0.0, 1.0, 0.0 ' Rotation Setup
drawPyramid()
drawQuads()
tbgl_drawframe ' Swap the Drawing Buffers
angle += sin(timer)+100.0/FrameRate
end function
'------------------------------------------------------------
' TBGL support to render function 3
'------------------------------------------------------------
sub drawPyramid()
tbgl_beginpoly %GL_TRIANGLE_FAN
tbgl_color 40, fg, fb : tbgl_vertex 0.0, 1.5, 0.0
tbgl_color fr, 40, 40 : tbgl_vertex -1.5, -1.5, 1.5
tbgl_color fr, fg, fb : tbgl_vertex 1.5, -1.5, 1.5
tbgl_color 40, 40, fb : tbgl_vertex 1.5, -1.5, -1.5
tbgl_color 40, fg, 40 : tbgl_vertex -1.5, -1.5, -1.5
tbgl_color fr, 40, 40 : tbgl_vertex -1.5, -1.5, 1.5
tbgl_endpoly
tbgl_color fr,fg,fb ' restore controled foreground color
end sub
sub drawQuads()
tbgl_translate 0, -0.25,0
tbgl_rotate 60, 0, 1,0
tbgl_beginpoly %gl_quads
' Front Face
tbgl_Normal 0.0, 0.0, 1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex -1.0, -1.0, 1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex 1.0, -1.0, 1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex 1.0, 1.0, 1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex -1.0, 1.0, 1.0
' Back Face
tbgl_Normal 0.0, 0.0, -1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex -1.0, -1.0, -1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex -1.0, 1.0, -1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex 1.0, 1.0, -1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex 1.0, -1.0, -1.0
' Top Face
tbgl_Normal 0.0, 1.0, 0.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex -1.0, 1.0, -1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex -1.0, 1.0, 1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex 1.0, 1.0, 1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex 1.0, 1.0, -1.0
' Bottom Face
tbgl_Normal 0.0,-1.0, 0.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex -1.0, -1.0, -1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex 1.0, -1.0, -1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex 1.0, -1.0, 1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex -1.0, -1.0, 1.0
' Right face
tbgl_Normal 1.0, 0.0, 0.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex 1.0, -1.0, -1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex 1.0, 1.0, -1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex 1.0, 1.0, 1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex 1.0, -1.0, 1.0
' Left Face
tbgl_Normal -1.0, 0.0, 0.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex -1.0, -1.0, -1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex -1.0, -1.0, 1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex -1.0, 1.0, 1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex -1.0, 1.0, -1.0
tbgl_endpoly
end sub
'--------------------------------
' TBGL render function 4
'--------------------------------
function Render_04() as long
static x, y, z as double
Static BoxColor as long
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
TBGL_BackColor br,bg,bb
if tbgl_GetwindowKeyState(hCtrl, %VK_R) then fr=255 : fg=0 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_G) then fr=0 : fg=255 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_B) then fr=0 : fg=0 : fb=255
if tbgl_GetwindowKeyState(hCtrl, %VK_A) then fr=0 : fg=0 : fb=0
TBGL_COLOR fr,fg,fb
TBGL_ClearFrame
tbgl_Camera 0,0,5,0,1,0
tbgl_translate 0, 1, 0
tbgl_Rotate GetTickCount/25,1,1,2
tbgl_color fr, 255, fb
tbgl_torus 0.2, 1.44
tbgl_Rotate GetTickCount/8,1.25,1,-1
tbgl_rotate 45, 1, 1, 1
tbgl_color 255, fg, fb
tbgl_torus 0.22, 0.6
tbgl_rotate gettickcount/20, 2, 1, 1
tbgl_color fr, 166, fb
tbgl_torus 0.18, 0.9
tbgl_GetPixelInfo tbgl_MouseGetPosX, tbgl_MouseGetPosy, %TBGL_PINFO_XYZ, x, y, z
tbgl_Translate x,y,z
TBGL_DrawFrame
end function
more to come...
hi charles, petr, kent, michael, all who are working also with oxygen module...
to learn more about tbgl and oxygen cooperation I have just add a new tbgl button 4 and again some little things to this damned good choosing color example created by oxygen power ...
1) if you like push in every tbgl window (1-4) extra
the "R", "G", "B" Keys to see what happen to the models... ;)
(little hint for eros: I cannot write words like this one as [R],[G], "B",... into this post text box says to me everything is now bold after this "B" put into this =>[] brackets...) ?
2) click "choose color", choose a color you like, close color picker and notice the rgb values of the models are changing... very, very nice one ! :)
ciao, best regards, Lionheart
have fun with it :D
'
'UI CALLBACKS TBGL AND OXYGEN WORKING TOGETHER
'--modified with new tbgl button 4 :) by lionheart, mai 2009
#MINVERSION 1.7.0.0
uses "TBGL", "UI","OXYGEN"
global hCtrl as dword
global ExitProgram as long
global TBGL_TestFunction as string
global hDlg AS DWORD
global lcolor,fr,fg,fb,br,bg,bb as long
fr=128 : fg=258 : fb=228
br=042 : bg=042 : bb=045
' -- ID numbers of controls
Begin Const
%btnClose = 1000
%btnCanvasOn
%btnCanvasOff
%btn_test01
%btn_test02
%btn_test03
%btn_test04
%btn_test05
%btn_ColorPik
%btn_colorPikB
%btn_read
%btn_exec
%txt_box
%gCanvas
%IDC_TIMER = 100
%TIMER_DELAY = 1 ' Timer delay (in milliseconds, not very accurate below about 100)
End Const
'------------------------------------------------------------
' Main function
'------------------------------------------------------------
function TBMAIN() as long
DIALOG New 0, "Callbacks for Colors using Oxygen by Lionheart", 100, 100, 640, 450, _
%WS_POPUP Or %WS_VISIBLE Or _
%WS_CLIPCHILDREN Or %ws_clipsiblings or %WS_CAPTION OR _
%WS_SYSMENU Or %WS_MINIMIZEBOX or %WS_THICKFRAME, 0 To hDlg
' -- Place controls here
hCtrl = CONTROL ADD label, hDlg, %gCanvas, "This is LABEL control, press ON to use this label as TBGL canvas", 6, 6, 520, 420
control set color hDlg, %gCanvas, %YELLOW, %BLACK
CONTROL ADD BUTTON, hDlg, %btnCanvasOn , "On" , 530, 5, 100, 24,,, call CanvasButton
CONTROL ADD BUTTON, hDlg, %btnCanvasOff , "Off" , 530, 35, 100, 24,,, call CanvasButton
CONTROL ADD BUTTON, hDlg, %btn_test01 , "TBGL Test 1" , 530, 80, 100, 24,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test02 , "TBGL Test 2" , 530, 106, 100, 24,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test03 , "TBGL Test 3" , 530, 130, 100, 24,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_test04 , "TBGL Test 4" , 530, 156, 100, 24,,, call cbChangeTest
CONTROL ADD BUTTON, hDlg, %btn_colorpik , "Choose Color" , 530, 204, 100, 20,,, call cbColorpik
CONTROL ADD BUTTON, hDlg, %btn_colorpikB , "Choose Back Color" , 530, 226, 100, 20,,, call cbColorpikB
dim est as long=%ES_MULTILINE or %WS_HSCROLL or %WS_VSCROLL
dim s as string="; Oxygen Script:"+$crlf+"; Choosing Colors"+$crlf+"; Click GET DATA to read current data"
CONTROL ADD TEXTBOX, hDlg, %txt_box , s , 530, 255, 100, 90,est,', 0
CONTROL ADD BUTTON, hDlg, %btn_read , "Get Data" , 530, 350, 050, 20,,, call cbReado
CONTROL ADD BUTTON, hDlg, %btn_exec , "Exec" , 580, 350, 050, 20,,, call cbExeco
CONTROL ADD BUTTON, hDlg, %btnClose , "Click to close" , 530, 370, 100, 30,,, call CloseButton
' -- Set anchors
CONTROL Set RESIZE hDlg, %btnClose , 0, 1, 0, 1
CONTROL Set RESIZE hDlg, %btnCanvasOn , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btnCanvasOff, 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %gCanvas , 1, 1, 1, 1
CONTROL disable hDlg, %btnCanvasOff
CONTROL disable hDlg, %btn_test01, %btn_test02, %btn_test03, %btn_test04
CONTROL Set RESIZE hDlg, %btn_test01 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test02 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test03 , 0, 1, 1, 0
CONTROL Set RESIZE hDlg, %btn_test04 , 0, 1, 1, 0
dialog set minsize hDlg, 400, 300
TBGL_TestFunction = "Render_01"
DIALOG SHOW MODal hDlg, call DlgProc
End Function
'------------------------------------------------------------
' Callback function for main window
'------------------------------------------------------------
callback function DlgProc() as long
select case cbmsg
case %WM_CREATE
case %WM_INITDIALOG
dialog Set Timer cbhndl, %IDC_TIMER, %TIMER_DELAY
case %WM_SIZE
TBGL_UpdateCanvasProportions(hCtrl)
call TBGL_TestFunction
case %WM_SIZING
TBGL_UpdateCanvasProportions(hCtrl)
call TBGL_TestFunction
case %WM_TIMER
'---Dynamically call a function whose name is composed at run-time
'---In this case function name to be executed is inside TBGL_TestFunction string variable
call TBGL_TestFunction
case %WM_DESTROY
if TBGL_CanvasBound(hCtrl) then TBGL_ReleaseCanvas(hCtrl)
dialog Kill Timer cbhndl, %IDC_TIMER
case %WM_RBUTTONDOWN
end select
end function
'------------------------------------------------------------
' Callback function handling Close button
'------------------------------------------------------------
callback function CloseButton() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then DIALOG End cbhndl
end if
end function
'------------------------------------------------------------
' Callback function handling Canvas activation/deactivation
'------------------------------------------------------------
callback function CanvasButton() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
select case cbctl
case %btnCanvasOn
TBGL_TestFunction = "Render_01"
CONTROL disable cbhndl, %btnCanvasOn
TBGL_BindCanvas(hCtrl)
CONTROL enable cbhndl, %btnCanvasOff, %btn_test02, %btn_test03, %btn_test04
case %btnCanvasOff
CONTROL disable cbhndl, %btnCanvasOff
TBGL_ReleaseCanvas(hCtrl)
CONTROL disable cbhndl, %btn_test01, %btn_test02, %btn_test03, %btn_test04
CONTROL enable cbhndl, %btnCanvasOn
end select
end if
end if
end function
'------------------------------------------------------------
' Callback function handling test type
'------------------------------------------------------------
callback function cbChangeTest() as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
select case cbctl
case %btn_test01
CONTROL disable cbhndl, %btn_test01
CONTROL enable cbhndl, %btn_test02, %btn_test03, %btn_test04
TBGL_TestFunction = "Render_01"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test02
CONTROL disable cbhndl, %btn_test02
CONTROL enable cbhndl, %btn_test01, %btn_test03, %btn_test04
TBGL_TestFunction = "Render_02"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test03
CONTROL disable cbhndl, %btn_test03
CONTROL enable cbhndl, %btn_test01, %btn_test02, %btn_test04
TBGL_TestFunction = "Render_03"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test04
CONTROL disable cbhndl, %btn_test04
CONTROL enable cbhndl, %btn_test01, %btn_test02, %btn_test04
TBGL_TestFunction = "Render_04"
TBGL_ReleaseCanvas(hCtrl)
TBGL_BindCanvas(hCtrl)
case %btn_test04
CONTROL disable cbhndl, %btn_test04
CONTROL enable cbhndl, %btn_test01, %btn_test02, %btn_test04
end select
end if
end if
end function
'------------------------------------------------------------
' Callback function handling color picker
'------------------------------------------------------------
callback function cbColorpik() as long
dim c as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
c = Dialog_ChooseColor(hDlg, rgb(fr,fg,fb), %CC_RGBINIT OR %CC_FULLOPEN )
if c<>-1 then
lcolor=c
fr =lcolor and 255 : fg=lcolor : fb=lcolor
shift right fg, 8 : fg = fg and 255
shift right fb, 16 : fb = fb and 255
end if
end if
end if
end function
'------------------------------------------------------------
' Callback function handling color picker Background
'------------------------------------------------------------
callback function cbColorpikB() as long
dim c as long
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
c = Dialog_ChooseColor(hDlg, rgb(br,bg,bb), %CC_RGBINIT OR %CC_FULLOPEN )
if c<>-1 then
lcolor=c
br =lcolor and 255 : bg=lcolor : bb=lcolor
shift right bg, 8 : bg = bg and 255
shift right bb, 16 : bb = bb and 255
end if
end if
end if
end function
'-------------------------------------------------
' Callback function to read in script from textbox
'-------------------------------------------------
callback function cbReado() as long
dim s as string
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
s="; Enter new values literally"+$crlf+_
"; or as Expressions"+$crlf+_
"; then click EXEC"+$crlf+$crlf+_
" fr ="+$tab+str$(fr)+$crlf+_
" fg ="+$tab+str$(fg)+$crlf+_
" fb ="+$tab+str$(fb)+$crlf+_
" br ="+$tab+str$(br)+$crlf+_
" bg ="+$tab+str$(bg)+$crlf+_
" bb ="+$tab+str$(bb)+$crlf
Control_Settext(hDlg, %txt_box,s)
end if
end if
end function
'---------------------------------------------------
' Callback function to compile and execute o2 script
'---------------------------------------------------
callback function cbExeco() as long
dim s as string
if CBMSG = %WM_COMMAND then
if cbctlmsg = %BN_CLICKED then
s=Control_Gettext(hDlg, %txt_box)
s="dim fr at #fr, fg at #fg, fb at #fb, br at #br, bg at #bg, bb at #bb"+$cr+s+"terminate"+$cr
o2_basic s
o2_exec
end if
end if
end function
'------------------------------------------------------------
' TBGL render function 1
'------------------------------------------------------------
function Render_01() as long
static x, y, z as double
Static BoxColor as long
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
TBGL_BackColor br,bg,bb
if tbgl_GetwindowKeyState(hCtrl, %VK_R) then fr=255 : fg=0 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_G) then fr=0 : fg=255 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_B) then fr=0 : fg=0 : fb=255
if tbgl_GetwindowKeyState(hCtrl, %VK_A) then fr=0 : fg=0 : fb=0
TBGL_COLOR fr,fg,fb
TBGL_ClearFrame
tbgl_Camera 0,0,5,0,1,0
tbgl_translate 0,0.25,0
tbgl_Rotate GetTickCount/25,1,1,2
tbgl_Box 1,1.75,1
tbgl_Color fr, fg, 255
tbgl_Rotate GetTickCount/20,-1,2,1
tbgl_Box 0.25,0.45,2.5
tbgl_GetPixelInfo tbgl_MouseGetPosX, tbgl_MouseGetPosy, %TBGL_PINFO_XYZ, x, y, z
tbgl_Translate x,y,z
tbgl_color 255,fg,fb
tbgl_Sphere 0.295
TBGL_DrawFrame
end function
'------------------------------------------------------------
' TBGL render function 2
'------------------------------------------------------------
function Render_02() as long
static i, j as long
TBGL_COLOR 255, 255, 255
TBGL_BackColor br,bg,bb
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
' -- Erases previous frame
tbgl_ClearFrame
' -- Sets camera to look from 3,3,3 to 0,-1,0
tbgl_Camera 3, 3, 3, _
0, 0, 0
' -- All following geometry will be rotated around vector 0,1,0
' -- That is - Y axis
tbgl_Rotate gettickcount/100, 0, 1, 0
' -- Now we will try to render kind of spider
' -- It has ...
' .. One big head
tbgl_Color fr,fg,fb
tbgl_Sphere 0.25
' .. And eight legs
' .. We will draw them each 60°
for i = 0 to 359 step 45
tbgl_PushMatrix
tbgl_Rotate i, 0, 1, 0 ' 60, 120, 180, ...
' -- Legs will raise from bottom of head
tbgl_Translate 0, -0.25, 0
' -- With 3 part tentacle
tbgl_PushMatrix
for j = 1 to 3
tbgl_Color fr/j, fg/j, fb/j
' -- Some harmonic rotations will be provided by Sinus
tbgl_Rotate 70+sin(GetTickCount/1000+i+j)*20, 1, 0, 0
' -- Each tentacle part will be shorter and thinner than that before
tbgl_Cylinder ( 0.1/j, 0.1/(j+1), 1/j )
' -- When drawn, we need to move "cursor" at its end to bind new part
tbgl_Translate 0, 1/j, 0
next
tbgl_PopMatrix
tbgl_PopMatrix
next
if tbgl_GetwindowKeyState(hCtrl, %VK_R) then fr=255 : fg=0 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_G) then fr=0 : fg=255 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_B) then fr=0 : fg=0 : fb=255
if tbgl_GetwindowKeyState(hCtrl, %VK_A) then fr=0 : fg=0 : fb=0
' -- Finishes drawing
tbgl_DrawFrame
end function
'------------------------------------------------------------
' TBGL render function 3
'------------------------------------------------------------
function Render_03() as long
' Rotation Variable
static angle as single
' Timing Variables
static FrameRate as number
TBGL_BackColor br,bg,bb
FrameRate = tbgl_GetFrameRate
tbgl_clearframe ' Clear Screen
tbgl_resetmatrix ' Reset the Current Matrix
tbgl_camera 0, 0, 1, 0, 0, 0 ' Default Camera Position
tbgl_translate 0, 0, -4 ' Move Pyramid to Centre of Screen
tbgl_rotate angle, 0.0, 1.0, 0.0 ' Rotation Setup
drawPyramid()
drawQuads()
tbgl_drawframe ' Swap the Drawing Buffers
angle += sin(timer)+100.0/FrameRate
end function
'------------------------------------------------------------
' TBGL support to render function 3
'------------------------------------------------------------
sub drawPyramid()
tbgl_beginpoly %GL_TRIANGLE_FAN
tbgl_color 40, fg, fb : tbgl_vertex 0.0, 1.5, 0.0
tbgl_color fr, 40, 40 : tbgl_vertex -1.5, -1.5, 1.5
tbgl_color fr, fg, fb : tbgl_vertex 1.5, -1.5, 1.5
tbgl_color 40, 40, fb : tbgl_vertex 1.5, -1.5, -1.5
tbgl_color 40, fg, 40 : tbgl_vertex -1.5, -1.5, -1.5
tbgl_color fr, 40, 40 : tbgl_vertex -1.5, -1.5, 1.5
tbgl_endpoly
tbgl_color fr,fg,fb ' restore controled foreground color
end sub
sub drawQuads()
tbgl_translate 0, -0.25,0
tbgl_rotate 60, 0, 1,0
tbgl_beginpoly %gl_quads
' Front Face
tbgl_Normal 0.0, 0.0, 1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex -1.0, -1.0, 1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex 1.0, -1.0, 1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex 1.0, 1.0, 1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex -1.0, 1.0, 1.0
' Back Face
tbgl_Normal 0.0, 0.0, -1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex -1.0, -1.0, -1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex -1.0, 1.0, -1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex 1.0, 1.0, -1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex 1.0, -1.0, -1.0
' Top Face
tbgl_Normal 0.0, 1.0, 0.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex -1.0, 1.0, -1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex -1.0, 1.0, 1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex 1.0, 1.0, 1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex 1.0, 1.0, -1.0
' Bottom Face
tbgl_Normal 0.0,-1.0, 0.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex -1.0, -1.0, -1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex 1.0, -1.0, -1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex 1.0, -1.0, 1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex -1.0, -1.0, 1.0
' Right face
tbgl_Normal 1.0, 0.0, 0.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex 1.0, -1.0, -1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex 1.0, 1.0, -1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex 1.0, 1.0, 1.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex 1.0, -1.0, 1.0
' Left Face
tbgl_Normal -1.0, 0.0, 0.0
tbgl_texcoord2d 0.0, 0.0 : tbgl_vertex -1.0, -1.0, -1.0
tbgl_texcoord2d 1.0, 0.0 : tbgl_vertex -1.0, -1.0, 1.0
tbgl_texcoord2d 1.0, 1.0 : tbgl_vertex -1.0, 1.0, 1.0
tbgl_texcoord2d 0.0, 1.0 : tbgl_vertex -1.0, 1.0, -1.0
tbgl_endpoly
end sub
'--------------------------------
' TBGL render function 4
'--------------------------------
function Render_04() as long
static x, y, z as double
Static BoxColor as long
TBGL_UseLighting %TRUE
TBGL_UseLightSource %GL_LIGHT0, %TRUE
TBGL_BackColor br,bg,bb
if tbgl_GetwindowKeyState(hCtrl, %VK_R) then fr=255 : fg=0 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_G) then fr=0 : fg=255 : fb=0
if tbgl_GetwindowKeyState(hCtrl, %VK_B) then fr=0 : fg=0 : fb=255
if tbgl_GetwindowKeyState(hCtrl, %VK_A) then fr=0 : fg=0 : fb=0
TBGL_COLOR fr,fg,fb
TBGL_ClearFrame
tbgl_Camera 0,0,5,0,1,0
tbgl_translate 0, 1, 0
tbgl_Rotate GetTickCount/25,1,1,2
tbgl_color fr, 255, fb
tbgl_torus 0.2, 1.44
tbgl_Rotate GetTickCount/8,1.25,1,-1
tbgl_rotate 45, 1, 1, 1
tbgl_color 255, fg, fb
tbgl_torus 0.22, 0.6
tbgl_rotate gettickcount/20, 2, 1, 1
tbgl_color fr, 166, fb
tbgl_torus 0.18, 0.9
tbgl_GetPixelInfo tbgl_MouseGetPosX, tbgl_MouseGetPosy, %TBGL_PINFO_XYZ, x, y, z
tbgl_Translate x,y,z
TBGL_DrawFrame
end function
more to come...