module Exercise10 where

import Data.List (find, intercalate)
import Data.Map as Map (lookup)
-- import Data.Maybe (fromJust, fromMaybe)
import System.IO
import System.Exit
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' = move 10
apply 'G' = move 10
apply '+' = turn 30
apply '-' = turn (-30)
apply '*' = turn 15
apply '~' = turn (-15)
apply '^' = penUp
apply 'v' = penDown
apply 'n' = turn 180
apply _ = sit

-- 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 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"]

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

something :: LSystem
something = LSystem "G+++G+++GG+++GGG" ['G' :->: "G+++GG"]  -- this was supposed to be a spiral, but ok

loss :: LSystem
loss = LSystem "A" [  'L' :->: "---FF---F---FnFFF"
                    , 'K' :->: "FFDFEFnFFFFH"
                    , 'G' :->: "FFFDFEFnFFFFH"
                    , 'H' :->: "FFIFIFnFFFFJ"
                    , 'B' :->: "+++FFnFF+++FFFC"
                    , 'J' :->: "---FFFFnFFFFL"
                    , 'C' :->: "+++FFFFnFFFF+++K"
                    , 'I' :->: "+++FFnFF+++"
                    , 'E' :->: "+++FnF+++"
                    , 'D' :->: "+++FFnFF+++"
                    , 'A' :->: "---FB"
                    ]

-- finds the first occurrence of a fitting rule
getName :: Rule -> Char
getName (c :->: _) = c

getRule :: Rule -> String
getRule (_ :->: r) = r

findRule :: [Rule] -> Char -> Rule
findRule l c = head $ filter ((c ==) . getName) $ l ++ [c :->: [c]]

applyRule :: [Rule] -> Char -> String
applyRule r = getRule . findRule r

-- expands the L-System n times
expandLSystem :: LSystem -> Integer -> String
expandLSystem (LSystem start _) 0 = start
expandLSystem ls@(LSystem start rules) x = expandLSystem (ls {start = concatMap (applyRule rules) start}) $ x - 1

-- updating LSystem via command
update :: LSystem -> IO LSystem
update ls@(LSystem start r) = do
  ready <- hReady stdin
  if not ready then return ls else do
    line <- getLine
    let w = words line
    case w of
      ["start", rest] -> update $ ls {start = rest}
      ["rule", [symbol], "->", rest] -> update $ ls {rules = (symbol :->: rest) : filter ((/= symbol) . getName) r}
      ("rule" : _) -> do
        putStrLn "Error parsing rule"
        update ls
      ["clear"] -> update $ LSystem "" []
      ["print"] -> do
        print ls
        update ls
      -- ["quit"] -> exitSuccess
      -- ["delete", [symbol]] -> return $ ls {rules = filter ((/= symbol) . getName) r}
      _ -> do
        putStrLn "Error parsing command"
        update ls

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

{- WETT -}
{- TTEW -}