module Exercise10 where

import Data.List (foldl', isPrefixOf)
import System.IO (hReady, stdin)
import Turtle


data Rule = Char :->: String  -- context-free and deterministic! 
    deriving (Eq, Show)

left :: Rule -> Char
left (c :->: _) = c

right :: Rule -> String
right (_ :->: str) = str

data LSystem = LSystem {
        start :: String, 
        rules :: [Rule]  -- constraint: unique left sides
    }
    deriving Eq

instance Show LSystem where
    show (LSystem s r) = unlines $ ["Start: " ++ show s, "Rules: "] ++ map show r


apply :: Char -> Turtle -> Turtle
apply 'F' t = move   10  t
apply 'G' t = move   10  t
apply '+' t = turn   30  t
apply '-' t = turn (-30) t
apply '*' t = turn   15  t
apply '~' t = turn (-15) t
apply  _  t = sit        t

-- Use apply to convert movements of turtle to GL lines.
-- Try changing the color to red! 
execute :: LSystem -> Integer -> [Ln]
execute ls n = let (pen, ang, pnt, ln, bps) = lines (black, 0, 0, [],[]) $ expandLSystem ls n in ln
    where
        lines = foldl' (flip apply)

-- sample LSystems for (manual) testing
dragoncurve :: LSystem
dragoncurve = LSystem "FX" ['X' :->: "X+++YF+++", 'Y' :->: "---FX---Y"]

kochcurve :: LSystem
kochcurve = LSystem "F" ['F' :->: "F+++F---F---F+++F"]

sierpinski :: LSystem
sierpinski = LSystem "F++++G++++G" ['F' :->: "F++++G----F----G++++F", 'G' :->: "GG"]



-- finds the first occurrence of a fitting rule
findRule :: [Rule] -> Char -> Rule
findRule []     c   = c :->: [c]
findRule (r:rs) c
    | c == left r   = r
    | otherwise     = findRule rs c

-- expands the L-System n times
expandLSystem :: LSystem -> Integer -> String
expandLSystem l                   0 = start l
expandLSystem (LSystem str rules) n = expandLSystem (LSystem expandedStr rules) (n - 1)
    where
        expandedStr = concatMap (right . findRule rules) str

-- updating LSystem via command
update :: LSystem -> IO LSystem
update ls = do
    moreLines <- hReady stdin
    if moreLines then do
        command  <- getLine
        ls'      <- execCommand ls command
        update ls'
    else
        return ls
    where
        execCommand ls command
            | "start " `isPrefixOf` command = do
                let start = drop 6 command
                return (LSystem start (rules ls))
            
            | "rule " `isPrefixOf` command = do
                let ruleStr = drop 5 command
                if null ruleStr ||
                   not (" -> " `isPrefixOf` tail ruleStr) ||
                   null (drop 5 ruleStr) then do
                       putStrLn "Error parsing rule"
                       return ls
                else do
                    let char     = head ruleStr
                    let str      = drop 5 ruleStr
                    let rule     = char :->: str
                    let newRules = rule : filter (\r -> left r /= char) (rules ls)
                    return (LSystem (start ls) newRules)

            | command == "clear" =
                return (LSystem "" [])

            | command == "print" = do
                print ls
                return ls

            | otherwise = do
                putStrLn "Error parsing command"
                return ls



{-WETT-}
{-MCCOMMENT
    My Wettbewerb submission can be found in the Wettbewerb directory.
    The created video is Snake.mp4.
    The README.md file includes an explanation of the project.
-}
{-TTEW-}