PureBasic Forums - English

Posted: **Thu Jun 18, 2009 7:28 pm**

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


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()

Posted: **Thu Jun 18, 2009 9:02 pm**

Very nice and beautiful to watch. Would make a great screensaver. Thanks for posting!

Posted: **Thu Jun 18, 2009 9:26 pm**

Almost hypnotic!

Posted: **Thu Jun 18, 2009 9:42 pm**

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()

Posted: **Thu Jun 18, 2009 9:48 pm**

Just a blank screen here! Vista 32.

Posted: **Thu Jun 18, 2009 9:51 pm**

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

Posted: **Thu Jun 18, 2009 9:54 pm**

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

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.

Posted: **Thu Jun 18, 2009 9:55 pm**

> 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.

Posted: **Thu Jun 18, 2009 9:58 pm**

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()
  ...

Posted: **Thu Jun 18, 2009 10:06 pm**

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!

Posted: **Thu Jun 18, 2009 11:32 pm**

looks good.

Posted: **Fri Jun 19, 2009 2:31 am**

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

PureBasic Forums - English

Demo: Recursion tree

Demo: Recursion tree