[bb] LSystem Fractals by MuffinRemnant [ 1+ years ago ]

[BlitzBot]

Title : LSystem Fractals
Author : MuffinRemnant
Posted : 1+ years ago

Description : Note: some permutations can take a long time to draw!

Code :

Code (blitzbasic) Select Expand

;------------------------------------------------------
;
; Program:
;
; LSystem3 v1.1
;
;
; Description:
;
; Simple Lindermayer (LSystem) Fractal Generator
; (Blitz Basic 2D)
;
;
; Author:
;
; Paul Robinson (MuffinRemnant)
; email paulrobinson123@aol.com
;
;
; Changes in this version:
;
; - removed recursive function to increase speed (!)
; - added mouse controls for zoom and move
;
; Date:
;
; 13/09/02
;
;
;------------------------------------------------------
;
; Notes:
;
; What does this program do? It generates simple LSystem
; fractals. Essentially this type of fractal consists of
; an 'axiom' (the starting information) and a 'rule' or
; re-write string, which together can generate complex
; and sometimes interesting patterns.
;
; It works like this.....
; Take the axiom string (say "F+F+F") and for each occurence
; of F replace it with the rule string (say "F-FF+F).
;
; In this example the new axiom string would become...
;
; (F-FF+F) + (F-FF+F) + (F-FF+F)
;
; We can apply the rule to the new axiom string again to get
; another (longer) axiom and so on.
;
; When we've done this enough times we can render the resulting
; string interpreting each character as follows...
;
;
; F = Move forward and draw line
; + = Turn by turning_angle
; - = Turn by -turning_angle
; G = Go forward do not draw line
; R = Reverse do not draw line
;
; This program operates on a limited 'command set' compared to
; many LSystem programs - some have the facility to change drawing
; colours, have incremental angle changes, render polygons etc etc
;
; These are all very straightforward to implement but they can reduce
; the speed of the program considerably - as will long axiom/rule strings
; (or running with Debug enabled!).
;
;
;
;
; I've rewritten this program using arrays,banks and strings
; and found this version to be the best. If you can think of a quicker
; way to accomplish the same result - LET ME KNOW!
;
;
;
;
;
; A few interesting combinations:
;
; 'Creature'
; Axiom F+F+F+F
; Rule F-GF-F-
; Iterations 6
; Turning angle 89
;
;
; 'Starfish Spawn'
; Axiom F+FF-F
; Rule F-F-FF-F
; Iterations 5
; Turning angle 99
;
;
; 'Tri-lobe'
; Axiom F+F+F
; Rule F-FF
; Iterations 8
; Turning angle 77
;
;
; 'Spirograph'
; Axiom F+F-F
; Rule F+F+F
; Iterations 5
; Turning angle 84
;
;
; 'FIL Soup'
; Axiom F+FF+F
; Rule F+FGF
; Iterations 5
; Turning angle 96
;
;
; 'Sun Crescent'
; Axiom F-F-F-F
; Rule FGF+G
; Iterations 8
; Turning angle 99
;
;
; 'Octospiral'
; Axiom F+F++F
; Rule F+F-G
; Iterations 9
; Turning angle 90
;
;
; 'Muscle man'
; Axiom F
; Rule FR+F-GG
; Iterations 12
; Turning angle 94
;
;
;
;------------------------------------------------------
;
;
; Controls (such as they are)...
;
; Left mouse button - zoom in
; Right mouse button - zoom out
; Both mouse buttons - drag fractal
;
; + and - keys for next and previous iteration
;
; esc - exit
;
;
;
; For most axiom/rule sets going above iteration 10 will
; be very slow!
;
;
;
; You need to change the axiom/rule by modifying the
; globally declared string before running the program
;
;------------------------------------------------------






Graphics 800,600,16,1
SetBuffer BackBuffer()



; Globals
;
Global axiom$="F+F+F+F"
Global rule$="FF-FGF"
Global temp$
Global t2$
Global turning_angle=89
Global zoom#=6

; locals
Local startx#=400, starty#=300
Local iteration=3

Local time1,time2 ; for timing
Local time3,time4

Local mmx, mmy, xs, ys ; for mouse



; trig look ups
Dim sinlut#(360)
Dim coslut#(360)

; init trig tables
recalc_lut()






; create initial view
Cls
; expand the original axiom by i iterations
temp$=axiom$
time1=MilliSecs()
expand(iteration)
time2=MilliSecs()
Flip







;main loop
While Not KeyDown(1)


Cls


; display fractal and information
time3=MilliSecs()
render(startx, starty)
time4=MilliSecs()

Color 255,255,255
Text 0, 0, "String size " + Len(temp$) + " bytes"
Text 0, 16, "Iterations " + iteration
Text 0, 32, "Zoom " + Int(zoom) + "X"
Text 0, 64, "Expansion time " + (time2-time1) + " milliseconds"
Text 0, 80, "Render time " + (time4-time3) + " milliseconds"

; great mouse cursor!
Rect MouseX(), MouseY(), 4, 4, 1

Color 0,255,0


Flip




button$="none"
If MouseDown(1) Then button$="left"
If MouseDown(2) Then button$="right"
If MouseDown(1) And MouseDown(2) Then button$="both"


; zoom in
If button$="left" Then

zoom = zoom + 0.2
recalc_lut()

EndIf

; zoom out
If button$="right" Then

If zoom > 1.2 Then
zoom = zoom - 0.2
recalc_lut()
EndIf

EndIf

; click and drag
If button$="both"

xs = MouseXSpeed()
ys = MouseYSpeed()

startx=startx+xs
starty=starty+ys

EndIf

mmx=MouseXSpeed()
mmy=MouseYSpeed()


; iteration up/down keys...
;
;

If KeyDown(13) Then ; "="
iteration=iteration+1
temp$=axiom$
time1=MilliSecs()
expand(iteration)
time2=MilliSecs()
While KeyDown(13)
FlushKeys()
Wend
EndIf

If KeyDown(12) Then ; "-"
If iteration > 1 Then iteration=iteration-1
temp$=axiom$
time1=MilliSecs()
expand(iteration)
time2=MilliSecs()
While KeyDown(12)
FlushKeys()
Wend
EndIf


Wend
End







; recalculate the trig look up tables
; including current zoom factor
Function recalc_lut()


For loop=0 To 359

sinlut(loop)=Sin(loop) * zoom
coslut(loop)=Cos(loop) * zoom

Next



End Function












Function expand(n)


Repeat



;replace each occurence of F with rewrite rule
t2$ = ""
lng = Len(temp$) + 1
p=1

Repeat

c$ = Mid$(temp$, p, 1)
If c$ = "F" Then

t2$=t2$ + rule$

Else

t2$=t2$ + c$

EndIf

p=p+1

Until p=lng

temp$=t2$



n=n-1

Until n=0


End Function




; render the 'command sequence' in temp$
Function render(x#, y#)

Local loop=1, l=Len(temp$), angle=0, ox#, oy#, cv#, sv#, col=128

Color 0,col,0

Repeat




c$=Mid$(temp$, loop, 1)

Select c$

Case "F"

ox=x
oy=y
x=x+cv
y=y+sv

Line ox, oy, x, y
;Rect x,y,4,4,0

Case "G"

ox=x
oy=y
x=x+cv
y=y+sv



Case "R"

ox=x
oy=y
x=x-cv
y=y-sv


Case "C"

col=col+1
Color col,0,0


Case "+"

angle=angle+turning_angle

If angle > 359 Then angle = angle - 360

cv=coslut(angle)
sv=sinlut(angle)


Case "-"

angle=angle-turning_angle

If angle < 0 Then angle = angle + 360

cv=coslut(angle)
sv=sinlut(angle)

End Select

loop=loop+1

Until loop > l



End Function

Comments : none...