Playing with, and visualising, L-systems

Defining a Turtle system

I decided to use SVG graphics for this (partly because my attempt to get OpenGL working via Gloss totally failed). In order to keep track of the cursor (or Turtle), we encapsulate this state in a State monad, and define our render function, which translates a symbol to an SVG element, in terms of that State monad:

-- Keep track of the position and direction representing a single cursor
data TurtleState = TurtleState
  { position :: (Float, Float),
    angle :: Float
  }

-- The state of our renderer is a stack of at least one 'TurtleState'
newtype RenderState = RenderState (NonEmpty TurtleState)

-- And now we can compute all our translation operations in the context of this 'RenderState'
type WorldM a = State RenderState a

To capture the general translation behaviour, we use a Turtle type class which turns a symbol from our Alphabet into an SVG element (from the SVG Builder library):

class Turtle a where
  render :: a -> WorldM SVG.Element

Another reason to do this with the State monad is that it gives us a nice algebra for sequencing our rendering instructions. Instead of having to think about how to handle the sequencing of the state changes, we can just traverse over the instruction sets and get the end result.

Translating the BinaryTree to graphical instructions

If we want to turn our BinaryTree symbols into graphical elements, we need some basic operations like moving the turtle, as well as operations on the state like pushing and popping states on stack (so we can go back to a previously-saved state as with our [] pairs), so let’s define some helpers:

-- | Modifies the topmost 'TurtleState'
turtleMod :: (TurtleState -> TurtleState) -> WorldM ()
turtleMod f = modify $ \(RenderState (t :| rest)) -> RenderState (f t :| rest)

-- | Views the topmost 'TurtleState' in the stack
viewTurtle :: WorldM TurtleState
viewTurtle = gets $ \(RenderState (t :| _)) -> t

-- | Takes off the topmost 'TurtleState', but if there is only one, it leaves it
-- in place as we can't have an empty stack of states
popTurtle :: WorldM ()
popTurtle = modify $ \(RenderState (t :| rest)) -> case NEL.nonEmpty rest of
  Just states -> RenderState states
  Nothing -> RenderState (t :| rest)

-- | Puts a 'TurtleState' on top of the stack
pushTurtle :: TurtleState -> WorldM ()
pushTurtle t = modify $ \(RenderState states) -> RenderState $ t <| states

-- | Move from one point some distance, at some angle, to another point
vecMove :: (Float, Float) -> Float -> Float -> (Float, Float)
vecMove (x1, y1) distance theta = (x1 + distance * sin theta, y1 + distance * cos theta)

Now we’re ready to write our translation from the Alphabet BinaryTree to drawing instructions (or, really, SVG elements):

-- For the sake of making things uniform, let's define some basic sizes on the canvas
size :: Float
size = 1600

baseLength :: Float
baseLength = 10

baseWidth :: Float
baseWidth = 5

-- And, since the SVG builder library takes 'Text' values for literally
-- everything, we need a way to translate all our numbers to 'Text'
showT :: (Show a) => a -> Text
showT = pack . show

-- A leaf is just a small green circle
mkLeaf :: (Float, Float) -> SVG.Element
mkLeaf origin =
  SVG.circle_
    [ SVG.Cx_ <<- showT (fst origin),
      SVG.Cy_ <<- showT (snd origin),
      SVG.R_ <<- showT (baseLength / 2),
      SVG.Fill_ <<- "green"
    ]

instance Turtle (Alphabet BinaryTree) where
  render Zero = do
    -- Let's get the current cursor position and angle
    TurtleState origin theta <- viewTurtle
    -- The move forward a small amount
    let next = vecMove origin baseLength theta
    -- and save this new cursor state
    turtleMod (const $ TurtleState next theta)
    pure $
      mkLeaf next -- draw a leaf at the new position
        <> SVG.line_ -- and a line from the previous position to the new position
          [ SVG.X1_ <<- showT (fst origin),
            SVG.Y1_ <<- showT (snd origin),
            SVG.X2_ <<- showT (fst next),
            SVG.Y2_ <<- showT (snd next),
            SVG.Stroke_ <<- "black",
            SVG.Stroke_width_ <<- showT baseWidth
          ]
  render One = do
    -- Very similar to how we render 'Zero', but we don't have a leaf
    TurtleState origin theta <- viewTurtle
    let next = vecMove origin baseLength theta
    turtleMod (const $ TurtleState next theta)
    pure $
      SVG.line_
        [ SVG.X1_ <<- showT (fst origin),
          SVG.Y1_ <<- showT (snd origin),
          SVG.X2_ <<- showT (fst next),
          SVG.Y2_ <<- showT (snd next),
          SVG.Stroke_ <<- "black",
          SVG.Stroke_width_ <<- showT baseWidth
        ]
  render LBrace = do
    -- copy the cursor state
    viewTurtle >>= pushTurtle
    -- and turn anti-clockwise by 45° (π / 4)
    turtleMod $ \turtle -> turtle {angle = angle turtle - (pi / 4)}
    -- but we don't actually render anything
    pure mempty
  render RBrace = do
    -- go back to the previously-saved state
    popTurtle 
    -- and turn clockwise by 45° (π / 4)
    turtleMod $ \turtle -> turtle {angle = angle turtle + (pi / 4)}
    -- but we don't actually render anything
    pure mempty

Results!

Running this we see some nice representations of our system’s growth:

We can do something similar for the Koch system

instance Turtle (Alphabet Koch) where
  render F = do
    TurtleState origin theta <- viewTurtle
    let next = vecMove origin (baseLength * 2) theta
    turtleMod (const $ TurtleState next theta)
    pure $ -- Draw a small line
      SVG.line_
        [ SVG.X1_ <<- showT (fst origin),
          SVG.Y1_ <<- showT (snd origin),
          SVG.X2_ <<- showT (fst next),
          SVG.Y2_ <<- showT (snd next),
          SVG.Stroke_ <<- "blue",
          SVG.Stroke_width_ <<- showT baseWidth
        ]
  render Plus = do
    -- Rotate 90° clockwise
    turtleMod $ \turtle -> turtle {angle = angle turtle + (pi / 2)}
    pure mempty
  render Minus = do
    -- Rotate 90° anticlockwise
    turtleMod $ \turtle -> turtle {angle = angle turtle - (pi / 2)}
    pure mempty

Iterating over the world

To generate these images, and to make experimentation a bit easier, I wrote a script to step through the iterations of growth for a given system and save the results as SVG images. While most of this final part is fairly mechanical, the nice part is that, due to the structures we have used like NonEmpty and State, we can very easily run the production rule over all the symbols iteratively, and then traverse over the drawing actions to generate a final result quite neatly. You can see how all this fits together in the downloadable version of this script (see the link at the top), but here’s a snippet from how that works:

runWorld ::
  forall a.
  ( (CFL a),
    (Turtle (Alphabet a))
  ) =>
  CLI ->
  Proxy a ->
  IO ()
runWorld options _ =
  let start = RenderState (singleton $ TurtleState {position = (size / 2, 0), angle = 0})
   in mapM_ (uncurry $ writeImage options)
        . take (maxIterations options)
        . zip [1 ..]
        . map (mkImage . sconcat . fst . flip runState start . traverse render)
        . iterate step
        . singleton
        $ axiom (Proxy @a)

Further experimentation

There are two directions that would be interesting to pursue: the first is context-aware L-systems – those that take more than just a single symbol at a time, but look to what is around that symbol to decide what to produce next; the second is writing my own systems with their own strange production rules, to see what one might come up with (sort of in the vein of playing with Game Of Life automata.