Demo: Recursion tree

Share your advanced PureBasic knowledge/code with the community.
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Demo: Recursion tree

Post by Trond »

I made this based on a standard function to draw trees recursively.

Code: Select all


Define.d

#MaxRecursions = 8
Global Angle = 0.2 * #PI
Global Shrink = 2.8
Global treecol = #Red+#Green

Procedure Recursion(pX, pY, dX, dY, sz, n)
  x2 = pX + sz * dX
  y2 = pY + sz * dY
  LineXY(pX, pY, x2, y2, treecol)
  
  If n < #maxRecursions
    sz / shrink
    n + 1
    dX2 = Cos(angle) * dX + Sin(angle) * dY
    dY2 = -Sin(angle) * dX + Cos(angle) * dY
    recursion(X2, Y2, dX2, dY2, sz, n)
    dX2 = Cos(-angle) * dX + Sin(-angle) * dY
    dY2 = -Sin(-angle) * dX + Cos(-angle) * dY
    recursion(X2, Y2, dX2, dY2, sz, n)
  EndIf
EndProcedure

InitKeyboard()
InitSprite()
ExamineDesktops()
w = DesktopWidth(0)
h = DesktopHeight(0)
OpenScreen(w, h, 32, "")
CreateSprite(0, w, h)
StartDrawing(SpriteOutput(0))
  col = RGB(10, 30, 50)
  Box(0, 0, w, h, col)
StopDrawing()
Repeat
  If Int(treecolcount / 255) & 1
    treecol + 256
  Else
    treecol - 256
  EndIf
  treecolcount + 1
  StartDrawing(SpriteOutput(0))
    recursion(w / 2, h - 1, 0, -1, h / 2.3, 0)
  StopDrawing()
  DisplaySprite(0, 0, 0)
  FlipBuffers()
  ExamineKeyboard()
  Angle + 0.01
  Shrink - 0.001
  If Shrink < 0.86
    Shrink = 3
  EndIf
Until KeyboardInkey()


Maybe someone can even change it into 10 lines of 80 characters each and participate in PurePunch with it?
Edit: Nvm, I did it myself. I had no idea it was that easy to do.

Code: Select all

Define.d:Global a=0.2*#PI,t=3,c=$FFFF:InitKeyboard():InitSprite()
ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):OpenScreen(w, h, 32, "")
CreateSprite(0, w, h):Procedure R(X,Y,d,e,s,n):z=X+s*d:q=Y+s*e:LineXY(X,Y,z,q,c)
If n:s/t:f=Cos(a)*d+Sin(a)*e:g=-Sin(a)*d+Cos(a)*e:r(z,q,f,g,s,n+1):
f=Cos(-a)*d+Sin(-a)*e:g=-Sin(-a)*d+Cos(-a)*e:r(z,q,f,g,s,n+1):EndIf:EndProcedure
StartDrawing(SpriteOutput(0)):Box(0, 0, w, h, $281400):StopDrawing():Repeat
If Int(ct/255)&1:c+256:Else:c-256:EndIf:ct+1:StartDrawing(SpriteOutput(0))
r(w/2,h-1,0,-1,h/2.3,-8):StopDrawing():DisplaySprite(0,0,0):FlipBuffers()
ExamineKeyboard():a+0.01:t-0.001:If t<0.86:t=3:EndIf:Until KeyboardInkey()
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Very nice and beautiful to watch. Would make a great screensaver. Thanks for posting!
BERESHEIT
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Almost hypnotic! :)
I may look like a mule, but I'm not a complete ass.
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Post by Trond »

If you have a powerful graphics card you can also make use of Sprite3d for a nice effect. You may have to turn down the resolution to make it run fast enough.

Code: Select all

;###############################################################################
Define.d:Global a=0.2*#PI,t=3,c=$FFFF:InitKeyboard():InitSprite()

w = 1440
h = 900

OpenScreen(w, h, 32, "")
w*2
h*2
CreateSprite(0, w, h, #PB_Sprite_Texture)
InitSprite3D()
CreateSprite3D(0, 0)
Sprite3DQuality(#PB_Sprite3D_BilinearFiltering)

Procedure R(X, Y, d, e, s, n)
  z = X + s * d
  q = Y + s * e
  LineXY(X, Y, z, q, c)
  
  If n
    s / t
    f = Cos(a) * d + Sin(a) * e
    g = -Sin(a) * d + Cos(a) * e
    r(z, q, f, g, s, n+1)
    f = Cos(-a) * d + Sin(-a) * e
    g = -Sin(-a) * d + Cos(-a) * e
    r(z, q, f, g, s, n+1)
  EndIf
EndProcedure


StartDrawing(SpriteOutput(0)):Box(0, 0, w, h, $281400):StopDrawing():Repeat
  If Int(ccount / 255) & 1
    c + 256
  Else
    c - 256
  EndIf
  ccount + 1
  StartDrawing(SpriteOutput(0))
    r(w / 2, h - 1, 0, -1, h / 2.3, -8)
  StopDrawing()
  ; DisplaySprite(0, 0, 0)
  Start3D()
  ZoomSprite3D(0, w/2, h/2)
  DisplaySprite3D(0, 0, 0)
  Stop3D()
  FlipBuffers()
  ExamineKeyboard()
  a + 0.01
  t - 0.001
  If t < 0.86
    t = 3
  EndIf
Until KeyboardInkey()
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Just a blank screen here! Vista 32.
I may look like a mule, but I'm not a complete ass.
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Post by Trond »

After watching both I found that I actually liked the first one best anyways, so you didn't miss much. :)
Last edited by Trond on Thu Jun 18, 2009 9:59 pm, edited 2 times in total.
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Trond wrote:After watching both I found that I actually liked the first one best anyways, so you didn't miss much. :)
:lol:

Any idea why the second doesn't display anything other than a blank screen here? I have a crappy integrated graphics using shared memory etc.
I may look like a mule, but I'm not a complete ass.
PB
PureBasic Expert
PureBasic Expert
Posts: 7581
Joined: Fri Apr 25, 2003 5:24 pm

Post by PB »

> If you have a powerful graphics card you can also make use of
> Sprite3d for a nice effect

I get this error when trying to run your new code:

Code: Select all

Line: 10 - OpenScreen() or OpenWindowedScreen() must be called before using any Sprite commands.
But OpenScreen is there (line 7) so there seems to be a PureBasic bug.
It works if I change 1440x900 to 640x480, but the IDE shouldn't report
that OpenScreen isn't called, because it is.
I compile using 5.31 (x86) on Win 7 Ultimate (64-bit).
"PureBasic won't be object oriented, period" - Fred.
Trond
Always Here
Always Here
Posts: 7446
Joined: Mon Sep 22, 2003 6:45 pm
Location: Norway

Post by Trond »

First of all you needed to change the resolution variables to something sensible for your setup. If you get the same error as PB then your graphics card didn't support the chosen resolution.

Srod: You need a graphics card that supports non-square, non-power-of-two textures that are bigger than the screen.

It keeps amazing me. It makes "new" pictures every round because the animation and colour cycling don't have the same length. Who thought line trees could make such beautiful images?!?

By the way it's possible to clear the sprite every frame to see what the tree looks like when it's not overdrawing:

Code: Select all

  ...
  StartDrawing(SpriteOutput(0))
    Box(0, 0, w, h, col) ; add this
    recursion(w / 2, h - 1, 0, -1, h / 2.3, 0)
  StopDrawing()
  ...
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Strange; that resolution runs fine with PB's Sprite3D demo.

However, when I set the res to 640x480 like PB then your demo runs fine - and I agree with you; your first demo looked better! :wink:
I may look like a mule, but I'm not a complete ass.
User avatar
idle
Always Here
Always Here
Posts: 5917
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Post by idle »

looks good.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Here's some Windows Screensaver code for it. To keep CPU usage down I made some timing adjustments, added a delay and fixed the resolution at 800*600. It still looks good here.

Compile as <whatever>.scr and make sure you select "save as: all files" when you compile so a ".exe" doesn't get appended to it, put it in \windows\system32.

Code: Select all

Define.d

;============================================================
;                       Declarations
;============================================================

Declare.i SetProcessLock(LockStr$)
Declare Recursion(pX, pY, dX, dY, sz, n) 
Declare.i CheckStatus()

;============================================================
;           Constants/Structures/Interfaces/Globals
;============================================================

; Presentation constants
#MaxRecursions = 8 

; Screensaver management constants
#Mode_Save     = 0
#Mode_Preview  = 1
#Mode_Config   = 2

; Presentation vars
Global Angle = 0.2 * #PI, Shrink = 2.8, treecol.i = #Red+#Green

; Screensaver management vars
Global runmode.i, Preview_hwnd.i, timeperiod.i

w.i = 800 
h.i = 600 

runtype$ = ProgramParameter() 
If FindString(UCase(runtype$), "S", 1)
  runmode = #Mode_Save
ElseIf FindString(UCase(runtype$), "P", 1) 
  runmode = #Mode_Preview
ElseIf FindString(UCase(runtype$), "C", 1)
  runmode = #Mode_Config
Else
  runmode = #Mode_Config
EndIf

InitSprite()
Select runmode 
  Case #Mode_Preview  
    SetProcessLock("TreeSaver_PreviewModeLock")
    preview$ = ProgramParameter()
    Preview_hwnd = Val(preview$)
    GetClientRect_(Preview_hwnd, @PSize.RECT)
    OpenWindow(0, 0, 0, PSize\right,PSize\bottom, "TreeSaver", #WS_CHILD, Preview_hwnd) 
    OpenWindowedScreen(WindowID(0),0,0,w,h,1,0,0) 
  Case #Mode_Save
    SetProcessLock("TreeSaver_SaverModeLock")
    InitKeyboard() : InitMouse()
    OpenScreen(w, h, 32, "TreeSaver") 
  Case #mode_config
    MessageRequester("","No settings to adjust for this screensaver",#MB_ICONINFORMATION)
EndSelect

CreateSprite(0, w, h) 
StartDrawing(SpriteOutput(0)) 
  col = RGB(10, 30, 50) 
  Box(0, 0, w, h, col) 
StopDrawing() 

timer_res.TIMECAPS
timeGetDevCaps_( timer_res, SizeOf(TIMECAPS) )
timeperiod = timer_res\wPeriodMin
timeBeginPeriod_( timeperiod )

Repeat 
  Select runmode
    Case #Mode_Preview
      Repeat:ev=WindowEvent():If ev=#WM_CLOSE:timeEndPeriod_(timeperiod):End:EndIf:Until ev=0
    Case #Mode_Save 
      CheckStatus()
  EndSelect
  
  If Int(treecolcount / 255) & 1 
    treecol + 256 
  Else 
    treecol - 256 
  EndIf 
  treecolcount + 1 
  StartDrawing(SpriteOutput(0)) 
    recursion(w / 2, h - 1, 0, -1, h / 2.3, 0) 
  StopDrawing() 
  DisplaySprite(0, 0, 0) 
  FlipBuffers() 
  Angle + 0.01 
  Shrink - 0.001 
  If Shrink < 0.86 
    Shrink = 3 
  EndIf 
  Delay(5)
ForEver

End

;============================================================
;                   Procedure Section
;============================================================

Procedure SetProcessLock(LockStr$)
  *MySem = CreateSemaphore_(0, 0, 1, LockStr$)
  If *MySem <> 0 And GetLastError_() = #ERROR_ALREADY_EXISTS
    CloseHandle_(*MySem)
    End
  EndIf
EndProcedure

Procedure Recursion(pX, pY, dX, dY, sz, n) 
  x2 = pX + sz * dX 
  y2 = pY + sz * dY 
  LineXY(pX, pY, x2, y2, treecol) 
  
  If n < #maxRecursions 
    sz / shrink 
    n + 1 
    dX2 = Cos(angle) * dX + Sin(angle) * dY 
    dY2 = -Sin(angle) * dX + Cos(angle) * dY 
    recursion(X2, Y2, dX2, dY2, sz, n) 
    dX2 = Cos(-angle) * dX + Sin(-angle) * dY 
    dY2 = -Sin(-angle) * dX + Cos(-angle) * dY 
    recursion(X2, Y2, dX2, dY2, sz, n) 
  EndIf 
EndProcedure 

Procedure CheckStatus()
    ExamineKeyboard() : ExamineMouse()
    If KeyboardPushed(#PB_Key_All) Or MouseButton(#PB_MouseButton_Left) Or MouseButton(#PB_MouseButton_Right) Or MouseDeltaX() Or MouseDeltaY() 
      timeEndPeriod_(timeperiod)
      End
    EndIf
    If GetFocus_() <> ScreenID()
      timeEndPeriod_(timeperiod)
      End
    EndIf
EndProcedure
BERESHEIT
Post Reply