L-system generator

Interactive fractal generator

This demo is based on L-system workshop by Andrea Magnorsky and Ross McKinlay. Rather than working on the tasks they gave us, I compiled it with Fable, so that you can play with it in a browser!

The demo lets you enter a simple L-system with a single entry point and a number of rewriting rules written using ->. You can use letters to draw a line forward, - and + to turn (left and right) and ! to randomly change color. It also supports brackets, e.g. [[-X]+X], for undoing state changes.


L-System Configuration
Number of iterations (0 to 10):
Rotation angle (0 to 180):
Line width (1 to 10):

Rendering fractals with SVG

The demo uses SVG to render fractals. Once the fractal is generated, it is turned into a sequence of lines that are then rendered. Each line has a starting and ending point together with a color. We represent this using a simple F# domain model:

1: 
2: 
3: 
type Point = { x : float; y : float }
type Color = { r:int; g:int; b:int; }
type LineSegment = {startPoint : Point; endPoint : Point; color : Color }

When rendering lines, we generate <svg> tag containing a number of <line> elements. This is done using a simple helper library (which you can find in the Fable repository). The library uses the dynamic operator ? to generate SVG elements. For example, you can write:

1: 
2: 
3: 
s?svg [ "width" => 600 ] [
  s?line [ "x1" => 100; "y1" => 100; "x2" => 200; "y2" => 200 ]
]

The result of s?svg is a function that takes a list of attributes and a list of nested elements. Writing a rendering function is now easy - we just generate root SVG element with a line for each LineSegment. The only slightly complex aspect is that we re-scale the image to fit into the 600x600 box automatically:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
let render lineWidth lines =
  // Calculate minimal and maximal X/Y values for scaling
  let xs = lines |> Seq.collect (fun l -> [l.startPoint.x; l.endPoint.x])
  let ys = lines |> Seq.collect (fun l -> [l.startPoint.y; l.endPoint.y])
  let minx, maxx = Seq.min xs, Seq.max xs
  let miny, maxy = Seq.min ys, Seq.max ys
  let convx x = (x - minx) / (maxx - minx) * 600.0
  let convy y = (y - miny) / (maxy - miny) * 600.0

  // Generate root SVG tag with line tag for each line sgement
  s?svg ["width" => 600; "height" => 600] [
    for line in lines ->
      s?line
        [ "x1" => convx line.startPoint.x; "y1" => convy line.startPoint.y
          "x2" => convx line.endPoint.x; "y2" => convy line.endPoint.y
          "style" =>
            sprintf "stroke:rgb(%i,%i,%i);stroke-width:%i"
              line.color.r line.color.g line.color.b lineWidth ] []
  ]

From turtle graphics to line sgemnets

To make the evaluation of L-systems easier, we first turn L-system into commands of a simple turtle graphics engine:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
type LogoCommand =
  | DrawForward of float
  | Turn of float
  | Push
  | Pop
  | RandomColor

type LTurtle =
  { angle : float
    x : float
    y : float
    c : Color}

The DrawForward and Turn commands move the turtle forward or rotate it. The Push and Pop commands are used to implement the brackets - Push stores the current state of the turtle and Pop restores the previous state. Finally, RandomColor corresponds to ! and changes the color to a new, randomly generated one:

1: 
2: 
3: 
4: 
5: 
let chaos = System.Random()
let randomColor() =
  { r = (chaos.Next 256);
    g = (chaos.Next 256);
    b = (chaos.Next 256) }

The interpreter of the turtle graphics needs to keep track of the current position and direction of the turtle. It iterates over the commands one by one and either updates the current state or generates a line segment:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
/// interprets a logo program and produces a line segment list to render
let processTurtle turtle program =
  let rec phono stack output turtle = function
    | [] -> output
    | RandomColor :: t ->
        // Change current color of the turtle
        phono stack output { turtle with c = randomColor() } t
    | Push :: t ->
        // Store current state on the stack
        phono (turtle::stack) output turtle t
    | Pop :: t when List.isEmpty stack ->
        // Silently ignore errors when stack is empty
        phono stack output turtle t
    | Pop :: t ->
        // Pop the most recent turtle state from the stack
        phono (List.tail stack) output (List.head stack) t

    | DrawForward d :: t ->
        // Move forward by `d` in the current direction
        let rads = turtle.angle * (System.Math.PI / 180.0)
        let x = turtle.x + d * cos rads
        let y = turtle.y + d * sin rads
        let newTurtle = {turtle with x = x; y= y }
        let seg =
          { startPoint = {x = turtle.x; y = turtle.y}
            endPoint = {x = x; y = y}; color = turtle.c }
        phono stack (seg::output) newTurtle t

    | Turn delta :: t ->
        // Rotate by the specified angle
        let d = turtle.angle + delta
        let d =
          if delta > 0.0 && d > 360.0 then d - 360.0
          elif delta < 0.0 && d < 0.0 then 360.0 + d
          else d
        phono stack output {turtle with angle = d} t

  List.rev (phono [] [] turtle program)

Processing and rendering L-systems

An L-system is represented by an initial state (called an axiom) and a function that returns the production (new L-system string on the right of ->) for a given character:

1: 
2: 
3: 
type LSystem =
  { Axiom : string
    Productions : char -> string }

When processing an L-system, we start with an initial string and repeatedly (for a given number of iterations) replace all the characters in the string with a new string produced by the Productions function. To do this efficiently, we're going to use mutable JavaScript arrays. In JavaScript, you can call ar.push(x) on an array ar to add an element x to the end of the array. We can use F# extensions and Emit attribtue to enable calling this member on an F# array (this is slightly ugly, but it does the trick!):

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8: 
[<Fable.Core.Emit("$0.push($1)")>]
let push (sb:'a[]) (v:'a) = failwith "js"
[<Fable.Core.Emit("$0.join($1)")>]
let join (sb:'a[]) (sep:string) = failwith "js"

type ``[]``<'a> with
  member x.push(v) = push x v
  member x.join(s) = join x s

Now we have everything we need to implement a function that processes the L-system:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
let processLsystem max lsystem =
  let rec gen (current:string) iteration =
    if iteration = max then current else
    // Iterate over characters, appending the result of
    // production to the mutable array `sb` of strings
    let sb = [||]
    for x in current.ToCharArray() do
      sb.push(lsystem.Productions x)
    gen (sb.join("")) (iteration+1)

  // Start with the initial axiom
  gen lsystem.Axiom 0

The processLsystem function turns an L-system specification into a single large string that represents the actions that we want to do. This pretty much directly corresponds to the turtle commands that we defined earlier:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
// By default, go forward by 10 pixels
let defaultLength = 10.0

// Convert processed l-system string to turtle commands
let convertToTurtle angle (lSystemString: string) =
  let defaultAngle = 1.0 * angle
  lSystemString.ToCharArray() |> Array.map (function
    // Special commands that mean something
    | '+' -> Turn(defaultAngle)
    | '-' -> Turn(-defaultAngle)
    | '!' -> RandomColor
    | '[' -> Push
    | ']' -> Pop
    // Anything else is treated as move forward
    | _ -> DrawForward(defaultLength) )
  |> Array.toList

Parsing L-system specifications

Now we are almost done - we just need to parse the L-system specification given by the user and then we need to put everything together. There are a number of things that can go wrong when parsing the specification, so we'll need a function for reporting errors. This uses the HTML library that we used for generating SVG images:

1: 
2: 
3: 
4: 
5: 
let error msg =
  h?p [] [
    h?strong [] [text "Error: "]
    text msg
  ] |> renderTo (document.getElementById("errors"))

When parsing an input, we split it into lines. Each line is either an axiom (when it does not contain ->) or a production rule. When parsing productions, we simply find the part before -> and after -> and create a function that uses the collected rules to implement mapping that we can use to construct LSystem value:

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
let parse (s:string) =
  // Clear errors and split lines into axioms and procutions
  h?div [] [] |> renderTo (document.getElementById("errors"))
  let prods, ax = s.Trim().Split('\n') |> Array.partition (fun s -> s.Contains("->"))

  // There shold be exactly one axiom
  let axiom =
    if ax.Length <> 1 then error("There should be exactly one axiom"); "A"
    else ax.[0].Trim()

  // Collect production rules
  let prods =
    prods |> Array.map (fun s ->
      let i = s.IndexOf("->")
      let c = s.Substring(0, i).Trim()
      let c =
        if c.Length = 1 then c.ToCharArray().[0]
        else error("Production rule should have one thing on the left"); 'A'
      let t = s.Substring(i+2).Trim()
      c, t)

  // Build an L-system specification
  { Axiom = axiom
    Productions = fun c ->
      match prods |> Array.tryFind (fun (k, _) -> k = c) with
      | Some(_, r) -> r
      | _ -> string c }

Putting everything together

The last step is to implement the user interface. We have a number of elements on the page that we can access using document.getElementById - for some, we need to access their value, so we cast them to the appropriate HTML element type:

1: 
2: 
3: 
4: 
5: 
let cont = document.getElementById("output")
let input = document.getElementById("input") :?> HTMLTextAreaElement
let iters = document.getElementById("iterations") :?> HTMLInputElement
let angle = document.getElementById("angle") :?> HTMLInputElement
let width = document.getElementById("width") :?> HTMLInputElement

An initial turtle starts in the middle (the position will be re-scaled later, so it does not matter) and has initially red color:

1: 
2: 
3: 
let turtle =
  { angle = 0.0; x = 0.0; y = 0.0
    c = { r = 255; g = 0; b = 0 } }

Now the most beautiful part of the source code - the run function just composes all the steps that we created so far using the |> operator. We take the input, parse it, run the L-system using the given number of iterations, turn it into Turtle commands, turn that into line segments and render the line segments:

1: 
2: 
3: 
4: 
5: 
6: 
7: 
let run () =
  parse input.value
  |> processLsystem (int iters.value)
  |> convertToTurtle (float angle.value)
  |> processTurtle turtle
  |> render (int width.value)
  |> renderTo cont

Finally, we call run when any of the configuration parameters change and we also run it when the page loads:

1: 
2: 
3: 
4: 
5: 
input.addEventListener_keyup(fun _ -> run(); box())
iters.addEventListener_change(fun _ -> run(); box())
angle.addEventListener_change(fun _ -> run(); box())
width.addEventListener_change(fun _ -> run(); box())
run()
namespace Fable
namespace Fable.Import
module Browser

from Fable.Import
module Html

from Fable
namespace Fable.Core
Multiple items
type EmitAttribute =
  inherit Attribute
  private new : unit -> EmitAttribute
  new : macro:string -> EmitAttribute
  new : emitterType:Type * methodName:string -> EmitAttribute

Full name: Fable.Core.EmitAttribute

--------------------
new : macro:string -> Fable.Core.EmitAttribute
new : emitterType:System.Type * methodName:string -> Fable.Core.EmitAttribute
val push : sb:'a [] -> v:'a -> 'a0

Full name: Lsystem.push
val sb : 'a []
val v : 'a
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val join : sb:'a [] -> sep:string -> 'a0

Full name: Lsystem.join
val sep : string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
val x : 'T []
member [].push : v:'T -> 'a

Full name: Lsystem.push
val v : 'T
member [].join : s:string -> 'a

Full name: Lsystem.join
val s : string
type Point =
  {x: float;
   y: float;}

Full name: Lsystem.Point
Point.x: float
Multiple items
val float : value:'T -> float (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.float

--------------------
type float = System.Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
Point.y: float
type Color =
  {r: int;
   g: int;
   b: int;}

Full name: Lsystem.Color
Color.r: int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
Color.g: int
Color.b: int
type LineSegment =
  {startPoint: Point;
   endPoint: Point;
   color: Color;}

Full name: Lsystem.LineSegment
LineSegment.startPoint: Point
LineSegment.endPoint: Point
LineSegment.color: Color
val render : lineWidth:int -> lines:seq<LineSegment> -> DomNode

Full name: Lsystem.render
val lineWidth : int
val lines : seq<LineSegment>
val xs : seq<float>
module Seq

from Microsoft.FSharp.Collections
val collect : mapping:('T -> #seq<'U>) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.collect
val l : LineSegment
val ys : seq<float>
val minx : float
val maxx : float
val min : source:seq<'T> -> 'T (requires comparison)

Full name: Microsoft.FSharp.Collections.Seq.min
val max : source:seq<'T> -> 'T (requires comparison)

Full name: Microsoft.FSharp.Collections.Seq.max
val miny : float
val maxy : float
val convx : (float -> float)
val x : float
val convy : (float -> float)
val y : float
val s : El

Full name: Fable.Html.s
val line : LineSegment
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
type LogoCommand =
  | DrawForward of float
  | Turn of float
  | Push
  | Pop
  | RandomColor

Full name: Lsystem.LogoCommand
union case LogoCommand.DrawForward: float -> LogoCommand
union case LogoCommand.Turn: float -> LogoCommand
union case LogoCommand.Push: LogoCommand
union case LogoCommand.Pop: LogoCommand
union case LogoCommand.RandomColor: LogoCommand
type LTurtle =
  {angle: float;
   x: float;
   y: float;
   c: Color;}

Full name: Lsystem.LTurtle
LTurtle.angle: float
LTurtle.x: float
LTurtle.y: float
LTurtle.c: Color
val chaos : System.Random

Full name: Lsystem.chaos
namespace System
Multiple items
type Random =
  new : unit -> Random + 1 overload
  member Next : unit -> int + 2 overloads
  member NextBytes : buffer:byte[] -> unit
  member NextDouble : unit -> float

Full name: System.Random

--------------------
System.Random() : unit
System.Random(Seed: int) : unit
val randomColor : unit -> Color

Full name: Lsystem.randomColor
System.Random.Next() : int
System.Random.Next(maxValue: int) : int
System.Random.Next(minValue: int, maxValue: int) : int
val processTurtle : turtle:LTurtle -> program:LogoCommand list -> LineSegment list

Full name: Lsystem.processTurtle


 interprets a logo program and produces a line segment list to render
val turtle : LTurtle
val program : LogoCommand list
val phono : (LTurtle list -> LineSegment list -> LTurtle -> LogoCommand list -> LineSegment list)
val stack : LTurtle list
val output : LineSegment list
val t : LogoCommand list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member GetSlice : startIndex:int option * endIndex:int option -> 'T list
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val isEmpty : list:'T list -> bool

Full name: Microsoft.FSharp.Collections.List.isEmpty
val tail : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.tail
val head : list:'T list -> 'T

Full name: Microsoft.FSharp.Collections.List.head
val d : float
val rads : float
type Math =
  static val PI : float
  static val E : float
  static member Abs : value:sbyte -> sbyte + 6 overloads
  static member Acos : d:float -> float
  static member Asin : d:float -> float
  static member Atan : d:float -> float
  static member Atan2 : y:float * x:float -> float
  static member BigMul : a:int * b:int -> int64
  static member Ceiling : d:decimal -> decimal + 1 overload
  static member Cos : d:float -> float
  ...

Full name: System.Math
field System.Math.PI = 3.14159265359
val cos : value:'T -> 'T (requires member Cos)

Full name: Microsoft.FSharp.Core.Operators.cos
val sin : value:'T -> 'T (requires member Sin)

Full name: Microsoft.FSharp.Core.Operators.sin
val newTurtle : LTurtle
val seg : LineSegment
val delta : float
val rev : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.rev
type LSystem =
  {Axiom: string;
   Productions: char -> string;}

Full name: Lsystem.LSystem
LSystem.Axiom: string
LSystem.Productions: char -> string
Multiple items
val char : value:'T -> char (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.char

--------------------
type char = System.Char

Full name: Microsoft.FSharp.Core.char
val processLsystem : max:int -> lsystem:LSystem -> string

Full name: Lsystem.processLsystem
val max : int
val lsystem : LSystem
val gen : (string -> int -> string)
val current : string
val iteration : int
val x : char
System.String.ToCharArray() : char []
System.String.ToCharArray(startIndex: int, length: int) : char []
val defaultLength : float

Full name: Lsystem.defaultLength
val convertToTurtle : angle:float -> lSystemString:string -> LogoCommand list

Full name: Lsystem.convertToTurtle
val angle : float
val lSystemString : string
val defaultAngle : float
module Array

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> array:'T [] -> 'U []

Full name: Microsoft.FSharp.Collections.Array.map
val toList : array:'T [] -> 'T list

Full name: Microsoft.FSharp.Collections.Array.toList
val error : msg:string -> unit

Full name: Lsystem.error
val msg : string
val h : El

Full name: Fable.Html.h
val text : s:string -> DomNode

Full name: Fable.Html.text
val renderTo : node:HTMLElement -> dom:DomNode -> unit

Full name: Fable.Html.renderTo
val document : Document

Full name: Fable.Import.Browser.document
abstract member Document.getElementById : elementId:string -> HTMLElement
val parse : s:string -> LSystem

Full name: Lsystem.parse
val prods : string []
val ax : string []
System.String.Trim() : string
System.String.Trim([<System.ParamArray>] trimChars: char []) : string
val partition : predicate:('T -> bool) -> array:'T [] -> 'T [] * 'T []

Full name: Microsoft.FSharp.Collections.Array.partition
System.String.Contains(value: string) : bool
val axiom : string
property System.Array.Length: int
val prods : (char * string) []
val i : int
System.String.IndexOf(value: string) : int
System.String.IndexOf(value: char) : int
System.String.IndexOf(value: string, comparisonType: System.StringComparison) : int
System.String.IndexOf(value: string, startIndex: int) : int
System.String.IndexOf(value: char, startIndex: int) : int
System.String.IndexOf(value: char, startIndex: int, count: int) : int
System.String.IndexOf(value: string, startIndex: int, comparisonType: System.StringComparison) : int
System.String.IndexOf(value: string, startIndex: int, count: int) : int
System.String.IndexOf(value: string, startIndex: int, count: int, comparisonType: System.StringComparison) : int
val c : string
System.String.Substring(startIndex: int) : string
System.String.Substring(startIndex: int, length: int) : string
val c : char
val t : string
val tryFind : predicate:('T -> bool) -> array:'T [] -> 'T option

Full name: Microsoft.FSharp.Collections.Array.tryFind
val k : char
union case Option.Some: Value: 'T -> Option<'T>
val r : string
val cont : HTMLElement

Full name: Lsystem.cont
val input : HTMLTextAreaElement

Full name: Lsystem.input
Multiple items
val HTMLTextAreaElement : HTMLTextAreaElementType

Full name: Fable.Import.Browser.HTMLTextAreaElement

--------------------
type HTMLTextAreaElement =
  interface
    inherit HTMLElement
    abstract member checkValidity : unit -> bool
    abstract member createTextRange : unit -> TextRange
    abstract member autofocus : bool
    abstract member cols : float
    abstract member defaultValue : string
    abstract member disabled : bool
    abstract member form : HTMLFormElement
    abstract member maxLength : float
    abstract member name : string
    ...
  end

Full name: Fable.Import.Browser.HTMLTextAreaElement
val iters : HTMLInputElement

Full name: Lsystem.iters
Multiple items
val HTMLInputElement : HTMLInputElementType

Full name: Fable.Import.Browser.HTMLInputElement

--------------------
type HTMLInputElement =
  interface
    inherit HTMLElement
    abstract member checkValidity : unit -> bool
    abstract member createTextRange : unit -> TextRange
    abstract member accept : string
    abstract member align : string
    abstract member alt : string
    abstract member autocomplete : string
    abstract member autofocus : bool
    abstract member border : string
    abstract member checked : bool
    ...
  end

Full name: Fable.Import.Browser.HTMLInputElement
val angle : HTMLInputElement

Full name: Lsystem.angle
val width : HTMLInputElement

Full name: Lsystem.width
val turtle : LTurtle

Full name: Lsystem.turtle
val run : unit -> unit

Full name: Lsystem.run
property HTMLTextAreaElement.value: string
property HTMLInputElement.value: string
abstract member HTMLElement.addEventListener_keyup : listener:System.Func<KeyboardEvent,obj> * ?useCapture:bool -> unit
val box : value:'T -> obj

Full name: Microsoft.FSharp.Core.Operators.box
abstract member HTMLElement.addEventListener_change : listener:System.Func<Event,obj> * ?useCapture:bool -> unit
Fork me on GitHub