module Exercise10 where

import Data.List (find)
import Data.Maybe (fromMaybe, isNothing, fromJust)
import Data.Map as Map (lookup)
import qualified Data.Text as T
import System.IO

import Turtle

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

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 (green, 0, 0, [],[]) $ expandLSystem ls n in ln
  where
    lines t [] = t 
    lines t (x:xs) = lines (apply x t) xs

-- 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 rs c = 
  let rule = find (\x -> getC x == c) rs in -- find rule with matching character
  fromMaybe (c :->: [c]) rule               -- else return the rule we just found 

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

getS :: Rule -> String
getS (_ :->: s) = s

-- expands the L-System n times
expandLSystem :: LSystem -> Integer -> String
expandLSystem lsys n = expandLSystem' lsys n (start lsys)
                        where 
                            expandLSystem' :: LSystem -> Integer -> String -> String
                            expandLSystem' lsys 0 s = s
                            expandLSystem' lsys n s = expandLSystem' lsys (n-1) (concat [getS (findRule (rules lsys) c) | c <- s])

-- updating LSystem via command
update :: LSystem -> IO LSystem
update ls = 
  do
    continue <- hReady stdin
    if continue then
      do
      line <- getLine
      let cmds = words line
      case head cmds of
        "start" -> do 
          return (LSystem (cmds !! 1) (rules ls))
        "rule" -> do
          if all validChar (cmds !! 3) then
            do
              putStr "Error parsing rule"
              return ls
          else
            return (LSystem (start ls) (head (cmds !! 1) :->: (cmds !! 3) : filter (\x -> getC x /= head (cmds !! 1)) (rules ls)))
        "clear" ->
          return (LSystem "" [])
        "print" -> do
          print ls
          putStr "\n"
          return ls
        _ -> do
          putStrLn "Error parsing command"
          return ls
      else 
        do return ls

validChar :: Char -> Bool
validChar c = c `elem` ['F','G','+','-','*','~']

-- add the WETT ... TTEW tags if you want to participate in the wettbewerb!