View Full Version : Tree Recursion
Hi Eros,
There is still another problem with recursion.
It seems that Mathematics in Thinbasic is a little bit differently.
This recursion tree only shows one branch.
You can compare with oxygenbasic tree, to see the difference.
Uses "ui", "math"
#INCLUDE "abc.inc"
OpenWindow 600, 500
SetHandleDC hdc, hwnd
Canvas_Clear &HFFFFFF
Dim x2, y2, depth As Long
depth = 9
Sub MainDraw(x1, y1 As Long, angle As Single, d As Long)
If d >0 Then
x2 = x1 + Cos(DegToRad(angle)) * d * 10
y2 = y1 + Sin(DegToRad(angle)) * d * 10
DrawLine x1, y1, x2, y2, d, Rgb(255-d*10, 100-d, 70)
MainDraw(x2, y2, angle - 20, d-1)
MainDraw(x2, y2, angle + 20, d-1)
End If
End Sub
MainDraw(300, 460, -90, depth)
Canvas_Redraw
Canvas_WaitKey
Canvas_Window End hwnd
OxygenBasic code:
#include "sw.inc"
Window 600,500,1
sys depth=9
Sub Draw(sys x1, y1, single angle, sys depth)
iF depth > 0
x2 = x1 + cos(rad(angle)) * depth * 10
y2 = y1 + sin(rad(angle)) * depth * 10
Line x1, y1, x2, y2, depth, RGB(255-depth*10, 100-depth, 70)
Draw(x2, y2, angle - 20, depth - 1)
Draw(x2, y2, angle + 20, depth - 1)
End iF
End Sub
Draw(300, 460, -90, depth)
WaitKey
CloseWindow
ErosOlmi
30-03-2014, 08:08
Ciao Peter,
sorry for the delay but I was on a mission :)
Please define X2 and Y2 as Local inside MainDraw function and all should work as expected.
Uses "ui", "math"#INCLUDE "abc.inc"
OpenWindow 600, 500
SetHandleDC hdc, hwnd
Canvas_Clear &HFFFFFF
Dim depth As Long = 9
Sub MainDraw(x1, y1 As Long, angle As Single, d As Long)
Dim x2, y2 As Long
If d >0 Then
x2 = x1 + Cos(DegToRad(angle)) * d * 10
y2 = y1 + Sin(DegToRad(angle)) * d * 10
DrawLine x1, y1, x2, y2, d, Rgb(255-d*10, 100-d, 70)
MainDraw(x2, y2, angle - 20, d-1)
MainDraw(x2, y2, angle + 20, d-1)
End If
End Sub
MainDraw(300, 460, -90, depth)
Canvas_Redraw
Canvas_WaitKey
Canvas_Window End hwnd
ErosOlmi
30-03-2014, 08:26
A little bit of random variations.
Uses "ui", "math"#INCLUDE "abc.inc"
OpenWindow 600, 500
SetHandleDC hdc, hwnd
Dim depth As Long
Sub MainDraw(x1, y1 As Long, angle As Single, d As Long)
Dim x2, y2 As Long
If d > 0 Then
x2 = x1 + Cos(DegToRad(angle)) * d * Rnd(5, 12)
y2 = y1 + Sin(DegToRad(angle)) * d * Rnd(5, 12)
DrawLine x1, y1, x2, y2, d, Rgb(255-d*10, 100-d, 70)
MainDraw(x2, y2, angle - 20, d-1)
MainDraw(x2, y2, angle + 20, d-1)
End If
End Sub
Randomize
Do
depth = Rnd(8, 10)
Canvas_Clear &HFFFFFF
MainDraw(300, 460, -90, depth)
Canvas_Redraw
Loop While Asc(Canvas_WaitKey) <> 27
Canvas_Window End hwnd
Thank you Eros,
Cool Trees! Well done.
ErosOlmi
31-03-2014, 22:26
This evening I was really tired after a hard day at work :(
I just wanted a little bit of ... nature.
It always surprise me how few lines of code are able to create such natural figures.
Nature is math and math is nature.
Uses "ui", "math"
#INCLUDE "abc.inc"
OpenWindow 1024, 768
SetHandleDC hdc, hwnd
Dim depth As Long
Sub MainDraw(x1, y1 As Long, angle As Single, d As Long)
Dim x2, y2 As Long
If d > 0 Then
x2 = x1 + Cos(DegToRad(angle)) * d * Rnd(2, 12)
y2 = y1 + Sin(DegToRad(angle)) * d * Rnd(2, 12)
DrawLine x1, y1, x2, y2, d, Rgb(d*10, 255-d*Rnd(20, 25), 0)
MainDraw(x2, y2, angle - Rnd(13, 18), d-1)
MainDraw(x2, y2, angle + Rnd(13, 18), d-1)
End If
End Sub
Dim Counter As Long
Randomize
Do
depth = Rnd(6, 12)
'---Clear screen every 50 trees
If Mod(Counter, 50) = 0 Or Counter = 0 Then Canvas_Clear Rgb(0, 230, 255)
MainDraw(Rnd(100, 985), 768, Rnd(-85, -95), depth)
Canvas_Redraw
Incr Counter
Loop While (Asc(Canvas_WaitKey) <> 27) And IsWindow(hwnd)
Canvas_Window End hwnd
Hi Eros,
Looks good this nature. Better than the original nature!
There are no cars, no people, is a quiet and peaceful nature forest.
Hi Eros,
A beautiful example how nature regenerates itself in a recursive way.
(and generating "natural images ;-)
I'm somewhat back to Lisp for the moment, but .. (while it is a byte code compiler with native JIT , it lacks the speed of ThinBasic + O2 ) , so I use Thinbasic for writing the "glue-code" and O2 to rewrite time critical things ... somewhat a miracle this works , because Lisp uses exact and inexact numbers ( in Lisp p.e. something as 1/7 is an exact number because it stores it as a rational number (both the 1 and the 7 in this case and knows how to process such numbers ).
As you mention few code is needed (I attached an image, and this is all the code : )
--------------------------------------
(require ffi/unsafe)
(define o2toR (ffi-lib "o2toRJulia")) ; get a handle for the C library (well, oxygen of course )
(define orbO2 (get-ffi-obj 'orbO2 corb (_fun _float _float _float _float _int -> _float )
(lambda () orbO2 )))
(define zijde 1200)
(define target (make-bitmap zijde zijde))
(define dc (new bitmap-dc% [bitmap target]))
(send dc set-background "DarkOliveGreen")
(send dc clear)
(define-values (cr ci info x y xo yo dz ro ro2 ) (values 0.143 0.6 '() 0 0 0 0 0 0 0))
(define (make-int n)
(inexact->exact (round (* (sqrt n) 7 )))) ; ----------------------------- parabolic gradient conversion of inexact numbers !!!
(define (draw-julia it)
(set! xo -1.5)
(set! yo -1.5)
(set! dz (/ 3 zijde))
(for ( [ i (range 0 zijde) ] )
(for ( [ j (range 0 zijde) ] )
(set! x (+ xo (* i dz)))
(set! y (+ yo (* j dz)))
(set! ro (orbO2 x y cr ci it))
(if (> 250 ro)
(send dc set-pixel i j (make-color 0 (make-int ro) 0 ))
#f)
)))
(define (init)
(displayln "System Ready")
(draw-julia 58)
(display "Image generated as JuliaO2.png ")
(send target save-file "JuliaO2.png" 'png)
)
(init)
---------------------------------------------------------------------------
& the ThinBasic script to generate the dll :
-----------------------------------------------------------
Uses "oxygen"
Dim o2 As String
O2=
"
% filename "o2toRJulia.dll"
% dll
include "RTL32.inc"
dim dup , orb as single
dim i as long
function corb (byval x as single , byval y as single ,byval cr as single ,
byval ci as single , byval it as integer ) as single export
for i=1 to it
dup=x
x=x*x-y*y+cr
y=2*dup*y+ci
orb=abs(x*y)
if orb > 3 then
exit for
endif
next
return orb
end function
"
O2_Basic o2
If O2_Errno Then
MsgBox 0, O2_Error
Stop
Else
O2_Exec
End If
MsgBox ,"DLL created"
-----------------------------------------------------------
result
below ;-) (oops, with a serious degradation )
best Rob
Hey, I'd like to thank you for all the information you've given. I'm looking for an apartment and this is helping me a lot!
John Spikowski
07-11-2014, 10:42
I'm looking for an apartment and this is helping me a lot!
I would be willing to bet that this new member is a bot.
ReneMiner
07-11-2014, 13:07
maybe it means he can now rent a very small apartment since he doesn't need too much space for houseplants?
:D :D :D
ErosOlmi
08-11-2014, 10:34
No, no, it means he/she used a recursive algorithm in order to find an apartment and thanks to that he/she succeeded.
:onthequiet:
John Spikowski
08-11-2014, 21:06
Eros,
You are truly the eternal optimist. Continuing with PB as your foundation of your BASIC is a testimonial of your faith.
Wow, what a fun thread. I had fun tonight playing with your guys code!!! Thanks.
My Fun:
'Press SpaceBar to make new trees, ESC to Exit
Uses "ui", "math"
#INCLUDE "abc.inc"
OpenWindow 800, 600
SetHandleDC hdc, hwnd
Dim depth As Long
Boolean cnt = FALSE
Sub MainDraw(x1, y1 As Long, angle As Single, d As Long)
Dim x2, y2 As Long
If d > 0 Then
x2 = x1 + Cos(DegToRad(angle)) * d * Rnd(5, 12)
y2 = y1 + Sin(DegToRad(angle)) * d * Rnd(5, 12)
Select Case Rnd(1,3)
Case 1 : DrawLine x1, y1, x2, y2, d, Rgb(180-d*10, 100-d, 100)
Case 2 : DrawLine x1, y1, x2, y2, d, Rgb(180-d*10, 90-d, 75)
Case 3 : DrawLine x1, y1, x2, y2, d, Rgb(180-d*10, 80-d, 50)
End Select
If cnt = TRUE Then
'DrawPoint(x2,y2,Rnd(5,20),Rnd(5,20),Rgb(0, 255-(d*25), 0))
DrawCircle(x2,y2,Rnd(5,20),Rnd(1,11),Rgb(0, 255-(d*25), 0))
EndIf
'Canvas_Redraw 'uncomment this if you want to see the tree draw
MainDraw(x2, y2, angle - 20, d-1)
MainDraw(x2, y2, angle + 20, d-1)
cnt = TRUE
End If
End Sub
Randomize
Do
Canvas_Clear &HFFF8F8
DrawPoint(0,550,800,50,Rgb(0, 175, 0))
For depth = 1 To 10000
SetPixel(Rnd(0,800),Rnd(550,600),Rgb(Rnd(50,200), Rnd(50,255), 0))
Next
depth = Rnd(8, 10)
MainDraw(400, 600, -90, depth)
Canvas_Redraw
cnt = FALSE
Loop While Asc(Canvas_WaitKey) <> 27
Canvas_Window End hwnd
9694 A Southern Oak Tree
Petr Schreiber
12-05-2017, 08:58
Pretty stylish tree, I like this modern art :)
Petr