Drawing Fractals Using the L-Systems Technique

akj · Post by **akj** » Tue May 02, 2006 7:55 pm

I noticed in the book "Advanced Fractal Programming in C" by Roger T. Stevens a chapter about drawing fractals using the L-Systems technique and I thought it would make a nice mini-project for programming in PureBasic.

This technique/language was first developed by Aristid Lindenmayer, who used it to describe the geometric structure of plants.

The program is somewhat unusual in that it uses co-routines in which one procedure Generate() calls another procedure Draw() which in turn calls Generate() which calls Draw() which ...
A side effect of this was the difficulty in determining the proper scope for variables. In the end, many had to be made global despite my attempts to avoid this.

I hope you enjoy experimenting with the program.

Code: Select all

; L-Systems  AKJ  02-May-06
; Advanced fractal Programming in C  Roger Stevens  Page 256

#Program$ = "L-Systems"
#Version$ = "1.0"
Global inifile$ = ".\"+#Program$+".ini"
EnableExplicit

;- Declarations
Declare Abort(msg$)
Declare.s StrRev(x$)
Declare butDraw_Click(new.b, imgw, imgh)
Declare Generate(type, X1.d, Y1.d, X2.d, Y2.d, line_dim.d, level)
Declare Draw(type, level, turtle_r.d) ; Was step()
;}

;- Constants
Enumeration
  #ini
  #winMain
  #lblFractal
  #cboFractal
  #lblLines
  #chkFast
  #lblWait
  #butDraw
  #butDrawNext
  #butExit
  #imgFractal
  #Fractal ; The drawing
EndEnumeration
;}

;- Globals
Global level
Global fast.b=#False ; True if fractal is to be drawn as quickly as possible
Global lines ; Number of lines drawn
Global start_x, start_y, start_a
Global divisor.d, div2.d, div3.d
Global angle.d, first_line.d
Global turtle_x.d, turtle_y.d, turtle_a.d
Global Dim generator$(10)
;}

;- GUI metrics
Define gap, lblw, lblh, txtw, txth, cbow, cboh, chkw, chkh, butw, buth
Define imgw, imgh, winw, winh, x0, x1, x2, x3
gap=20
imgw=640: imgh=480
winw = imgw+gap*2
butw=140: buth=30
lblw=100: lblh=20
x0 = gap: x1 = gap+lblw: x3 = imgw-butw+gap: x2 = (x1+x3)/2
cbow=x2-x1+butw: cboh=lblh
chkw=lblw: chkh=lblh
txtw=cbow: txth=cboh
winh = cboh+buth+imgh+gap*4
;}

;- Display GUI
Define y
OpenWindow(#winMain, 100, 0, winw, winh, #Program$+":  Generate Fractal Curves")
CreateGadgetList(WindowID(#winMain))
y = gap
TextGadget(#lblFractal, x0, y, lblw, lblh, "Fractal to draw:")
ComboBoxGadget(#cboFractal, x1, y-4, txtw, txth*20)
TextGadget(#lblLines, x3, y, butw+gap, lblh, "")
y + cboh+gap
CheckBoxGadget(#chkFast, x0, y+4, chkw, chkh, "Draw Fast")
  GadgetToolTip(#chkFast, "In fast mode, the fractal is not displayed until fully drawn")
TextGadget(#lblWait, x0, y+chkh+6, chkw, lblh, "")
ButtonGadget(#butDraw, x1, y, butw, buth, "Draw  First  Level")
ButtonGadget(#butDrawNext, x2, y, butw, buth, "Draw  Next  Level")
  DisableGadget(#butDrawNext, #True)
ButtonGadget(#butExit, x3, y, butw, buth, "E x i t")
y + buth+gap
ImageGadget(#imgFractal, x0, y, imgw, imgh, 0, #PB_Image_Border)
;}

;- Populate combo box with names of fractals listed in INI file
Define cboSelected, cboSelectedOld
NewList Fractals$()
If OpenPreferences(inifile$)=0
  Abort("Cannot read INI file")
EndIf
ExaminePreferenceGroups()
NextPreferenceGroup() ; Skip template
While NextPreferenceGroup()
  AddElement(Fractals$()): Fractals$() = Trim(PreferenceGroupName())
Wend
ClosePreferences()
SortList(Fractals$(), 2)
ForEach Fractals$()
  AddGadgetItem(#cboFractal, -1, Fractals$())
Next Fractals$()
ClearList(Fractals$()) ; Free memory
SetGadgetText(#cboFractal, GetGadgetItemText(#cboFractal, 0, 0))
cboSelectedOld = 0
;}

;- Event loop  15-Feb-06
Define done=#False, ev
Repeat
  ev = WaitWindowEvent()
  If ev=#PB_Event_Menu: ev=#PB_Event_Gadget: EndIf ; To map shortcut keys to gadgets
  Select ev
  Case #PB_Event_Gadget
    Select EventGadget()
    Case #cboFractal
      If EventType()=#PB_MouseButton_Left
        ; See whether a new fractal has been selected
        cboSelected = GetGadgetState(#cboFractal)
        If cboSelectedOld<>cboSelected
          cboSelectedOld = cboSelected
          DisableGadget(#butDrawNext, #True)
          SetGadgetText(#butDrawNext, "Draw  Next  Level")
        EndIf
      EndIf
    Case #chkFast
      fast = GetGadgetState(#chkfast)
    Case #butDraw
      butDraw_Click(#True, imgw, imgh)
    Case #butDrawNext
      butDraw_Click(#False, imgw, imgh)
    Case #butExit
      done=#True
    EndSelect
  Case #PB_Event_CloseWindow
    done=#True
  EndSelect
Until done
;}
End

Procedure Abort(msg$)
  MessageRequester(#program$+" Error", msg$,#MB_ICONERROR)
  End
EndProcedure

Procedure.s StrRev(x$)
; Return the input string, reversed end-for-end
Protected i, y$=""
For i=Len(x$) To 1 Step -1
  y$ + Mid(x$, i, 1)
Next i
ProcedureReturn y$
EndProcedure

Procedure butDraw_Click(new.b, imgw, imgh)
; Draw one level of the fractal
; new = True if the fractal is to be drawn from the beginning

Protected fractal$ ; Fractal name
Protected i ; Loop counter
DisableGadget(#butDraw, #True)
DisableGadget(#butDrawNext, #True)
If new
  fractal$ = GetGadgetText(#cboFractal)
  If Len(fractal$)=0: ProcedureReturn: EndIf
  ; Read parameters from INI file
  If OpenPreferences(inifile$)=0
    Abort("Cannot read INI file")
  EndIf
  PreferenceGroup(fractal$)
  generator$(0) = ReadPreferenceString("Init", "") ; Initiator
  generator$(1) = ReadPreferenceString("S Gen", "") ; Skip (d)
  generator$(2) = ReadPreferenceString("D Gen", "") ; Draw line
  generator$(3) = ReadPreferenceString("L Gen", "") ; Left
  generator$(4) = ReadPreferenceString("R Gen", "") ; Right
  generator$(5) = ReadPreferenceString("X Gen", "") ; Draw line
  generator$(6) = ReadPreferenceString("Y Gen", "") ; Draw line
  generator$(7) = ReadPreferenceString("T Gen", "") ; Draw line
  start_x = ReadPreferenceLong("Start X", 0) ; Starting X co-ordinate
  start_y = ReadPreferenceLong("Start Y", -160) ; Starting Y co-ordinate
  start_a = ReadPreferenceLong("Start A", 0) ; Starting angle
  divisor = ReadPreferenceDouble("Div 1", 1.0) ; Divisor
  div2 = ReadPreferenceDouble("Div 2", 1.0) ; Second divisor
  div3 = ReadPreferenceDouble("Div 3", 1.0) ; Third divisor
  angle = ReadPreferenceDouble("Angle", 0.0) ; Angle
  first_line = ReadPreferenceDouble("Line", 200.0) ; Line length
  ClosePreferences()
  ; Create bottom side generator B (8)
  ; Method:  Interchange all angle signs and interchange T's with B's and t's with b's
  generator$(8) = ""
  For i=1 To Len(generator$(7))
    Select Mid(generator$(7), i, 1)
      Case "+": generator$(8)+"-"
      Case "-": generator$(8)+"+"
      Case "T": generator$(8)+"B"
      Case "B": generator$(8)+"T"
      Case "t": generator$(8)+"b"
      Case "b": generator$(8)+"t"
      Default: generator$(8)+Mid(generator$(7), i, 1)
    EndSelect
  Next i
  ; Create backward generators t & b (9 & 10) by reversing T and B
  ; Then interchange all the {} and <> pairs
  generator$(9) = StrRev(generator$(7))
  ReplaceString(generator$(9), "{", "¬", 2)
  ReplaceString(generator$(9), "}", "{", 2)
  ReplaceString(generator$(9), "¬", "}", 2)
  ReplaceString(generator$(9), "<", "¬", 2)
  ReplaceString(generator$(9), ">", "<", 2)
  ReplaceString(generator$(9), "¬", ">", 2)
  generator$(10) = StrRev(generator$(8))
  ReplaceString(generator$(10), "{", "¬", 2)
  ReplaceString(generator$(10), "}", "{", 2)
  ReplaceString(generator$(10), "¬", "}", 2)
  ReplaceString(generator$(10), "<", "¬", 2)
  ReplaceString(generator$(10), ">", "<", 2)
  ReplaceString(generator$(10), "¬", ">", 2)
  level = 0
EndIf ; begin
; Initialise drawing
If Not IsImage(#fractal)
  CreateImage(#fractal, imgw, imgh)
EndIf
If fast: DisableGadget(#butExit, #True): EndIf
StartDrawing(ImageOutput(#fractal))
Box(0,0, imgw,imgh, #Green) ; Cls
FrontColor(#Black)
; Draw one level
turtle_x = start_x
turtle_y = start_y
level + 1
SetGadgetText(#butDrawNext, "Drawing  Level  "+Str(level))
lines=0
Generate(0, start_x, start_y, 0, start_a, first_line*divisor, level)
StopDrawing()
SetGadgetState(#imgFractal, ImageID(#fractal))
SetGadgetText(#lblLines, Str(lines)+" Lines drawn")
SetGadgetText(#lblWait, "")
SetGadgetText(#butDrawNext, "Draw  Level  "+Str(level+1))
DisableGadget(#butDraw, #False)
DisableGadget(#butDrawNext, #False)
DisableGadget(#butExit, #False)
EndProcedure


Procedure Generate(type, X1.d, Y1.d, X2.d, Y2.d, line_dim.d, level)
; Draw one fractal level
Protected turtle_r.d
Protected j
Static index=0 ; Could level be used instead ??? !!!
Static Dim store_x.d(32) ; Stacks for processing '[' and ']'
Static Dim store_y.d(32)
Static Dim store_a.d(32)
turtle_x = X1
turtle_y = Y1
If type=0
  turtle_a = Y2
EndIf
turtle_r = line_dim/divisor
level - 1
For j=1 To Len(generator$(type))
  Select Mid(generator$(type), j, 1)
    Case "S","d": Draw( 1, level, turtle_r) ; Skip
    Case "D": Draw( 2, level, turtle_r) ; Draw line
    Case "T": Draw( 7, level, turtle_r)
    Case "B": Draw( 8, level, turtle_r)
    Case "t": Draw( 9, level, turtle_r)
    Case "b": Draw(10, level, turtle_r)
    Case "L": Draw( 3, level, turtle_r)
    Case "H": Draw(11, level, turtle_r) ; Halt ???
    Case "R": Draw( 4, level, turtle_r)
    Case "X": Draw( 5, level, turtle_r)
    Case "Y": Draw( 6, level, turtle_r)
    Case "+": turtle_a+angle ; Rotate
    Case "-": turtle_a-angle
    Case "["
      store_x(index) = turtle_x
      store_y(index) = turtle_y
      store_a(index) = turtle_a
      index + 1
    Case "]"
      index - 1
      turtle_x = store_x(index)
      turtle_y = store_y(index)
      turtle_a = store_a(index)
    Case "{": turtle_r/div2 ; Scale
    Case "}": turtle_r*div2
    Case "<": turtle_r/div3
    Case ">": turtle_r*div3
  EndSelect
Next j
EndProcedure


Procedure Draw(type, level, turtle_r.d) ; Was step()
Protected x1.d, y1.d
x1 = turtle_x
y1 = turtle_y
turtle_x + turtle_r*Sin(turtle_a*#PI/180.0)
turtle_y + turtle_r*Cos(turtle_a*#PI/180.0)
If level>0 And type<>11  ; If not halt ???
  Generate(type, x1, y1, turtle_x, turtle_y, turtle_r, level)
ElseIf type<>1 ; If not skip
  LineXY(x1+320, 239-y1, turtle_x+320, 239-turtle_y) ; Draw line
  lines + 1
  If fast=#False ; If in slow mode ...
    If lines&$FF=0 ; Every 256 lines drawn, run the code below
      StopDrawing()
      SetGadgetState(#imgFractal, ImageID(#fractal)) ; Refresh image
      While WindowEvent() ; Do events
        If EventGadget()=#butExit: End: EndIf
      Wend
      fast = GetGadgetState(#chkfast)
      If fast
        SetGadgetText(#lblWait, "Please wait ...")
        DisableGadget(#butExit, #True)
      EndIf
      StartDrawing(ImageOutput(#fractal))
    EndIf ; lines
  EndIf ; fast
EndIf ; type
EndProcedure

The program uses a file L-Systems.ini which has the following contents:

Code: Select all

; L-Systems
; Advanced Fractal programming in C  Roger Stevens

; Most values default to "" or 0
; 'Start Y' defaults to -160
; Divisors default to 1
; 'Line' defaults to 200

[Template]
; Page 
Init = 
S Gen = 
D Gen = 
L Gen = 
R Gen = 
X Gen = 
Y Gen = 
T Gen = 
Start X = 
Start Y = 
Start A = 
Div 1 = 
Div 2 = 
Div 3 = 
Angle = 
Line = 

[Snowflake: von Koch]
; Page 213
Init = D--D--D
D Gen = D+D--D+D
Start X = -150
Start Y = -120
Start A = 90
Div 1 = 3
Angle = 60
Line = 300

[Gosper]
; Page 214
Init = D+++D+++D+++D+++D+++D
D Gen = -D+++D---D+
Start X = -150
Start Y = -100
Div 1 = 2.645751
Angle = 20
Line = 180

[Quadric: von Koch 18-Segment]
; Page 217
Init = D+D+D+D
D Gen = D-DD+DD+D+D-D-DD+D+D-D-DD-DD+D
Start X = -150
Start Y = -120
Div 1 = 6
Angle = 90

[Islands]
; Page 219
Init = D+D+D+D
S Gen = SSSSSS
D Gen = D+S-DD+D+DD+DS+DD-S+DD-D-DD-DS-DDD
Start X = -150
Start Y = -120
Div 1 = 6
Angle = 90
Line = 250

[Peano]
; Page 221
Init = D
D Gen = D-D+D+DD+D+D+DD
Div 1 = 3
Angle = 90
Line = 300

[Cesaro]
; Page 223
Init = R
L Gen = +R--R+
R Gen = -L++L-
Start X = -150
Start Y = -120
Start A = 90
Div 1 = 1.414120
Angle = 45
Line = 300

[Dragon: Harter-Heightway]
; Page 225
Init = R
L Gen = +L--R+
R Gen = -L++R-
Start X = -150
Start Y = -120
Start A = 90
Div 1 = 1.414120
Angle = 45
Line = 300

[Peano-Gosper]
; Page 227
Init = R
;L Gen = L+R+RR-L--L-R+
L Gen = L+R++R-L--LL-R+
R Gen = -L+RR++R+L--L-R
Start X = -120
Start Y = 100
Start A = 90
Div 1 = 2.645800
Angle = 60
Line = 300

[Sierpinski Triangle]
; Page 229
Init = R
L Gen = +R-L-R+
R Gen = -L+R+L-
Start X = -150
Start Y = -120
Start A = 90
Div 1 = 2
Angle = 60
Line = 300

[Hilbert]
; Page 231
Init = T
D Gen = DXX
T Gen = +BDX-TDT-XDB+
Start X = -150
Start Y = -120
Div 1 = 2.333333
Angle = 90

[Snowflake: Peano 7-Segment]
; Page 234
Init = T
T Gen = --Bt++t++t+++{b}-----Bt
Start X = -150
Start Y = -120
Start A = 90
Div 1 = 3
Div 2 = 0.577350
Angle = 30
Line = 300

[Snowflake: 13-Segment]
; Page 236
Init = T
T Gen = --BT++T++T+++++{TB--B--B---}T{+++++TB}-----BT
Start X = -150
Start Y = -120
Start A = 90
Div 1 = 3
Div 2 = 1.732051
Angle = 30
Line = 300

[Snowflake: Split Halls]
; Page 238
Init = T
S Gen = SSSSSS
T Gen = --Bt++T++t+++++{tB--b--bT}---bT
Start X = -150
Start Y = -120
Start A = 90
Div 1 = 3
Div 2 = 1.732051
Angle = 30
Line = 300

[Tree 1]
; Page 240
Init = X
D Gen = DD
X Gen = D[+X]D[-X]+X
Div 1 = 2
Angle = 22.5
Line = 180

[Tree 2]
; Page 242
Init = D
D Gen = D[+D]D[-D]D
Div 1 = 2.7
Angle = 26.5

[Tree 3]
; Page 244
Init = X
D Gen = DD
X Gen = D[+X][-X]DX
Start Y = -200
Div 1 = 2
Angle = 27.9

[Tree 4]
; Page 246
Init = D
D Gen = DD-[-D+D+D]+[+D-D-D]
Start Y = -200
Div 1 = 2
Angle = 23
Line = 110

[Tree 5]
; Page 248
Init = X
D Gen = DD
X Gen = D-[[X]+X]+D[+DX]-X
Start A = 0
Div 1 = 2
Angle = 22.7
Line = 150

[Tree 6]
; Page 250
Init = D
D Gen = D[+D]D[-D][D]
X Gen = D[+X][-X]DX
Start Y = -200
Start A = 0
Div 1 = 2
Angle = 29.3

[Bush]
; Page 252
Init = RLDDD
D Gen = D
L Gen = [-DDD][+DDD]D
R Gen = [+++X][---X]TR
X Gen = +Y[-X]L
Y Gen = -X[+Y]L
T Gen = TL
Start Y = -150
Div 1 = 1.3
Angle = 18
Line = 60

rsts · Post by **rsts** » Tue May 02, 2006 8:32 pm

Pretty tricky way to get us started

Nice stuff.

cheers

have to see if i can add some background color options

netmaestro · Post by **netmaestro** » Tue May 02, 2006 8:39 pm

Really neat! I enjoyed playing with it.

MrMat · Post by **MrMat** » Wed May 03, 2006 12:34 am

Good fun! Cheers