PureBasic Forums - English

Posted: **Sun Aug 31, 2014 9:44 am**

a space filling curve
using the algorithm from
http://www.vb-helper.com/howto_fractal_ ... curve.html
i have replaced the vb6 line:
picCanvas.Line -Step(dx, dy)
with these PB lines:
LineXY(x0,y0 , x0+dx, y0+dy)
x0 + dx: y0 + dy

Code: Select all

#SizeH = 800: #SizeV = 600
Global imageNum
Global.l x0, y0
x0 = 20: y0 = 20
Procedure Hilbert(depth.i, dx.f, dy.f)
    
  If depth > 1 
    Hilbert(depth - 1, dy, dx)
    LineXY(x0,y0 , x0+dx, y0+dy)
    x0 + dx: y0 + dy
  EndIf  
  If depth > 1
    Hilbert(depth - 1, dx, dy)
    LineXY(x0,y0 , x0+dy, y0+dx)
    x0 + dy: y0 + dx
  EndIf
  
  If depth > 1
    Hilbert(depth - 1, dx, dy)
    LineXY(x0,y0 , x0-dx, y0-dy)
    x0 - dx: y0 - dy
  EndIf
  
  If depth > 1
    Hilbert(depth - 1, -dy, -dx)
  EndIf
  
EndProcedure

CreateImage(2,700,570)

    
;**************************************************************
OpenWindow(0, 0, 0, #SizeH, #SizeV, "Hilbert Curve", #PB_Window_SystemMenu)
imageNum = CreateImage(#PB_Any, #SizeH, #SizeV, 32)
ImageGadget(0, 10, 10, 0, 0, ImageID(imageNum))
depth.i = 7


If StartDrawing(ImageOutput(imageNum))
    Hilbert(depth, 10, 0)
  StopDrawing()
  SetGadgetState(0, ImageID(imageNum))
EndIf 
 
Repeat: Until WaitWindowEvent(10) = #PB_Event_CloseWindow

ref:
1- http://www.datagenetics.com/blog/march22013/
2- http://www.jasondavies.com/hilbert-curve/
3- http://www.latenightpc.com/blog/archive ... -lua-and-c
4- http://www.ebi.ac.uk/huber-srv/hilbert/

Posted: **Sun Aug 31, 2014 9:47 am**

Nice code, as always applePi

Posted: **Sun Aug 31, 2014 11:50 am**

...wow, that's hard to look at

Posted: **Sun Aug 31, 2014 8:41 pm**

Should be identical in execution, and seems so when you run it:

Code: Select all

Procedure Hilbert(depth.i, dx.f, dy.f)
    
  If depth > 1 
    Hilbert(depth - 1, dy, dx)
    LineXY(x0,y0 , x0+dx, y0+dy)
    x0 + dx: y0 + dy
    Hilbert(depth - 1, dx, dy)
    LineXY(x0,y0 , x0+dy, y0+dx)
    x0 + dy: y0 + dx
    Hilbert(depth - 1, dx, dy)
    LineXY(x0,y0 , x0-dx, y0-dy)
    x0 - dx: y0 - dy
    Hilbert(depth - 1, -dy, -dx)
  EndIf
  
EndProcedure

Posted: **Sun Aug 31, 2014 9:28 pm**

thats much shorter code thank you. i'm still feel dizziness from this recursive function.
i have prepared the same 2D version but in a 3D context so to consider it as a mesh we can rotate it. i will use your code netmaestro, will post it tomorrow . thanks Fred and IdeasVacuum.

Posted: **Sun Aug 31, 2014 9:37 pm**

i have prepared the same 2D version but in a 3D context so to consider it as a mesh we can rotate it

Seriously cool, I'm looking forward to that one!

Posted: **Sun Aug 31, 2014 9:56 pm**

@applePi

Another lovely example. Thank you.

Posted: **Mon Sep 01, 2014 7:26 am**

thanks davido
to make it as a sheet inside 3D space :instead of using LineXY(x0,y0 , x0+dx, y0+dy) we use:
MeshVertexPosition(x0, y0, 0)
MeshVertexPosition(x0+dx, y0+dy, 0)
with the empty mesh defined previously as having #PB_Mesh_LineStrip property. it is only this change. we can color every step in a different color by preceding it with something like MeshVertexColor(RGB(0,255,0))
i have used the corrected procedure by netmaestro.
make a tour around the curve using the mouse and keyboard.
uncomment line 121 to let it rotate

Code: Select all

#CameraSpeed = 10
#Camera = 0

Global.l x0, y0, tot
x0 = 0: y0 = 0
Define.f KeyX, KeyY, MouseX, MouseY

Procedure Hilbert(depth.i, dx.f, dy.f)
  
  If depth > 1 
    
    Hilbert(depth - 1, dy, dx)
    MeshVertexColor(RGB(0,255,0))
    MeshVertexPosition(x0, y0, 0)
    MeshVertexPosition(x0+dx, y0+dy, 0)
    ;LineXY(x0,y0 , x0+dx, y0+dy)
    x0 + dx: y0 + dy
   
  
    Hilbert(depth - 1, dx, dy)
    MeshVertexPosition(x0, y0, 0)
    MeshVertexPosition(x0+dy, y0+dx, 0)
    ;LineXY(x0,y0 , x0+dy, y0+dx)
    x0 + dy: y0 + dx
 
  
  
    Hilbert(depth - 1, dx, dy)
    MeshVertexPosition(x0, y0, 0)
    MeshVertexPosition(x0-dx, y0-dy, 0)
    ;LineXY(x0,y0 , x0-dx, y0-dy)
    x0 - dx: y0 - dy
  
    
    Hilbert(depth - 1, -dy, -dx)
  EndIf
  
EndProcedure


IncludeFile #PB_Compiler_Home + "Examples/3D/Screen3DRequester.pb"

Define.f KeyX, KeyY, MouseX, MouseY

If InitEngine3D()
  
  Add3DArchive(".", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Textures", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Models", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Scripts",#PB_3DArchive_FileSystem)
    
  Parse3DScripts()
  
  InitSprite()
  InitKeyboard()
  InitMouse()
  
ExamineDesktops()
DesktopW = DesktopWidth(0)
DesktopH = DesktopHeight(0)


If OpenWindow(0, 0, 0, DesktopW, DesktopH, "Hilbert Curve, use the mouse / keyboard to travel over the curve ")
  If OpenWindowedScreen(WindowID(0), 0, 0, DesktopW, DesktopH, 0, 0, 0)
     
    CreateMesh(0, #PB_Mesh_LineStrip , #PB_Mesh_Static)
    
    CreateMaterial(0, LoadTexture(0, "White.jpg"))
    DisableMaterialLighting(0, #True)
    SetMeshMaterial(0, MaterialID(0))
  
    ; Camera
    ;
    CreateCamera(#Camera, 0, 0, 100, 100)
    MoveCamera(#Camera, 0, 500, 600, #PB_Absolute)
    CameraLookAt(#Camera, 0, 0, 0)
    RotateCamera(#Camera, -10,0,0,#PB_Relative)
  depth.i = 8
 
  Hilbert(depth, 10, 0)
  
  FinishMesh(#True)
  CreateEntity(0,MeshID(0),MaterialID(0) )
  MoveEntity(0, -250,0,-200)
EndIf
EndIf

RotateEntity(0, 90,0,0)
    Repeat
      event = WindowEvent()
      
      If ExamineMouse()
        MouseX = -MouseDeltaX()/20 
        MouseY = -MouseDeltaY()/20
      EndIf
      
          
      If ExamineKeyboard()
      
        If KeyboardPushed(#PB_Key_Left)
          KeyX = -#CameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Right)
          KeyX = #CameraSpeed
        Else
          KeyX = 0
        EndIf
        
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -#CameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = #CameraSpeed
        Else
          KeyY = 0
        EndIf
        
                    
      EndIf
      RotateCamera(#Camera, MouseY, MouseX, 0, #PB_Relative)
      MoveCamera(#Camera, KeyX, 0, KeyY)
         
      ;RotateEntity(0, 0,1,0,#PB_Relative) ; to rotate the curve
      RenderWorld()
      FlipBuffers()
    Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
  ;EndIf
    
Else
  MessageRequester("Error", "The 3D Engine can't be initialized",0)
EndIf
  
End

Posted: **Mon Sep 01, 2014 9:35 am**

> uncomment line 121 to let it rotate

"Line: 121 - The specified #Entity is not initialised."

Posted: **Mon Sep 01, 2014 9:54 am**

PB wrote:> uncomment line 121 to let it rotate

"Line: 121 - The specified #Entity is not initialised."

Code: Select all

RotateEntity(7, 0,1,0,#PB_Relative) ; to rotate the curve

change 7 to 0.

@applePi.
Nice

Posted: **Mon Sep 01, 2014 10:22 am**

thank you DK_PETER and PB. i have edited it.
at near the end of the page http://www.datagenetics.com/blog/march22013/ there is the 3D version of Hilbert curve http://www.datagenetics.com/blog/march22013/3d.png in which the curve filling the 3D space. this is a possible project using thin lines, or thick continuous points since thick lines seems not possible as i have read in the Ogre forum.

PureBasic Forums - English

Hilbert Curve

Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve

Re: Hilbert Curve