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