L-system fractals!

Community Forums/Showcase/L-system fractals!

chwaga (Posted 2008) [#1]

Hi, I just thought I'd share with you some Lindenmayer system fractals a made a month back. The code is sloppy and probably uncommented, but you can make some pretty neat stuff with it. I only made 2: a (fake) Serpinski triangle, and a Dragon's curve. Find them here and here And for the source... Fractal1.exe: Graphics3D 1024, 768, 32, 2 Const Rule$ = "F+F-F-F+F" Const Angle# = 120 Global Length# = 10 Global a# = 0 Global iterations# = 0 Global LString$ = "F" DrawFractal() Repeat If KeyHit(57) Then KochIt() If MouseHit(2) Then Stop Until KeyHit(1) End Function DrawFractal() Cls RenderWorld() Local x1#, y1#, x2#, y2# x1 = 0 : y1 = 768 tmpstr$ = LString$ ;Scale the triangle by iteration count Length = -7*iterations + 54 For i = 1 To Len(tmpstr) If Mid$(tmpstr, i, 1) = "F" Then x2# = x1# + Length# * Cos(a) y2# = y1# + Length# * Sin(a) Line x1, y1, x2, y2 x1 = x2 : y1 = y2 EndIf If Mid$(tmpstr, i, 1) = "+" Then a = a - Angle EndIf If Mid$(tmpstr, i, 1) = "-" Then a = a + Angle EndIf Next Flip() End Function Function KochIt() tmpstr$ = LString$ Local x1, y1, x2, y2, a# x2 = 0 : y2 = 384 LString$ = "" For i = 1 To Len(tmpstr) tmpchr$ = Mid$(tmpstr, i, 1) If tmpchr$ = "F" Then LString = LString + Rule$ ElseIf tmpchr$ = "+" LString = LString + "+" ElseIf tmpchr$ = "-" LString = LString + "-" EndIf Next iterations = iterations+1 DrawFractal() End Function And Fractal2.exe: Graphics3D 1024, 768, 32, 2 Const Rule$ = "X+YF+" Const Rule2$ = "-FX-Y" Const Angle# = 90 Global Length# = 10 Global a# = 0 Global iterations# = 0 Global playerscale# = 1 Global LString$ = "FX" DrawFractal() Repeat If KeyHit(57) Then KochIt() If MouseHit(2) Then Stop If KeyHit(200) Then ScUp() If KeyHit(208) Then ScDown() Until KeyHit(1) End Function DrawFractal() Cls RenderWorld() Local x1#, y1#, x2#, y2# x1 = 640 : y1 = 525 tmpstr$ = LString$ ;Scale it by iteration count Length = 100-(iterations*8)*playerscale If length =< 0 Then length = 1 For i = 1 To Len(tmpstr) If Mid$(tmpstr, i, 1) = "F" Then ;COLORS!!!!!! c# = (255*i)/Len(tmpstr) Color c, -c, c x2# = x1# + Length# * Cos(a) y2# = y1# + Length# * Sin(a) Line x1, y1, x2, y2 x1 = x2 : y1 = y2 EndIf If Mid$(tmpstr, i, 1) = "+" Then a = a - Angle EndIf If Mid$(tmpstr, i, 1) = "-" Then a = a + Angle EndIf Next Text 0, 0, "Iteration " + iterations Text 0, 24, "Zoom = " + playerscale Flip() End Function Function ScUp() playerscale = playerscale - 0.05 DrawFractal() End Function Function ScDown() playerscale = playerscale + 0.05 DrawFractal() End Function Function KochIt() tmpstr$ = LString$ LString$ = "" For i = 1 To Len(tmpstr) tmpchr$ = Mid$(tmpstr, i, 1) If tmpchr$ = "X" Then LString = LString + Rule$ ElseIf tmpchr$ = "Y" LString = LString + Rule2$ ElseIf tmpchr$ = "+" LString = LString + "+" ElseIf tmpchr$ = "-" LString = LString + "-" EndIf Next iterations = iterations+1 DrawFractal() End Function Anyone who wants to modify this so it's more flexible is more than welcome! Try changing the angle values, you get some weird results. Check out the dragon (fractal2) at 75 degrees

chwaga (Posted 2008) [#2]

bah, it's cool and you know it! somebody comment on my day's work!!!!!!

Xzider (Posted 2008) [#3]

Neat

Torrente (Posted 2008) [#4]

It's cool, but it's also been done 2 or 3 times on these forums before ;) It'd be much neater if you made an .exe that could read a file containing the information about the L-system (rules, line-length, angles, etc...), and then saves that image. A lot easier to show your work that way. Also, make support for an arbitrary amount of rules, and then you'll be on a roll.

chwaga (Posted 2008) [#5]

nah, I'm busy :P

TomToad (Posted 2008) [#6]

I actually made something like that. It would read the commands from a .txt file, then compute it twice. First time without rendering, to figure out the extreme coordinates, then second time, scaling so it fits perfectly within the window. Unfortunately it is on my old drive so I don't have it available to show at the moment. Edit: Found it. Here is the source to the one I wrote. also it is a Blitz3D program and I never commented the code. Const TOKEN_EOL = 0 Const TOKEN_COMMAND = 1 Const TOKEN_STRING = 2 Const TOKEN_NUMBER = 3 Const STATE_NEWLINE = 0 Const STATE_INLINE = 1 Type turtle Field x#,y# Field theta# Field pendown Field penstuck End Type Global turtle.turtle = New turtle turtle\pendown = True Type turtlestack Field x#,y# Field theta# Field thetastep# Field movestep# End Type Type callstack Field editline$ Field position Field order End Type Type opstack Field op End Type Global thetastep# Global movestep# Global token$ Global level Global callstack.callstack Global minx#,miny#,maxx#,maxy# Dim linedef$(255) For t = 0 To 255 linedef$(t) = "default" Next Function TForward(distance#) DebugLog "forward" x# = turtle\x + Cos(turtle\theta) * distance y# = turtle\y + Sin(turtle\theta) * distance If turtle\pendown = True Then Line turtle\x,turtle\y,x,y turtle\x = x turtle\y = y If x < minx Then minx = x If x > maxx Then maxx = x If y < miny Then miny = y If y > maxy Then maxy = y End Function Function TRight(angle#) turtle\theta = turtle\theta + angle While turtle\theta > 180 turtle\theta = turtle\theta - 360 Wend While turtle\theta < -179 turtle\theta = turtle\theta + 360 Wend End Function Function TLeft(angle#) turtle\theta = turtle\theta - angle While turtle\theta < -179 turtle\theta = turtle\theta + 360 Wend While turtle\theta > 180 turtle\theta = turtle\theta - 360 Wend End Function Function TPenUp() If turtle\penstuck = False Then turtle\pendown = False DebugLog turtle\pendown End Function Function TPenDown() If turtle\penstuck = False Then turtle\pendown = True DebugLog turtle\pendown End Function Function TPush() turtlestack.turtlestack = New turtlestack turtlestack\x = turtle\x turtlestack\y = turtle\y turtlestack\theta = turtle\theta turtlestack\thetastep = thetastep turtlestack\movestep = movestep End Function Function TPop() turtlestack.turtlestack = Last turtlestack If turtlestack = Null Then RuntimeError "Turtle stack underflow error!!" turtle\x = turtlestack\x turtle\y = turtlestack\y turtle\theta = turtlestack\theta thetastep = turtlestack\thetastep movestep = turtlestack\movestep Delete turtlestack End Function Function parse() callstack.callstack = New callstack callstack\editline = linedef(0) callstack\position = 1 callstack\order = 0 Repeat While callstack\position > Len(callstack\editline) Delete callstack callstack.callstack = Last callstack If callstack = Null Then Return DebugLog "returning to "+callstack\editline+" position "+callstack\position Wend c$ = Mid(callstack\editline,callstack\position,1) DebugLog "testing "+c$ callstack\position = callstack\position + 1 If Asc(c$) <> - 1 If linedef(Asc(c$)) = "default" Or callstack\order = 1 Select(c$) Case "f" DebugLog "f" TForward(movestep) Case "g" DebugLog "g" TPenUp() TForward(movestep) TPenDown() Case "[" TPush() Case "]" TPop() Case "!" thetastep = -thetastep Case "-" DebugLog "-" TRight(thetastep) Case "+" DebugLog "+" TLeft(thetastep) Case "@" numvalue# = 0.0 position2 = callstack\position tc$ = Mid(callstack\editline,position2,1) While ((tc$ >= "0" And tc <= "9") Or tc = ".") And position2 <= Len(callstack\editline) position2 = position2 + 1 tc$ = Mid(callstack\editline,position2,1) Wend numvalue = Mid(callstack\editline,callstack\position,position2-callstack\position) movestep = movestep * numvalue End Select Else DebugLog "calling "+c$ order = callstack\order callstack.callstack = New callstack callstack\editline = linedef(Asc(c$)) callstack\position = 1 If order = 0 callstack\order = level Else callstack\order = order - 1 End If End If End If Forever End Function Graphics 1024,768,32,0 Cls com$ = CommandLine() If com$ <> "" filename$ = Mid(com,2,Len(com)-2) Else filename$ = Input("Input file To parse: ") End If lineno = 0 filein = ReadFile(filename) If filein = 0 Then RuntimeError "error opening file "+filename While Not Eof(filein) c$ = Lower(ReadLine(filein)) lineno = lineno + 1 position = 0 Repeat If position > Len(c$) Then Exit position = position + 1 Until Mid(c$,position,1) <> " " If position <= Len(c$) c$ = Right(c$,(Len(c$)-position)+1) Select Left(c$,5) Case "angle" numvalue# = 0 position = 7 position2 = 7 If Len(c$) > 6 tc$ = Mid(c$,position2,1) While ((tc$ >= "0" And tc <= "9") Or tc = ".") And position2 <= Len(c$) position2 = position2 + 1 tc$ = Mid(c$,position2,1) Wend numvalue = Mid(c$,position,position2-position) End If DebugLog "Angle " + numvalue +" "+ position+" " + position2 If numvalue = 0 Or numvalue >= 360 Then RuntimeError "line "+lineno+": Angle must be >0 And <360" thetastep = numvalue Case "axiom" If linedef(0) = "default" Then linedef(0) = "" position = 6 Repeat tc$ = Mid(c$,position,1) position = position + 1 Until (tc$ <> " " And tc$ <> "=") Or position > Len(c$) position = position - 1 If position <= Len(c$) While position <= Len(c$) And Mid(c$,position,1) <> " " And Mid(c$,position,1) <> ";" linedef(0) = linedef(0) + Mid(c$,position,1) position = position + 1 Wend Else RuntimeError "Axiom not defined" End If DebugLog linedef(0) Default DebugLog "here" tc$ = Left(c$,1) If tc <> ";" position = 2 While Mid(c$,position,1) = " " And position <= Len(c$) position = position + 1 Wend If Mid(c$,position,1) <> "=" Or position > Len(c$) Then RuntimeError "line "+lineno+": missing =" position = position + 1 If linedef(Asc(tc)) = "default" Then linedef(Asc(tc)) = "" While position <= Len(c$) While Mid(c$,position,1) = " " And position <= Len(c$) position = position + 1 Wend If position <= Len(c$) If Mid(c$,position,1) <> ";" linedef(Asc(tc)) = linedef(Asc(tc)) + Mid(c$,position,1) position = position + 1 Else Exit End If End If Wend DebugLog tc+"="+linedef(Asc(tc)) End If End Select End If Wend Repeat Cls level = Input("Level? ") If level = 0 Then Exit Cls Print "Thinking......" turtle\x = 0 turtle\y = 0 turtle\theta = -90 movestep = 10 TPenUp() ; turtle\penstuck = True minx# = 0 miny# = 0 maxx# = 0 maxy# = 0 parse() Cls maxx = maxx - minx maxy = maxy - miny If maxx/maxy > 1.333333333333 scale# = 1023.0/maxx Else scale# = 767.0/maxy End If turtle\x = -minx*scale turtle\y = -miny*scale turtle\theta = -90 movestep = 10*scale turtle\penstuck = False TPenDown() parse() WaitKey() Forever Here is hilbert.ls angle 90 axiom=x x=-yf+xfx+fy- y=+xf-yfy-fx+

Axel Wheeler (Posted 2008) [#7]

Very cool. Even if it's been done before, nothing stretches your brain like implementing something like this. I would add a percent complete indicator and a cancel option during processing. Well done Chwaga!