-- Gregor Dick, 0569864
-- competition.hs
-- 2005 Inf1a Programming Competition Entry
-- Please run the function 'showEntry' to display the entry.
import LSystem
import Maybe
-- First, we define a function to generate the commands for a general LSystem.
-- The parameters are, in order:
-- String Start state.
-- Angle Angle to turn for + and -.
-- [(Char, Function identifier.
-- (String, Replacement string for n > 0
-- Command))] Command to perform for n == 0.
-- Int Recursion index.
-- This solution works by expanding the string in situ. A more elegant method
-- would be one that generates recursive functions and simply evaluates a
-- command corresponding to the start state, but that leads to nasty Catch-22
-- situations involving function representations, and cyclic function types
-- if a workaround is sought for such. It's probably not worth the bother.
lsys :: String -> Angle -> [(Char, (String, Command))] -> Int -> Command
lsys xs y fns n = lsysStrToCmd xs ([('-', ("-", Turn y)), ('+', ("+", Turn (-y)))] ++ fns) n
lsysStrToCmd :: String -> [(Char, (String, Command))] -> Int -> Command
lsysStrToCmd [] _ _ = Sit
lsysStrToCmd (x:xs) fns 0
| x == '[' = Branch (lsysStrToCmd xs fns 0) :# lsysStrToCmd (afterBrackets xs 1) fns 0
| x == ']' = Sit
| otherwise = snd (fromJust (lookup x fns)) :# lsysStrToCmd xs fns 0
where
afterBrackets xs 0 = xs
afterBrackets [] _ = error "Incorrect bracketing."
afterBrackets (x:xs) n
| x == '[' = afterBrackets xs (n+1)
| x == ']' = afterBrackets xs (n-1)
| otherwise = afterBrackets xs n
lsysStrToCmd xs fns n = lsysStrToCmd (lsysExpandString xs fns) fns (n-1)
lsysExpandString [] _ = []
lsysExpandString (x:xs) fns
| x == '[' || x == ']' = x : lsysExpandString xs fns
| otherwise = fst (fromJust (lookup x fns)) ++ lsysExpandString xs fns
-- The following functions generate Turtle commands corresponding to
-- similar L-Systems. The family of patterns was arrived at by
-- experimenting with symmetries and so forth.
leaf, leaf2, square :: Int -> Command
leaf = lsys "-f" 45 [('f', ("f+g[f-g]-[f]+[g]", GrabPen (Colour 0 0.5 0) :# Go 10)), ('g', ("g-f[g+f]+[g]-[f]", GrabPen (Colour 0 0 0.5) :# Go 10))]
leaf2 = lsys "-f" 45 [('f', ("f+g[f-g]-[f]", GrabPen (Colour 0 0.5 0) :# Go 10)), ('g', ("g-f[g+f]+[f]", GrabPen (Colour 0 0 0.5) :# Go 10))]
square = lsys "-f" 90 [('f', ("f+g[f-g]-[f]+[g]", GrabPen (Colour 0 0.5 0) :# Go 10)), ('g', ("g-f[g+f]+[g]-[f]", GrabPen (Colour 0 0 0.5) :# Go 10))]
-- I've selected 'leaf' as my entry for the competition. The following
-- function displays it.
showEntry :: IO ()
showEntry = display 0.25 (leaf 6)