Circles

[peter]

Hi Petr,

Circle are ready! here is a small demo.
Is a little bit slow, is there a possibility to make it faster?
Would be good, if I had more speed. I know that the next demo needs a lot of speed.

Try once Circle and FillCircle.


Uses "tbgl"
Dim hwnd,hfnt As DWord

hwnd=TBGL_CreateWindowEx("Circles",800,600,32, %TBGL_WS_WINDOWED | %TBGL_WS_DONTSIZE | %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
TBGL_RenderMatrix2D (0,0,800,600)
TBGL_BackColor (0,0,0)
hfnt=TBGL_FontHandle("arial",24)
TBGL_BuildFont(hfnt)
TBGL_SetActiveFont(1)
Randomize()

Dim cx(120),cy(120),cd(120) As Single
Dim c1(120),c2(120),c3(120) As Byte
Dim c As Long

For c=1 To 100
cx(c)=400
cy(c)=300
cd(c)=Rnd(1,8)
c1(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
c2(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
c3(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
Next

While TBGL_IsWindow(hWnd)
TBGL_ClearFrame
TBGL_Color(249,202,253)
TBGL_PrintFont("Circles",340,542)

For c=1 To 100
If cd(c)=1 Then
cx(c)=cx(c)+1
bound()
ElseIf cd(c)=2 Then
cx(c)=cx(c)-1
bound()
ElseIf cd(c)=3 Then
cy(c)=cy(c)-1
bound()
ElseIf cd(c)=4 Then
cy(c)=cy(c)+1
bound()
ElseIf cd(c)=5 Then
cy(c)=cy(c)-1
cx(c)=cx(c)-1
bound()
ElseIf cd(c)=6 Then
cy(c)=cy(c)-1
cx(c)=cx(c)+1
bound()
ElseIf cd(c)=7 Then
cy(c)=cy(c)+1
cx(c)=cx(c)-1
bound()
ElseIf cd(c)=8 Then
cy(c)=cy(c)+1
cx(c)=cx(c)+1
bound()
End If
Next
circles()
TBGL_DrawFrame
If key(27) Then Exit While
'Sleep (10)
Wend
TBGL_DestroyWindow

Sub circles()
For c=1 To 100
Circle1(cx(c),cy(c),40,c1(c),c2(c),c3(c))
'FillCircle(cx(c),cy(c),40,c1(c),c2(c),c3(c))
Next
End Sub

Sub bound()
Dim i As DWord
For i=1 To 100
If cx(i) <=40 Then
cd(i) = Rnd(1,8)
cx(i) =40
End If
If cx(i) >=760 Then
cd(i) = Rnd(1,8)
cx(i) =760
End If
If cy(i) >=560 Then
cd(i) = Rnd(1,8)
cy(i) =560
End If
If cy(i) <=40 Then
cd(i) = Rnd(1,8)
cy(i) =40
End If
Next
End Sub

Sub Circle1(x0,y0 As Single,ra,r,g,b As Byte)
Local f,x,y,ddF_x,ddF_y As Single
f=1-ra : y=ra
ddF_y =-2 * ra
TBGL_Color(r,g,b)
TBGL_Point(x0,y0+ra)
TBGL_Point(x0,y0-ra)
TBGL_Point(x0+ra,y0)
TBGL_Point(x0-ra,y0)
While x < y
If f >= 0 Then
y=y-1
ddF_y=ddf_y+2
f=f+ddF_y
End If
x=x+1
ddF_x=ddf_x+2
f=f+ddF_x+1
TBGL_Point(x0+x,y0+y)
TBGL_Point(x0-x,y0+y)
TBGL_Point(x0+x,y0-y)
TBGL_Point(x0-x,y0-y)
TBGL_Point(x0+y,y0+x)
TBGL_Point(x0-y,y0+x)
TBGL_Point(x0+y,y0-x)
TBGL_Point(x0-y,y0-x)
Wend
End Sub

Sub FillCircle(x,y,ra As Single,r,g,b As Byte)
TBGL_Color(r,g,b)
TBGL_NGon(x,y,ra,ra)
End Sub

Function Key(xkey As Word) As Word
Return TBGL_GetAsyncKeyState(xkey)
End Function

[peter]

Here is a faster variation.


Uses "tbgl"
Dim hwnd,hfnt As DWord

hwnd=TBGL_CreateWindowEx("Circles",800,600,32, %TBGL_WS_WINDOWED | %TBGL_WS_DONTSIZE | %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
TBGL_RenderMatrix2D (0,0,800,600)
TBGL_BackColor (0,0,0)
hfnt=TBGL_FontHandle("arial",24)
TBGL_BuildFont(hfnt)
TBGL_SetActiveFont(1)
Randomize()

Dim cx(120),cy(120),cd(120) As Single
Dim c1(120),c2(120),c3(120) As Byte
Dim c As Long

For c=1 To 100
cx(c)=400
cy(c)=300
cd(c)=Rnd(1,8)
c1(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
c2(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
c3(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
Next

While TBGL_IsWindow(hwnd)
TBGL_ClearFrame
TBGL_Color(249,255,253)
TBGL_PrintFont("Point Circles",300,542)

For c=1 To 100
If cd(c)=1 Then
cx(c)=cx(c)+2
bound()
ElseIf cd(c)=2 Then
cx(c)=cx(c)-2
bound()
ElseIf cd(c)=3 Then
cy(c)=cy(c)-2
bound()
ElseIf cd(c)=4 Then
cy(c)=cy(c)+2
bound()
ElseIf cd(c)=5 Then
cy(c)=cy(c)-2
cx(c)=cx(c)-2
bound()
ElseIf cd(c)=6 Then
cy(c)=cy(c)-2
cx(c)=cx(c)+2
bound()
ElseIf cd(c)=7 Then
cy(c)=cy(c)+2
cx(c)=cx(c)-2
bound()
ElseIf cd(c)=8 Then
cy(c)=cy(c)+2
cx(c)=cx(c)+2
bound()
End If
Next
circles()
TBGL_DrawFrame
If key(27) Then Exit While
Wend
TBGL_DestroyWindow

Sub circles()
For c=1 To 100
TBGL_PointSize 66
TBGL_Color(c1(c),c2(c),c3(c))
TBGL_Point(cx(c),cy(c))
Next
End Sub

Sub bound()
Dim i As DWord
For i=1 To 100
If cx(i) <=40 Then
cd(i) = Rnd(1,8)
cx(i) =40
End If
If cx(i) >=760 Then
cd(i) = Rnd(1,8)
cx(i) =760
End If
If cy(i) >=560 Then
cd(i) = Rnd(1,8)
cy(i) =560
End If
If cy(i) <=40 Then
cd(i) = Rnd(1,8)
cy(i) =40
End If
Next
End Sub

Function Key(xkey As Word) As Word
Return TBGL_GetAsyncKeyState(xkey)
End Function

[Petr Schreiber]

Hi Peter,

I think this code is not performance bound on the graphics side, but because of so many loops and function calls. Here is slightly faster version, tweaks marked with [!]


Uses "tbgl"

Dim hwnd,hfnt As DWord

hwnd=TBGL_CreateWindowEx("Circles",800,600,32, %TBGL_WS_WINDOWED | %TBGL_WS_DONTSIZE | %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
TBGL_RenderMatrix2D (0,0,800,600)
TBGL_BackColor (0,0,0)

hfnt=TBGL_FontHandle("arial",24)
TBGL_BuildFont(hfnt)
TBGL_SetActiveFont(1)

Randomize()

Long cachedCircle, cachedCircleFull
TBGL_NewListSpace(cachedCircle)
TBGL_NewListSpace(cachedCircleFull)

TBGL_NewList cachedCircle
TBGL_PolygonLook %GL_LINE
TBGL_NGon(0,0,1,360)
TBGL_PolygonLook %GL_FILL
TBGL_EndList

TBGL_NewList cachedCircleFull
TBGL_NGon(0,0,1,360)
TBGL_EndList

Dim cx(120),cy(120),cd(120) As Single
Dim c1(120),c2(120),c3(120) As Byte
Dim i, c As Long

For c=1 To 100
cx(c)=400
cy(c)=300
cd(c)=Rnd(1,8)
c1(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
c2(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
c3(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
Next

While TBGL_IsWindow(hWnd)

TBGL_ClearFrame
TBGL_Color(249,202,253)
TBGL_PrintFont("Circles",340,542)

For c=1 To 100
'[!] Instead of huge IF
cx(c) += Choose(cd(c), 1, -1, 0, 0, -1, 1, -1, 1)
cy(c) += Choose(cd(c), 0, 0, -1, 1, -1, -1, 1, 1)

'[!] Bounds
For i=1 To 100

If cx(i) <=40 Then
cd(i) = Rnd(1,8)
cx(i) =40
ElseIf cx(i) >=760 Then
cd(i) = Rnd(1,8)
cx(i) =760
End If

If cy(i) >=560 Then
cd(i) = Rnd(1,8)
cy(i) =560
ElseIf cy(i) <=40 Then
cd(i) = Rnd(1,8)
cy(i) =40
End If
Next
Next

'[!] Circles
For c=1 To 100
TBGL_Color(c1(c),c2(c),c3(c))

'[!] Circle1
TBGL_PushMatrix
TBGL_Translate cx(c),cy(c), 0
TBGL_Scale 40
TBGL_CallList cachedCircle

TBGL_PopMatrix

Next

TBGL_DrawFrame

If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While

Wend
TBGL_DestroyWindow


Petr

[Petr Schreiber]

Slightly tweaked second example:


Uses "tbgl"
Dim hwnd,hfnt As DWord

hwnd=TBGL_CreateWindowEx("Circles",800,600,32, %TBGL_WS_WINDOWED | %TBGL_WS_DONTSIZE | %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
TBGL_RenderMatrix2D (0,0,800,600)
TBGL_BackColor (0,0,0)
hfnt=TBGL_FontHandle("arial",24)
TBGL_BuildFont(hfnt)
TBGL_SetActiveFont(1)
Randomize()

'[!] Enough to specify once
TBGL_PointSize 66

Dim cx(120),cy(120),cd(120) As Single
Dim c1(120),c2(120),c3(120) As Byte
Dim i, c As Long

For c=1 To 100
cx(c)=400
cy(c)=300
cd(c)=Rnd(1,8)
c1(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
c2(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
c3(c)=Rgb(Rnd(64,255),Rnd(64,255),Rnd(32,255))
Next

While TBGL_IsWindow(hwnd)
TBGL_ClearFrame
TBGL_Color(249,255,253)
TBGL_PrintFont("Point Circles",300,542)

For c=1 To 100

'[!] Instead of huge IF
cx(c) += Choose(cd(c), 2, -2, 0, 0, -2, 2, -2, 2)
cy(c) += Choose(cd(c), 0, 0, -2, 2, -2, -2, 2, 2)

'[!] Bounds
For i=1 To 100

If cx(i) <=40 Then
cd(i) = Rnd(1,8)
cx(i) =40
ElseIf cx(i) >=760 Then
cd(i) = Rnd(1,8)
cx(i) =760
End If

If cy(i) >=560 Then
cd(i) = Rnd(1,8)
cy(i) =560
ElseIf cy(i) <=40 Then
cd(i) = Rnd(1,8)
cy(i) =40
End If
Next

Next

circles()

TBGL_DrawFrame

If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While

Wend
TBGL_DestroyWindow

Sub circles()
For c=1 To 100
TBGL_Color(c1(c),c2(c),c3(c))
TBGL_Point(cx(c),cy(c))
Next
End Sub


Petr

[peter]

Thank you Petr, for slightly tweaking.

It's very interesting to see that ThinBasic supports C syntax.
I didn't know this! Working through the help isn't that easy here.

How works TBGL_ColorAlpha? I got no success therewith.
Thanks

[Michael Clease]

Here is an optimisation for the bounds checking


'[!] Bounds
For i=1 To 100
cx(i) = MinMax(cx(i),40,760)
cy(i) = MinMax(cy(i),40,560)
Next

[peter]

Hi Micha,

This is really funny! I am missing something.

This Mandel Dragon needs an optimization.


Uses "tbgl"
Dim hwnd,hfnt As DWord

hwnd=TBGL_CreateWindowEx("Mandel Dragon",400,300,32, %TBGL_WS_WINDOWED | %TBGL_WS_DONTSIZE | %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow
TBGL_RenderMatrix2D (0,0,400,300)
TBGL_BackColor(255,0,0)
hfnt=TBGL_FontHandle("arial",44)
TBGL_BuildFont(hfnt)
TBGL_SetActiveFont(1)

Dim cRe,cIm,newRe,newIm,oldRe,oldIm,zoom,moveX,moveY As Single
Dim Iteration,x,y,i As Long
Iteration=300:cRe=-0.7:cIm=0.27015:zoom=1

TBGL_Color(255,255,0)
TBGL_PrintFont("WAIT....",100,32)
TBGL_DrawFrame
TBGL_ClearFrame

For x=0 To 400
For y=0 To 300
newRe = 1.5 * (x-400/2) / (.5*zoom*400) + moveX
newIm = (y-300/2) / (.5*zoom*300) + moveY
For i=0 To Iteration
oldRe = newRe
oldIm = newIm
newRe = oldRe * oldRe - oldIm * oldIm +cRe
newIm = 2 * oldRe * oldIm + cIm
If ((newRe * newRe + newIm * newIm) > 4) Then
Exit For
End If
Next
TBGL_Color(i*.8,100,i*.6)
TBGL_Point(x,y)
Next
Next
TBGL_DrawFrame

While TBGL_IsWindow(hWnd)
If TBGL_GetAsyncKeyState(27) Then Exit While
Sleep (10)
Wend
TBGL_DestroyWindow

[Petr Schreiber]

How works TBGL_ColorAlpha? I got no success therewith.


As help file says: "Value in Alpha channel is used only when appropiate blending or alpha functions are enabled"
Here little example:


'
' Using alpha
' Petr Schreiber, started on 10-09-2012
'

Uses "TBGL"

Function TBMain()
Local hWnd As DWord
Local FrameRate As Double

' -- Create and show window
hWnd = TBGL_CreateWindowEx("TBGL script - press ESC to quit", 640, 480, 32, %TBGL_WS_WINDOWED Or %TBGL_WS_CLOSEBOX)
TBGL_ShowWindow

' -- Set bledning model
TBGL_BlendFunc %GL_SRC_ALPHA, %GL_ONE_MINUS_SRC_ALPHA
' -- Enable blending as effect
TBGL_UseBlend TRUE
' -- Disable depth
TBGL_UseDepth FALSE

' -- Resets status of all keys
TBGL_ResetKeyState()

' -- Main loop
While TBGL_IsWindow(hWnd)
FrameRate = TBGL_GetFrameRate

TBGL_RenderMatrix2D(0, 0, 640, 480)
TBGL_ClearFrame


TBGL_ColorAlpha(255, 128, 64, 128)
TBGL_Rect(0, 0, 400, 250)

TBGL_ColorAlpha(64, 128, 255, 128)
TBGL_Rect(310, 230, 640, 480)


TBGL_DrawFrame

' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While

Wend

TBGL_DestroyWindow
End Function


Petr

[peter]

Thanks petr,
Is almost that, what I have in OxygenBasic.



Sub glInit2D()
GetClientRect hwnd, rc
glViewport 0, 0, rc.right, rc.bottom
double right = rc.right
double bottom = rc.bottom
glMatrixMode GL_Projection
glLoadIdentity
glOrtho 0, right, bottom, 0, -1, 1
glMatrixMode GL_ModelView
glLoadIdentity
glDisable GL_DEPTH_TEST
glEnable GL_TEXTURE_2D
glEnable GL_ALPHA_TEST
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA
glShadeModel GL_SMOOTH
glAlphaFunc GL_GREATER,0.1
glGenTextures 128,sData
glGenTextures 128,Tiles
End Sub