View Full Version : New tbgl Mouse example
Thanks for the new tbgl mouse example. It looks really nice. I am playing with it like metaballs for modeling. Can make nice "Spore" looking shapes with it :)
I was experimenting with it and found this strange problem. I think it has something to do with lighting, but not sure?
I turned lighting off and it still occured. It does seem to change depending on where the sphere is moved in the window.
'
' TBGL DemoScript : Basic mouse handling
'
Uses "TBGL"
Uses "UI"
randomize timer
Dim hWnd As Dword
hWnd = TBGL_CreateWindowEx("Drag the spheres with mouse - press ESC to quit", 640, 480, 32, 0)
TBGL_ShowWindow
tbgl_UseLighting 1
tbgl_UseLightSource %GL_LIGHT0, 1
type TSphere
x as single
y as single
radius as single
cR as long
cG as long
cB as long
cA as long
end type
dim NumSphere as long = 16
dim mySphere(NumSphere) as TSphere
local i as long
for i = 1 to NumSphere
mySphere(i).x = rnd(-5,5)
mySphere(i).y = rnd(-3,3)
mySphere(i).radius = rndf(0.2, 1)
mySphere(i).cR = rnd(128,255)
mySphere(i).cG = rnd(128,255)
mySphere(i).cB = rnd(128,255)
mySphere(i).cA = rnd(75,150)
next
Local SphereHeld as long
GetAsyncKeyState(%VK_ESCAPE) ' Resets ESC key status before checking
While IsWindow(hWnd)
tbgl_ClearFrame
tbgl_Camera 0,0,10,0,0,0
TBGL_UseBlend 1
DrawGridXY
for i = 1 to NumSphere
tbgl_Pushmatrix
tbgl_Translate mySphere(i).x, mySphere(i).y, 0
TBGL_ColorAlpha mySphere(i).cR, mySphere(i).cG, mySphere(i).cB, mySphere(i).cA
tbgl_Sphere mySphere(i).radius
tbgl_Popmatrix
next
if tbgl_MouseGetLButton then
if SphereHeld = 0 then SphereHeld = GetSphereID
elseif tbgl_MouseGetLButton = 0 then
SphereHeld = 0
end if
if SphereHeld then
mySphere(SphereHeld).x = GetMouseToWorldX
mySphere(SphereHeld).y = GetMouseToWorldY
end if
tbgl_DrawFrame
If GetWindowKeyState( hWnd, %VK_ESCAPE) Then Exit While
Wend
TBGL_DestroyWindow
sub DrawGridXY()
tbgl_UseLighting 0
local i as long
tbgl_Color 0,255,0
tbgl_BeginPoly %GL_LINES
for i = -10 to 10
tbgl_Vertex -10, i, 0
tbgl_Vertex 10, i, 0
tbgl_Vertex i,-10, 0
tbgl_Vertex i, 10, 0
next
tbgl_EndPoly
tbgl_UseLighting 1
end sub
function GetMouseToWorldX()
local cX, x, y as single
dialog get client hWnd to x,y
cX = (tbgl_MouseGetPosX-x/2) /(x/(8.2 * x / y))
function = cX
end function
function GetMouseToWorldY()
local cY, x, y as single
dialog get client hWnd to x,y
cY = (tbgl_MouseGetPosY-y/2) /(y/8.2)
function = -cY
end function
function GetSphereID()
local cX, cY as single
local x,y as long
local i as long
dialog get size hWnd to x,y
' Recalculating pixel position to world XY - this is special case for zoom = 10 up !
cX = GetMouseToWorldX
cY = GetMouseToWorldY
function = 0
for i = 1 to NumSphere
if cx >< mySphere(i).x-mySphere(i).radius, mySphere(i).x+mySphere(i).radius and _
cy >< mySphere(i).y-mySphere(i).radius, mySphere(i).y+mySphere(i).radius then
function = i
end if
next
end function
Petr Schreiber
12-02-2007, 09:59
Hi kryton9,
I am happy you are playing with this sample :)
This problems occurs because the code to render sphere does its job by creating "ring parts". So the trouble is in blending you have enabled and order of drawing. To fix this, just disable depth mask - it will also display transparent objects correctly not depending on order.
Try this :):
'
' TBGL DemoScript : Basic mouse handling
'
Uses "TBGL"
Uses "UI"
randomize timer
Dim hWnd As Dword
hWnd = TBGL_CreateWindowEx("Drag the spheres with mouse - press ESC to quit", 640, 480, 32, 0)
TBGL_ShowWindow
tbgl_UseLighting 1
tbgl_UseLightSource %GL_LIGHT0, 1
type TSphere
x as single
y as single
radius as single
cR as long
cG as long
cB as long
cA as long
end type
dim NumSphere as long = 16
dim mySphere(NumSphere) as TSphere
local i as long
for i = 1 to NumSphere
mySphere(i).x = rnd(-5,5)
mySphere(i).y = rnd(-3,3)
mySphere(i).radius = rndf(0.2, 1)
mySphere(i).cR = rnd(128,255)
mySphere(i).cG = rnd(128,255)
mySphere(i).cB = rnd(128,255)
mySphere(i).cA = rnd(75,150)
next
Local SphereHeld as long
GetAsyncKeyState(%VK_ESCAPE) ' Resets ESC key status before checking
tbgl_BlendFunc %GL_src_COLOR, %GL_dst_COLOR
' tbgl_BlendFunc %GL_src_alpha, %GL_dst_alpha ' <- try this for mild blending effect
' tbgl_BlendFunc %GL_src_color, %GL_dst_alpha ' <- not bad too :)
tbgl_UseDepthMask 0
While IsWindow(hWnd)
tbgl_ClearFrame
tbgl_Camera 0,0,10,0,0,0
TBGL_UseBlend 1
DrawGridXY
for i = 1 to NumSphere
tbgl_Pushmatrix
tbgl_Translate mySphere(i).x, mySphere(i).y, 0
TBGL_ColorAlpha mySphere(i).cR, mySphere(i).cG, mySphere(i).cB, mySphere(i).cA
tbgl_Rotate 90,1,0,0
tbgl_Sphere mySphere(i).radius
tbgl_Popmatrix
next
if tbgl_MouseGetLButton then
if SphereHeld = 0 then SphereHeld = GetSphereID
elseif tbgl_MouseGetLButton = 0 then
SphereHeld = 0
end if
if SphereHeld then
mySphere(SphereHeld).x = GetMouseToWorldX
mySphere(SphereHeld).y = GetMouseToWorldY
end if
tbgl_DrawFrame
If GetWindowKeyState( hWnd, %VK_ESCAPE) Then Exit While
Wend
TBGL_DestroyWindow
sub DrawGridXY()
tbgl_UseLighting 0
local i as long
tbgl_Color 0,255,0
tbgl_BeginPoly %GL_LINES
for i = -10 to 10
tbgl_Vertex -10, i, 0
tbgl_Vertex 10, i, 0
tbgl_Vertex i,-10, 0
tbgl_Vertex i, 10, 0
next
tbgl_EndPoly
tbgl_UseLighting 1
end sub
function GetMouseToWorldX()
local cX, x, y as single
dialog get client hWnd to x,y
cX = (tbgl_MouseGetPosX-x/2) /(x/(8.2 * x / y))
function = cX
end function
function GetMouseToWorldY()
local cY, x, y as single
dialog get client hWnd to x,y
cY = (tbgl_MouseGetPosY-y/2) /(y/8.2)
function = -cY
end function
function GetSphereID()
local cX, cY as single
local x,y as long
local i as long
dialog get size hWnd to x,y
' Recalculating pixel position to world XY - this is special case for zoom = 10 up !
cX = GetMouseToWorldX
cY = GetMouseToWorldY
function = 0
for i = 1 to NumSphere
if cx >< mySphere(i).x-mySphere(i).radius, mySphere(i).x+mySphere(i).radius and _
cy >< mySphere(i).y-mySphere(i).radius, mySphere(i).y+mySphere(i).radius then
function = i
end if
next
end function
Please post here results if you create some creatures
Bye,
Petr
P.S. Little experiment - resizing spheres using right mouse button drag
'
' TBGL DemoScript : Basic mouse handling
'
Uses "TBGL"
Uses "UI"
randomize timer
Dim hWnd As Dword
hWnd = TBGL_CreateWindowEx("Drag the spheres with mouse, right button to scale - press ESC to quit", 640, 480, 32, 0)
TBGL_ShowWindow
tbgl_UseLighting 1
tbgl_UseLightSource %GL_LIGHT0, 1
type TSphere
x as single
y as single
xFactor as single
yFactor as single
radius as single
cR as long
cG as long
cB as long
cA as long
end type
dim NumSphere as long = 16
dim mySphere(NumSphere) as TSphere
local i as long
for i = 1 to NumSphere
mySphere(i).xFactor = 1
mySphere(i).yFactor = 1
mySphere(i).x = rnd(-5,5)
mySphere(i).y = rnd(-3,3)
mySphere(i).radius = rndf(0.2, 1)
mySphere(i).cR = rnd(128,255)
mySphere(i).cG = rnd(128,255)
mySphere(i).cB = rnd(128,255)
mySphere(i).cA = rnd(75,150)
next
Local SphereHeld as long
GetAsyncKeyState(%VK_ESCAPE) ' Resets ESC key status before checking
tbgl_BlendFunc %GL_src_alpha, %GL_dst_alpha
' tbgl_BlendFunc %GL_src_color, %GL_dst_alpha
tbgl_UseDepthMask 0
dim OldMouseX as long
dim OldMouseY as long
While IsWindow(hWnd)
tbgl_ClearFrame
tbgl_Camera 0,0,10,0,0,0
TBGL_UseBlend 1
DrawGridXY
for i = 1 to NumSphere
tbgl_Pushmatrix
tbgl_Translate mySphere(i).x, mySphere(i).y, 0
TBGL_ColorAlpha mySphere(i).cR, mySphere(i).cG, mySphere(i).cB, mySphere(i).cA
tbgl_Scale mySphere(i).xFactor, mySphere(i).yFactor, 1
tbgl_Rotate 90,1,0,0
tbgl_Sphere mySphere(i).radius
tbgl_Popmatrix
next
if tbgl_MouseGetLButton then
if SphereHeld = 0 then SphereHeld = GetSphereID
elseif tbgl_MouseGetLButton = 0 then
SphereHeld = 0
end if
if tbgl_MouseGetRButton then
if SphereHeld = 0 then SphereHeld = GetSphereID
elseif tbgl_MouseGetLButton = 0 then
SphereHeld = 0
end if
if SphereHeld then
if tbgl_MouseGetlButton then
mySphere(SphereHeld).x = GetMouseToWorldX
mySphere(SphereHeld).y = GetMouseToWorldY
elseif tbgl_MouseGetRButton then
mySphere(SphereHeld).xFactor += (OldMouseX - tbgl_MouseGetPosX)/10
if mySphere(SphereHeld).xFactor < 0.1 then mySphere(SphereHeld).xFactor = 0.1
mySphere(SphereHeld).yFactor += (OldMouseY - tbgl_MouseGetPosY)/10
if mySphere(SphereHeld).yFactor < 0.1 then mySphere(SphereHeld).yFactor = 0.1
end if
end if
tbgl_DrawFrame
OldMouseX = tbgl_MouseGetPosX
OldMouseY = tbgl_MouseGetPosY
If GetWindowKeyState( hWnd, %VK_ESCAPE) Then Exit While
Wend
TBGL_DestroyWindow
sub DrawGridXY()
tbgl_UseLighting 0
local i as long
tbgl_Color 0,255,0
tbgl_BeginPoly %GL_LINES
for i = -10 to 10
tbgl_Vertex -10, i, 0
tbgl_Vertex 10, i, 0
tbgl_Vertex i,-10, 0
tbgl_Vertex i, 10, 0
next
tbgl_EndPoly
tbgl_UseLighting 1
end sub
function GetMouseToWorldX()
local cX, x, y as single
dialog get client hWnd to x,y
cX = (tbgl_MouseGetPosX-x/2) /(x/(8.2 * x / y))
function = cX
end function
function GetMouseToWorldY()
local cY, x, y as single
dialog get client hWnd to x,y
cY = (tbgl_MouseGetPosY-y/2) /(y/8.2)
function = -cY
end function
function GetSphereID()
local cX, cY as single
local x,y as long
local i as long
dialog get size hWnd to x,y
' Recalculating pixel position to world XY - this is special case for zoom = 10 up !
cX = GetMouseToWorldX
cY = GetMouseToWorldY
function = 0
for i = 1 to NumSphere
if cx >< mySphere(i).x-mySphere(i).radius*mySphere(i).xFactor, mySphere(i).x+mySphere(i).radius*mySphere(i).xFactor and _
cy >< mySphere(i).y-mySphere(i).radius*mySphere(i).yFactor, mySphere(i).y+mySphere(i).radius*mySphere(i).yFactor then
function = i
end if
next
end function
Thanks Petr for the quick reply and solution. I just checked online before going to bed to see if anything new was up and was very happy to see the reply.
That looks really nice. Will be to play with it when I get up tomorrow. Thanks!!
Petr Schreiber
12-02-2007, 10:21
Good night ;D,
looking forward to your new versions !
I am not 100% sure it solves the problem in all cases, I will think about it more.
Bye,
Petr
I had about an hour to play with it when I got up, but now need to run and won't be able to do anything till later tonight.
Got stuck and am missing something, maybe fresh eyes can stop why it is not working. Well it works, but not for all spheres?
I remmed the left mouse button functions for now.
I added hold middle mouse button down and move mouse, it rotates the view in a constrained fashion. When you release goes back to default view.
Left mouse button will be as before when i get this working, but for now commented out.
Right mouse button moves the spheres in the z direction, it works for some but now all spheres. Anyways you can see that with mouse as input it adds so much to user interactivity dramatically.
Also Petr your get local mouse x and y functions should be tbgl commands I think, they are very useful. Can't wait to come home and work on this tonight.
Hope you can see what I was missing!!
'
' TBGL DemoScript : Basic mouse handling
'
Uses "TBGL"
Uses "UI"
randomize timer
Dim hWnd As Dword
hWnd = TBGL_CreateWindowEx("Drag the spheres with mouse - press ESC to quit", 640, 480, 32, 0)
TBGL_ShowWindow
tbgl_UseLighting 1
tbgl_UseLightSource %GL_LIGHT0, 1
type TSphere
x as single
y as single
z as single
radius as single
cR as long
cG as long
cB as long
cA as long
end type
dim NumSphere as long = 16
dim mySphere(NumSphere) as TSphere
local i as long
for i = 1 to NumSphere
mySphere(i).x = rnd(-5,5)
mySphere(i).y = rnd(-3,3)
mySphere(i).z = 0
mySphere(i).radius = rndf(0.2, 1)
mySphere(i).cR = rnd(128,255)
mySphere(i).cG = rnd(128,255)
mySphere(i).cB = rnd(128,255)
mySphere(i).cA = rnd(75,150)
next
Local SphereHeld as long
GetAsyncKeyState(%VK_ESCAPE) ' Resets ESC key status before checking
tbgl_BlendFunc %GL_src_COLOR, %GL_dst_COLOR
' tbgl_BlendFunc %GL_src_alpha, %GL_dst_alpha ' <- try this for mild blending effect
' tbgl_BlendFunc %GL_src_color, %GL_dst_alpha ' <- not bad too :)
tbgl_UseDepthMask 0
While IsWindow(hWnd)
tbgl_ClearFrame
if tbgl_MouseGetMButton then
tbgl_Camera GetMouseToWorldX()*5,GetMouseToWorldY()*5,10,0,0,0
elseif tbgl_MouseGetMButton = 0 then
tbgl_Camera 0,0,10,0,0,0
end if
TBGL_UseBlend 1
DrawGridXY
for i = 1 to NumSphere
tbgl_Pushmatrix
tbgl_Translate mySphere(i).x, mySphere(i).y, mySphere(i).z
TBGL_ColorAlpha mySphere(i).cR, mySphere(i).cG, mySphere(i).cB, mySphere(i).cA
tbgl_Rotate 90,1,0,0
tbgl_Sphere mySphere(i).radius
tbgl_Popmatrix
next
' if tbgl_MouseGetLButton then
' if SphereHeld = 0 then SphereHeld = GetSphereID
' elseif tbgl_MouseGetLButton = 0 then
' SphereHeld = 0
' end if
if tbgl_MouseGetRButton then
if SphereHeld = 0 then SphereHeld = GetSphereID
elseif tbgl_MouseGetRButton = 0 then
SphereHeld = 0
end if
' if SphereHeld and tbgl_MouseGetLButton then
' mySphere(SphereHeld).x = GetMouseToWorldX
' mySphere(SphereHeld).y = GetMouseToWorldY
' end if
if (SphereHeld AND tbgl_MouseGetRButton) then
mySphere(SphereHeld).z = GetMouseToWorldX
mySphere(SphereHeld).z = GetMouseToWorldY
end if
tbgl_DrawFrame
If GetWindowKeyState( hWnd, %VK_ESCAPE) Then Exit While
Wend
TBGL_DestroyWindow
sub DrawGridXY()
tbgl_UseLighting 0
local i as long
tbgl_Color 0,255,0
tbgl_BeginPoly %GL_LINES
for i = -10 to 10
tbgl_Vertex -10, i, 0
tbgl_Vertex 10, i, 0
tbgl_Vertex i,-10, 0
tbgl_Vertex i, 10, 0
next
tbgl_EndPoly
tbgl_UseLighting 1
end sub
function GetMouseToWorldX()
local cX, x, y as single
dialog get client hWnd to x,y
cX = (tbgl_MouseGetPosX-x/2) /(x/(8.2 * x / y))
function = cX
end function
function GetMouseToWorldY()
local cY, x, y as single
dialog get client hWnd to x,y
cY = (tbgl_MouseGetPosY-y/2) /(y/8.2)
function = -cY
end function
function GetSphereID()
local cX, cY as single
local x,y as long
local i as long
dialog get size hWnd to x,y
' Recalculating pixel position to world XY - this is special case for zoom = 10 up !
cX = GetMouseToWorldX
cY = GetMouseToWorldY
function = 0
for i = 1 to NumSphere
if cx >< mySphere(i).x-mySphere(i).radius, mySphere(i).x+mySphere(i).radius and _
cy >< mySphere(i).y-mySphere(i).radius, mySphere(i).y+mySphere(i).radius then
function = i
end if
next
end function
Petr Schreiber
12-02-2007, 23:24
Hi,
very nice "mouse look" !
The problem seems to me to be caused by wrong condition.
I realized it happens only for spheres with even id ( like 2, 4, 6, ... ).
Trouble was in fact, that in logical expression 4 AND 1 equals to 0. Scared ? Me too :)
To avoid such a troubles, use "complete" conditions.
So instead of:
if SphereHeld AND tbgl_MouseGetRButton then ...
use
if SphereHeld > 0 AND tbgl_MouseGetRButton = 1 then ...
In this case, as MouseGetRButton returns only 1 or 0, the "= 1" is redundant, but to keep it clear :)
This was quite tricky problem, I must tell you !
Bye,
Petr
Solution:
'
' TBGL DemoScript : Basic mouse handling
'
Uses "TBGL"
Uses "UI"
' randomize timer
Dim hWnd As Dword
hWnd = TBGL_CreateWindowEx("Drag the spheres with mouse - press ESC to quit", 640, 480, 32, 0)
TBGL_ShowWindow
tbgl_UseLighting 1
tbgl_UseLightSource %GL_LIGHT0, 1
type TSphere
x as single
y as single
z as single
radius as single
cR as long
cG as long
cB as long
cA as long
end type
dim NumSphere as long = 16
dim mySphere(NumSphere) as TSphere
local i as long
for i = 1 to NumSphere
mySphere(i).x = rnd(-5,5)
mySphere(i).y = rnd(-3,3)
mySphere(i).z = 0
mySphere(i).radius = rndf(0.2, 1)
mySphere(i).cR = rnd(128,255)
mySphere(i).cG = rnd(128,255)
mySphere(i).cB = rnd(128,255)
mySphere(i).cA = rnd(75,150)
next
Local SphereHeld as long
GetAsyncKeyState(%VK_ESCAPE) ' Resets ESC key status before checking
tbgl_BlendFunc %GL_src_COLOR, %GL_dst_COLOR
' tbgl_BlendFunc %GL_src_alpha, %GL_dst_alpha ' <- try this for mild blending effect
' tbgl_BlendFunc %GL_src_color, %GL_dst_alpha ' <- not bad too :)
tbgl_UseDepthMask 0
dim OldMouseX as long
dim OldMouseY as long
While IsWindow(hWnd)
tbgl_ClearFrame
if tbgl_MouseGetMButton then
tbgl_Camera GetMouseToWorldX()*5,GetMouseToWorldY()*5,10,0,0,0
elseif tbgl_MouseGetMButton = 0 then
tbgl_Camera 0,0,10,0,0,0
end if
TBGL_UseBlend 1
DrawGridXY
for i = 1 to NumSphere
tbgl_Pushmatrix
tbgl_Translate mySphere(i).x, mySphere(i).y, mySphere(i).z
TBGL_ColorAlpha mySphere(i).cR, mySphere(i).cG, mySphere(i).cB, mySphere(i).cA
tbgl_Rotate 90,1,0,0
tbgl_Sphere mySphere(i).radius
tbgl_Popmatrix
next
' if tbgl_MouseGetLButton then
' if SphereHeld = 0 then SphereHeld = GetSphereID
' elseif tbgl_MouseGetLButton = 0 then
' SphereHeld = 0
' end if
if tbgl_MouseGetRButton then
if SphereHeld = 0 then SphereHeld = GetSphereID
elseif tbgl_MouseGetRButton = 0 then
SphereHeld = 0
end if
' if SphereHeld and tbgl_MouseGetLButton then
' mySphere(SphereHeld).x = GetMouseToWorldX
' mySphere(SphereHeld).y = GetMouseToWorldY
' end if
if SphereHeld > 0 AND tbgl_MouseGetRButton = 1 then mySphere(SphereHeld).z += ( OldMouseX - tbgl_MouseGetPosX + OldMouseY - tbgl_MouseGetPosY)/10
OldMouseX = tbgl_MouseGetPosX
OldMouseY = tbgl_MouseGetPosY
tbgl_DrawFrame
If GetWindowKeyState( hWnd, %VK_ESCAPE) Then Exit While
Wend
TBGL_DestroyWindow
sub DrawGridXY()
tbgl_UseLighting 0
local i as long
tbgl_Color 0,255,0
tbgl_BeginPoly %GL_LINES
for i = -10 to 10
tbgl_Vertex -10, i, 0
tbgl_Vertex 10, i, 0
tbgl_Vertex i,-10, 0
tbgl_Vertex i, 10, 0
next
tbgl_EndPoly
tbgl_UseLighting 1
end sub
function GetMouseToWorldX()
local cX, x, y as single
dialog get client hWnd to x,y
cX = (tbgl_MouseGetPosX-x/2) /(x/(8.2 * x / y))
function = cX
end function
function GetMouseToWorldY()
local cY, x, y as single
dialog get client hWnd to x,y
cY = (tbgl_MouseGetPosY-y/2) /(y/8.2)
function = -cY
end function
function GetSphereID()
local cX, cY as single
local x,y as long
local i as long
dialog get size hWnd to x,y
' Recalculating pixel position to world XY - this is special case for zoom = 10 up !
cX = GetMouseToWorldX
cY = GetMouseToWorldY
function = 0
for i = 1 to NumSphere
if cx >< mySphere(i).x-mySphere(i).radius, mySphere(i).x+mySphere(i).radius and _
cy >< mySphere(i).y-mySphere(i).radius, mySphere(i).y+mySphere(i).radius then
function = i
end if
next
end function
Petr, I am so glad I posted the question then, there is no way I would have ever figured that one out. How did you realize what was wrong?
I am amazed and thanks you saved me hours of head scratching tonight. Now I can work on the program and make more progress I hope.
Thanks again, you saved me from endless turmoil tonight and frustration!!
Petr Schreiber
13-02-2007, 11:21
Hi kryton9,
first I thought the click detection didn't worked, so I wrote the index of currently clicked sphere to window title.
From that I could see that selection is ok and dragging doesn't work for even numbers.
So it had to be in the condition :)
Can't wait for next version!,
Petr