-- 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)