Circles

**peter** · 08-10-2012, 22:02

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** · 09-10-2012, 09:42

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** · 09-10-2012, 10:02

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** · 09-10-2012, 10:23

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** · 09-10-2012, 12:44

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** · 09-10-2012, 14:50

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** · 09-10-2012, 15:19

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** · 09-10-2012, 18:51

Originally Posted by peter

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** · 09-10-2012, 19:35

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