-- Work by: Michal Cudrnak s0677930 and Christopher Cook s0674951
-- See below for Haskell competition enry

import LSystem

orange :: Pen
orange = Colour 1.0 0.7 0.0

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

--2. split
split :: Command -> [Command]
split (c :# d) = split c ++ split d
split c        = [c]

--3. copy
copy :: Int -> Command -> Command
copy 0 c = Sit
copy n c = foldl1 (:#) (replicate n c)

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

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

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

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

--7. optimise
optimise :: Command -> Command
optimise = join . optimiseList . split
   where
   optimiseList xs | length optimised == length xs   = xs
                   | otherwise                       = optimiseList optimised
      where optimised = optimiseStep xs

   optimiseStep []                     = []
   optimiseStep (Sit : xs)             = optimiseStep xs
   optimiseStep (Go 0 : xs)            = optimiseStep xs
   optimiseStep (Turn 0 : xs)          = optimiseStep xs
   optimiseStep (Go   x : Go   y : xs) = optimiseStep (Go (x+y) : xs)
   optimiseStep (Turn x : Turn y : xs) = optimiseStep (Turn (x+y) : xs)
   optimiseStep (x : xs)               = x : optimiseStep xs

--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
   p         = Turn (-60)
   n         = Turn (60)
   

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

--10.
peanoGosper :: Int -> Command
peanoGosper x = f x
   where
   f 0         = GrabPen blue :# 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 orange :# 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
   p           = Turn (-60)
   n           = Turn (60)

-- Haskell Competition Entry - Work by: Michal Cudrnak s0677930

-- main function
main :: IO ()
main = display 3.3 (Branch (GrabPen Inkless :# Turn 10 :# Go (-50) :# join [Branch (Turn xa :# GrabPen Inkless :# Go 45 :# extrude 3 100 (gradient 10 (Colour 0.8 0.5 0.0) white (genericSnowflake 2 3))) | xa <- [0, 60..359]]) :# extrude 9 105 (extrude 8 75 (ltree 3 100)))       

genericSnowflake :: Int -> Distance -> Command
genericSnowflake x d = GrabPen (Colour 0.7 0.7 0.7) :# f x d :# n :# n :# f x d :# n :# n :# f x d :# n :# n 
   where
   f 0 d       = Go d
   f (x+1) d   = f x d :# p :# f x d :# n :# n :# f x d :# p :# f x d
   p           = Turn (-60)
   n           = Turn 60

-- dirty night coding :)
gradient :: Float -> Pen -> Pen -> Command -> Command
gradient p c1 c2 (Go d :# cmd) = join [GrabPen (Colour r g b) :# Go (d/p) | (r, g, b) <- zip3 [r1,(r1+(r2-r1)/p)..r2] [g1,(g1+(g2-g1)/p)..g2] [b1,(b1+(b2-b1)/p)..b2] ] :# gradient p c1 c2 cmd
   where
   (Colour r1 g1 b1) = c1
   (Colour r2 g2 b2) = c2
gradient p c1 c2 (cmd :# Go d) = gradient p c1 c2 cmd :# join [GrabPen (Colour r g b) :# Go (d/p) | (r, g, b) <- zip3 [r1,(r1+(r2-r1)/p)..r2] [g1,(g1+(g2-g1)/p)..g2] [b1,(b1+(b2-b1)/p)..b2] ]
   where
   (Colour r1 g1 b1) = c1
   (Colour r2 g2 b2) = c2
gradient p c1 c2 (cmd1 :# cmd2) = gradient p c1 c2 cmd1 :# gradient p c1 c2 cmd2
gradient p c1 c2 (Branch cmd)   = Branch (gradient p c1 c2 cmd)
gradient _ _ _ cmd              = cmd

extrude :: Distance -> Angle -> Command -> Command
extrude d a = join . (extrudeList d a) . split
   where
   extrudeList d a []                 = [Branch (Turn a :# Go d)]
   extrudeList d a (Turn angle : xs)  = Turn angle : extrudeList d (a-angle) xs
   extrudeList d a (Go dist : xs)     = Branch (Turn a :# Go d :# Turn (-a) :# Go dist) : Go dist : extrudeList d a xs
   extrudeList d a (Branch c : xs)    = Branch (extrude d a c) : extrudeList d a xs
   extrudeList d a (x:xs) = x : extrudeList d a xs

-- lambda tree
ltree :: Int -> Distance -> Command
ltree x d = Turn 210 :# f x d :# Turn (-210)
   where
   f 0 d = join [GrabPen (Colour x (0.5 + 0.5*x) x) :# Go (d / 20.0) | x <- [1.0, 0.95..0.055555]]
   f x d = divideAndConquer :#
           Branch (Turn (-60) :# divideAndConquer) :#
           divideAndConquer
      where
      divideAndConquer = f (x-1) (d/2)
   noPen = GrabPen Inkless