-- Work by:  (Michal Duczmal 0679305)

import LSystem

--1. join
join :: [Command] -> Command
join   []   = Sit
join (x:xs) = foldl (:#) x xs

--2. split
split :: Command -> [Command]
split = reverse . split'
	where
	 split' (commands :# command) = ( command : (split' commands) )
	 split'      singleCommand    = [singleCommand]

--3. copy
copy :: Int -> Command -> Command
copy n command = join [ command | x <- [1..n] ]

--   hexagon
hexagon :: Distance -> Command
hexagon x = copy 6 ( Go x :# Turn 60 )

--   pentagon
pentagon :: Distance -> Command
pentagon x = copy 5 ( Go x :# Turn 72 )

--5. polygon
polygon :: Distance -> Int -> Command
polygon x n = copy n ( Go x :# Turn ( 360 / ( fromIntegral n ) ) )

--6. spiral
spiral :: Distance -> Int -> Distance -> Angle -> Command
spiral   _     0  _     _   = Sit
spiral segment n step angle = (Go segment) :# (Turn angle) :# 
				(spiral (segment - step) (n - 1) step angle)

--7. optimise

--
-- gets rid of adjacent Go-s and Turn-s 
-- if the first pair is not addible (and after the first pair)
addComm1 :: [Command] -> [Command]
addComm1   []   = []
addComm1 (x:[]) = [x]
addComm1 (x:xs) = case (x, head xs) of
		  ((Turn a), (Turn b)) -> Turn (a+b) : addComm1 (tail xs)
		  ((Go a), (Go b))  -> Go (a+b) : addComm1 (tail xs)
		  (a, b) -> a : addComm1 xs

-- gets rid of adjacent Go-s and Turn-s
-- if the first pair is addible 
addComm2 :: [Command] -> [Command]
addComm2   []   = []
addComm2 (x:[]) = [x]
addComm2 (x:xs) = case (x, head xs) of
		  ((Turn a), (Turn b)) -> (Turn (a+b)) : addComm1 (tail xs)
		  ((Go a), (Go b))  -> Go (a+b) : addComm1 (tail xs)
		  (a, b) -> b : addComm1 xs

addCommands :: [Command] -> [Command]
addCommands (x:xs) = case (x, head xs) of
		     (Turn a, Turn b) ->  addComm2 (x:xs)
		     (Go a, Go b)     ->  addComm2 (x:xs)
		     (a, b)	     ->  addComm1 (x:xs)
--


-- gets rid off Sit, Go 0 or Turn 0 commands in a list of commands
optimiseNulls :: [Command] -> [Command]
optimiseNulls = filter (/=(Go 0)) . filter (/=(Sit)) . filter (/=(Turn 0))

-- checks whether the command can be optimised more
checkDone :: [Command] -> Bool
checkDone [] = True
checkDone (x:[]) = True
checkDone (x:xs) = and(
		       ( case (x, head xs) of
		         ((Turn a), (Go b)) -> True
		         ((Go a), (Turn b)) -> True
		         (a, b)             -> False
		       ) : (checkDone xs) : []   )

-- optimise a command
----------
optimise' :: Bool -> Command -> Command
optimise' done comm = case done of
			False -> optimise ( join (optimiseNulls (addCommands (optimiseNulls (split comm)))) )
			True  -> comm 


optimise :: Command -> Command
optimise comm =  optimise' whether comm
	where
	 whether = checkDone (split comm)
---------

--8. arrowhead
arrowhead :: Int -> Command
arrowhead x = f x
	where
	 f 0     = GrabPen red :# Go (10)
	 f (x+1) = g x :# p :# f x :# p :# g x

	 g 0     = GrabPen blue :# Go (10)
 	 g (x+1) = f x :# n :# g x :# n :# f x

	 n       = Turn 60
 	 p       = Turn (-60)

--9. snowflake
snowflake :: Int -> Command
snowflake x = f x
	where
	 f 0     = GrabPen blue :# Go (10) :# n :# n :# 
		   Go (10) :# n :# n :# Go (10) :# n :# n
	 f (x+1) = f x :# p :# f x :# n :# n :# f x :# p :# f x
	 n       = Turn 60
 	 p       = Turn (-60)

--10.
peanoGosper :: Int -> Command
peanoGosper  x = f x
	where
	 f 0     = GrabPen red :# Go (10)
	 f (x+1) = f x :# p :# g x :# p :# p :# g x :# 
		   n :# f x :# n :# n :# f x :# f x :#
		   n :# g x :# p

	 g 0     = GrabPen blue :# Go (10)
 	 g (x+1) = n :# f x :# p :# g x :# g x :# p :# p :# 
		   g x :# p :# f x :# n :# n :# f x :# n :# g x 

	 n       = Turn 60
 	 p       = Turn (-60)


---------Competition 2006 entry------------

-- run with the IO command:    competition
-- (it runs kind of slow but it will eventually run)

competition :: IO ()
competition = display 0.5 (competition' 6)

competition' :: Int -> Command
competition' x = GrabPen white :# Turn (-140) :# Go 700 :# 
		(f x (*4) black red blue green) :# (f x (*3) red blue green black) 
		:# (f x (+50) blue green black red) :# (f x (+40) green black red blue)
	where
	 f 0 m c d e a= GrabPen c :# (polygon 5 (m 40))
	 f (x+1) m c d e a= f x m c d e a :# n :# g x m c d e a :# n :# h x m c d e a :#
				 n :# i x m c d e a :# n :# j x m c d e a

	 g 0 m c d e a= GrabPen d :# (polygon 5 (m 30))
 	 g (x+1) m c d e a = g x m c d e a :# n :# f x m c d e a

	 h 0 m c d  e a  = GrabPen e :# (polygon 5 (m 20))
 	 h (x+1) m c d e a = h x m c d e a :# n :# f x m c d e a

	 i 0 m c d  e a = GrabPen a :# (polygon 5 (m 10))
 	 i (x+1) m c d  e a= i x m c d e a :# n :# f x m c d e a

	 j 0 m c d  e a  = GrabPen (Colour 0.4 0.2 0.6) :# (polygon 4 (m 5))
 	 j (x+1) m c d  e a= j x m c d e a :# n :# f x m c d e a

	 n       = Turn 0.5
 	 p       = Turn (-0.5)

--------------------------------------------