'Ported to FreeBasic by UEZ build 2016-10-01

#Include "fbgfx.bi"
#Include "windows.bi"
#Include "win\gdiplus.bi"

Using FB
Using GDIPLUS

Declare Sub PythagorasTreeRec(ByRef hGfx As Any Ptr, ByRef iX1 As Single, ByRef iY1 As Single, ByRef iX2 As Single, ByRef iY2 As Single, ByRef iRecDepth As UByte)
Declare Function _Sin6th(fX As Double) As Double
Declare Function _Cos6th(fX As Double) As Double

Dim Shared gdipToken As ULONG_PTR
Dim GDIp As GdiplusStartupInput 
GDIp.GdiplusVersion = 1
GdiplusStartup(@gdipToken, @GDIp, NULL)

Const As UInteger iW = 1200, iH = 700

ScreenControl FB.SET_DRIVER_NAME, "GDI"
ScreenRes iW, iH, 24, 1, GFX_HIGH_PRIORITY Or GFX_NO_SWITCH

Dim As String sTitle = "GDI+ Animated Pythagoras Tree v2.5 / FPS: "
WindowTitle sTitle

Dim as HWND hHWND
ScreenControl(FB.GET_WINDOW_HANDLE, Cast(Integer, hHWND))

Dim As BITMAPV5HEADER tBIV5HDR
tBIV5HDR.bV5Size = SizeOf(BITMAPV5HEADER)
tBIV5HDR.bV5Width = iW
tBIV5HDR.bV5Height = -iH
tBIV5HDR.bV5Planes = 1
tBIV5HDR.bV5BitCount = 32
tBIV5HDR.bV5Compression = 0 'BI_BITFIELDS
tBIV5HDR.bV5AlphaMask = &hFF000000
tBIV5HDR.bV5RedMask = 	&h00FF0000
tBIV5HDR.bV5GreenMask = &h0000FF00
tBIV5HDR.bV5BlueMask = 	&h000000FF
tBIV5HDR.bV5CSType = 2
tBIV5HDR.bV5Intent = 4


Dim As Any Ptr hDC = GetDC(hHWND), _
					hHBitmap = CreateCompatibleBitmap(hDC, iW, iH), _
					hGfxDC = CreateCompatibleDC(hDC)
Dim Shared As Any Ptr hPath, hCanvas, hBrush, hPen

Var hObjOld = SelectObject(hGfxDC, hHBitmap)
				
GdipCreateFromHDC(hGfxDC, @hCanvas)
GdipSetSmoothingMode(hCanvas, 5)
GdipSetPixelOffsetMode(hCanvas, 4)
GdipCreatePath(0, @hPath)
GdipCreateSolidFill(0, @hBrush)
GdipCreatePen1(0, 1, 2, @hPen)

Dim Shared As Double i = 0
Dim As ULong iFPS = 0
Dim As Double fTime, fTimer

Dim evt As EVENT

fTimer = Timer

Do
	BitBlt(hGfxDC, 0, 0, iW, iH, hGfxDC, 0, 0, WHITENESS)

	PythagorasTreeRec(hCanvas, 550, 700, 650, 700, 9)
	
	BitBlt(hDC, 0, 0, iW, iH, hGfxDC, 0, 0, SRCCOPY)
	
	If Timer - fTimer > 0.99 Then
		WindowTitle sTitle & iFPS
		iFPS = 0
		fTimer = Timer
	Else
		iFPS += 1
	EndIf
	
	If (ScreenEvent(@evt)) Then
		Select Case evt.Type 
			Case SC_ESCAPE, EVENT_WINDOW_CLOSE
				SelectObject(hGfxDC, hObjOld)
				ReleaseDC(hHWND, hDC)
				DeleteObject(hHBitmap)
				DeleteDC(hGfxDC)
				GdipDeleteGraphics(hCanvas)
				GdipDeletePath(hPath)
				GdipDeleteBrush(hBrush)
				GdipDeletePen(hPen)
				GdiplusShutdown(gdipToken)
				Exit Do
		End Select
	EndIf
	Sleep(10)
Loop

Sub PythagorasTreeRec(ByRef hGfx As Any Ptr, ByRef iX1 As Single, ByRef iY1 As Single, ByRef iX2 As Single, ByRef iY2 As Single, ByRef iRecDepth As UByte)
	Dim As ULong iBGR1 = &hFF000000 + (iRecDepth * 20) Shl 16 + (255 - (iRecDepth + 10) * 10) Shl 8
	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 + i) / 400) / 1.5)
	Dim As Single iY5 = iY4 - (dx + dy) / (2.25 + _Sin6th((iX5 + iY4 - i) / 500))
	i += 0.01
	
	
	GdipAddPathLine(hPath, iX1, iY1, iX2, iY2)
	'GdipAddPathLine(hPath, iX2, iY2, iX3, iY3)
	GdipAddPathLine(hPath, iX3, iY3, iX4, iY4)
	'GdipAddPathLine(hPath, iX4, iY4, iX1, iY1)
	
	GdipSetSolidFillColor(hBrush, iBGR1)
	GdipFillPath(hGfx, hBrush, hPath)
	
	'GdipSetPenColor(hPen, iBGR1 Or &hFF181818)
	'GdipDrawPath(hCanvas, hPen, hPath) 'insane slow!
	
	GdipResetPath(hPath)
	
	If iRecDepth > 0 Then
		PythagorasTreeRec(hGfx, iX4, iY4, iX5, iY5, iRecDepth - 1)
		PythagorasTreeRec(hGfx, iX5, iY5, iX3, iY3, iRecDepth - 1)
	EndIf
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 