'Ported to FreeBasic by UEZ build 2016-10-08
'OpenGL version by Elor
 
#lang "FB" 

#include "fbgfx.bi" 
#include "GL/gl.bi"
#Include "string.bi"

Declare Sub InitOpenGL(ByVal W As Integer, ByVal H As Integer) 
Declare Sub PythagorasTreeRec(iX1 As Single, iY1 As Single, iX2 As Single, iY2 As Single, iRecDepth As UByte) 
Declare Function _Sin6th(fX As Double) As Double 
Declare Function _Cos6th(fX As Double) As Double 


Dim As String sTitle = "OpenGL Animated Pythagoras Tree v2.5 , FPS: " 
Dim As ULong iFPS = 0
Dim Shared As ULong iRec = 0, iRectangles = 0
Dim As Double fTime, fTimer 
Dim As UShort iW = 1200, iH = 700, iWhL = iW \ 2 - 60, iWhR = iW \ 2 + 60
Dim As UByte iRecDepth = 16
InitOpenGL(iW, iH) 

fTimer= Timer() 

Do 
	glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT)
	
	PythagorasTreeRec(iWhL, iH, iWhR, iH, iRecDepth) 
	Flip() 
	
	glFlush()
	

	If (Timer - fTimer > 0.99) Then 
		WindowTitle(sTitle & iFPS & " ___ #Recursion calls / s: " & Format(iRec, "###,") & " ___ #Rectangles: " & Format(iRectangles, "###,")) 
		iFPS = 0 
		iRec = 0
		fTimer = Timer 
	Else 
		iFPS += 1 
	EndIf 
	iRectangles = 0
		
	Sleep(10) 
Loop Until InKey = Chr(27)
    

Sub InitOpenGL(ByVal W As Integer, ByVal H As Integer) 
	ScreenRes(W, H, 32,, FB.GFX_OPENGL)' Or FB.GFX_NO_SWITCH) 
	glMatrixMode(GL_PROJECTION) 
	glLoadIdentity() 
	
	glEnable(GL_LINE_SMOOTH)
	glEnable(GL_POLYGON_SMOOTH)
	glEnable(GL_BLEND)
	glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)

	
	glViewport(0, 0, W, H) 
	glOrtho(0, W, H, 0, -128, 128) 
	glMatrixMode(GL_MODELVIEW) 
	glEnable(GL_CULL_FACE) 
	glCullFace(GL_BACK) 
	glLoadIdentity() 

	glClearColor(&h60 / &hFF, &h60 / &hFF, &h60 / &hFF, 1.00) 'rgba
	glDepthFunc(GL_LESS) 
	glEnable(GL_DEPTH_TEST) 

End Sub 

Sub PythagorasTreeRec(iX1 As Single, iY1 As Single, iX2 As Single, iY2 As Single, iRecDepth As UByte) 
	Static iSpeed As Double = -&hFFFF
	Dim As UInteger iC1 =(iRecDepth * 17), iC2 =(iRecDepth + 2) * 8
	iC1 = IIf(iC1 > &hFF, &hFF, iC1)
	iC2 = IIf(iC2 > &hFF, &hFF, iC2)
	 
	Dim As Single dx = iX2 - iX1, dy = iY1 - iY2 
	Dim As Single iX3 = iX2 - dy, iY3 = iY2 - dx 
	Dim As Single iX4 = iX1 - dy, iY4 = iY1 - dx 
	Dim As Single iX5 = iX4 +(dx - dy) /(2.5 - _Cos6th((iX4 + iSpeed) / 400) / 1.5) 
	Dim As Single iY5 = iY4 -(dx + dy) /(2.25 + _Sin6th((iX5 + iY4 - iSpeed) / 500)) 
  	iSpeed += 0.0001
	
	glBegin(GL_POLYGON) 
	glColor3ub(iC2, (255 - iC1), 0) 
	glVertex2f(iX1, iY1) 
	glVertex2f(iX2, iY2) 
	glVertex2f(iX3, iY3) 
	glVertex2f(iX4, iY4) 
	glVertex2f(iX1, iY1)
	glEnd() 
	
	iRectangles += 1
	iRec += 1
  	If (iRecDepth > 0) Then  
		PythagorasTreeRec(iX5, iY5, iX3, iY3, iRecDepth - 1)
		PythagorasTreeRec(iX4, iY4, iX5, iY5, iRecDepth - 1)
  	End If 
End Sub 

Function _Sin6th(fX As Double) As Double 
   Asm 
      jmp _Sin6th_Start 
         _Sin6th_Mul: .double 683565275.57643158 
         _Sin6th_Div: .double -0.0000000061763971109087229 
         _Sin6th_Rnd: .double 6755399441055744.0 
       
      _Sin6th_Start: 
         movq xmm0, [fX] 
         mulsd xmm0, [_Sin6th_Mul] 
         addsd xmm0, [_Sin6th_Rnd] 
         movd ebx, xmm0 
    
         lea  eax, [ebx*2+0x80000000] 
         sar  eax, 2 
         imul eax 
         sar  ebx, 31 
         lea  eax, [edx*2-0x70000000] 
         lea  ecx, [edx*8+edx-0x24000000] 
         imul edx 
         xor  ecx, ebx 
         lea  eax, [edx*8+edx+0x44A00000] 
         imul ecx 
          
         cvtsi2sd xmm0, edx 
         mulsd xmm0, [_Sin6th_Div] 
         movq [Function], xmm0 
   End Asm 
End Function 

Function _Cos6th(fX As Double) As Double 
   Asm 
      jmp _Cos6th_Start 
         _Cos6th_Mul: .double 683565275.57643158 
         _Cos6th_Div: .double -0.0000000061763971109087229 
         _Cos6th_Rnd: .double 6755399441055744.0 
       
      _Cos6th_Start: 
         movq xmm0, [fX] 
         mulsd xmm0, [_Cos6th_Mul] 
         addsd xmm0, [_Cos6th_Rnd] 
         movd ebx, xmm0 
          
         add ebx, 0x40000000 'SinToCos 
    
         lea  eax, [ebx*2+0x80000000] 
         sar  eax, 2 
         imul eax 
         sar  ebx, 31 
         lea  eax, [edx*2-0x70000000] 
         lea  ecx, [edx*8+edx-0x24000000] 
         imul edx 
         xor  ecx, ebx 
         lea  eax, [edx*8+edx+0x44A00000] 
         imul ecx 
          
         cvtsi2sd xmm0, edx 
         mulsd xmm0, [_Cos6th_Div] 
         movq [Function], xmm0 
   End Asm 
End Function 