Hilbert

Category: Games

Date: 02-16-2022

Return to Index


 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode=1
#Include "Win32API.inc"
 
Global hDlg, hBMP, hBMPDC, hDC As Dword, r As Single, x,y As Long
%pt = 512      'a power of 2
%maxlev = 6
 
Enum Equates Singular
   IDC_Graphic = 500
End Enum
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Hilbert Curves",300,300,200,200, %WS_OverlappedWindow To hDlg
   Dialog Set Color hDlg, %Black, %White
   Control Add Graphic, hDlg, %IDC_Graphic, "", 0,0,200,200
   Graphic Attach hDlg, %IDC_Graphic
   Graphic Color %Black, %White
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         Dialog Post hDlg, %WM_User+500, 0,0
      Case %WM_User+500
         DrawHilbertCurves
   End Select
End Function
 
 
Sub DRAWPIXEL(ByVal xs As LongByVal ys As Long)
 Graphic Line -(x,y) : x += xs : y += ys
End Sub
 
Sub Hilbert (ByVal xs As LongByVal ys As LongByVal x2 As LongByVal y2 As LongByVal lev As Long)
 If lev = 0 Then Exit Sub
 hilbert (x2, y2, xs, ys, lev - 1)
 DrawPixel (xs, ys)
 hilbert (xs, ys, x2, y2, lev - 1)
 DrawPixel (x2,y2)
 hilbert (xs, ys, x2, y2,lev - 1)
 DrawPixel (-xs, -ys)
 hilbert (-x2, -y2 ,-xs, -ys, lev - 1)
 Graphic Line -(x, y)
End Sub
 
Function DrawHilbertCurves() As Long
   Dim LUT(%maxlev) As Long
   Local hWin As Dword, cSTEP, i, level As Long
   Graphic Clear
   For i = 0 To 6 : LUT(i) = RGB(Rnd(0,255),Rnd(0,255), Rnd(0,255)) : Next i
   level  = 0 : cSTEP  = %pt\2
   Do
      x = cSTEP\2 : y = cSTEP\2
      Graphic Color LUT(level)
      Incr level
      Graphic Set Pos (x,y)
      Hilbert 0, cSTEP, cSTEP, 0, level
      cSTEP = cSTEP\2
      Sleep 1000
   Loop Until level > %maxlev
End Function
 
'gbs_01403
'Date: 10-17-2014


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm