-- Put your name and matriculation number here
-- Baldur Karlsson s0561810
--
-- ## Comments written by me, not in the original file, prefixed with
-- ## and separated from original comments
{-

'########::'##:::::::'########::::'###:::::'######::'########:
 ##.... ##: ##::::::: ##.....::::'## ##:::'##... ##: ##.....::
 ##:::: ##: ##::::::: ##::::::::'##:. ##:: ##:::..:: ##:::::::
 ########:: ##::::::: ######:::'##:::. ##:. ######:: ######:::
 ##.....::: ##::::::: ##...:::: #########::..... ##: ##...::::
 ##:::::::: ##::::::: ##::::::: ##.... ##:'##::: ##: ##:::::::
 ##:::::::: ########: ########: ##:::: ##:. ######:: ########:
..:::::::::........::........::..:::::..:::......:::........::
'##::: ##::'#######::'########:'########:
 ###:: ##:'##.... ##:... ##..:: ##.....::
 ####: ##: ##:::: ##:::: ##:::: ##:::::::
 ## ## ##: ##:::: ##:::: ##:::: ######:::
 ##. ####: ##:::: ##:::: ##:::: ##...::::
 ##:. ###: ##:::: ##:::: ##:::: ##:::::::
 ##::. ##:. #######::::: ##:::: ########:
..::::..:::.......::::::..:::::........::

The inf1a 2005 competition entry for myself is only by myself, and is at the end of this file.

PLEASE READ THE FINAL COMMENTS as they explain usage and some minor gotchas. Specifically,
the entry may take a while to run and generate at the default settings - the DICE machine maesquoy
ran it in 30 seconds on average, please wait at least that long for it to finish.

Thank you :)

Baldur

-}

import LSystem
import List

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

-- 2.
--
-- ## if we have two commands separated by an :# then
-- ## split each command and concatenate the split strings
-- ## together. Then if it is only a single command, drop it
-- ## if it is Sit, or make it into a list otherwise
split :: Command -> [Command]
split (x:#xs) = (split x) ++ (split xs)
split Sit = []
split x = [x]

-- 3.
copy :: Int -> Command -> Command
copy n c = join (replicate n c)

-- 4.
hexagon :: Distance -> Command
hexagon len = copy 6 (Go len :# Turn 60.0)

-- 5.
--
-- ## 360 / n gives the size of each angle
polygon :: Distance -> Int -> Command
polygon len n = copy n (Go len :# Turn (360.0 / fromIntegral(n)))

-- 6.
--
-- ## Go the distance, turn the angle, recurse again until you hit level 0
spiral :: Distance -> Int -> Distance -> Angle -> Command
spiral _ 0 _ _ = Sit
spiral maxlen n step angle = Go maxlen :# Turn angle :# (spiral (maxlen-step) (n-1) step angle)

-- 7.
--
-- ## Assumes that Sits have been stripped out.
-- ##
-- ## a single optimise pass will remove Go 0 or Turn 0 commands, then add Go
-- ## commands then add Turn commands. When adding go or turn commands you have
-- ## to apply the pass over the added command, in case it is go or turn 0 now.
-- ## If you have neither go or turn 0 and no adjacant same commands, you must have
-- ## Turn Go, or Go Turn. There's nothing you can do to optimise this, so don't
-- ## do anything. However, only drop off the first command. If you had Go 10 :# Turn 20 :# Turn -20
-- ## you need to keep teh turn 20 in for later optimising, but you can drop off the go 10.
-- ## 
-- ## ** NB ** - If you only run this once, you might get something like this:
-- ## Go 10 :# Turn 20 :# Turn -20 :# Go 20
-- ## because the first go 10 would be dropped, you would end up with Go 10 :# Go 20, as the Go 10
-- ## would not be revisited after the Turns disappear. For this reason you should call this function
-- ## twice to be sure you have the optimum command.
optimisePass :: [Command] -> [Command]
optimisePass [] = []
optimisePass (Go 0:xs) = optimisePass xs
optimisePass (Turn 0:xs) = optimisePass xs
optimisePass (Go x:Go y:xs) = optimisePass (Go (x+y) :  xs)
optimisePass (Turn x:Turn y:xs) = optimisePass (Turn (x+y) : xs)
optimisePass (x:xs) = x:optimisePass xs

-- ## split the command to a string, take out sits, then call optimisepass twice, then join it all together again

optimise :: Command -> Command
optimise c = join (optimisePass (optimisePass ((filter (/= Sit) (split c)))))
					  
-- 8.
arrowhead :: Int -> Command
arrowhead x = f x
    where
    f 0 = Go 10
    f (x+1) = g x :# p :# f x :# p :# g x
    g 0 = Go 10
    g (x+1) = f x :# n :# g x :# n :# f x
    n = Turn 60
    p = Turn (-60)    

-- 9.
branch :: Int -> Command
branch x = g x
    where
    g 0 = Go 10
    g (x+1) = f x :# n :# Branch ( Branch (g x) :# p :# g x) :# p :# f x :# Branch (p :# f x :# g x) :# n :# g x
    f 0 = Go 10
    f (x+1) = f x :# f x
    n = Turn 22.5
    p = Turn (-22.5)


-- 10.
hilbert :: Int -> Command
hilbert x = l x
    where
    l 0 = Go 10
    l (x+1) = p :# r x :# f x :# n :# l x :# f x :# l x :# n :# f x :# r x :# p
    r 0 = Go 10
    r (x+1) = n :# l x :# f x :# p :# r x :# f x :# r x :# p :# f x :# l x :# n
    f 0 = Go 10
    f (x+1) = f x
    n = Turn 90
    p = Turn (-90)

-----------------------
-- competition entry --
-----------------------
-- *******************--
-----------------------
--
-- Comments here might not be great. They won't be prefixed with ## either
--
-- *******************--
-----------------------

-- Type declarations for 2D, 3D, 3D homogenised vertices and 2D lines
type Vertex2f = (Float, Float)
type Vertex3f = (Float, Float, Float)
type Vertex4f = (Float, Float, Float, Float)
type Line2f = (Vertex2f, Vertex2f)

-- draw a line at point (x, y) to point (a, b) with the colour specified
--
-- the method here is to move inklessly to the start of the line, then work out the direction and length of the line and draw it.
-- Generally, you'd want to branch before doing this because it will not return to its starting position.
-- It assumes the turtle is at the origin
drawline :: Pen -> Line2f -> Command
drawline col ((x,y),(a,b)) = GrabPen Inkless :# Turn yang :# Go (abs y) :# Turn xang :# Go (abs x) :# Turn (-xang-yang) :# Turn (180.0/pi * lineang) :# GrabPen col :# Go (sqrt ((b-y)^2 + (a-x)^2))
    where yang | y >= 0.0 = 0.0
	       | y < 0.0  = 180.0
	  xang | x >= 0.0 = yang-90.0
	       | x < 0.0  = yang+90.0

-- use trig to work out the signs and which angles to turn to get to the start point
	  lineang | a-x == 0.0 && b-y < 0.0  = pi
		  | a-x == 0.0 && b-y >= 0.0 = 0.0
		  | b-y == 0.0 && a-x < 0.0  = pi/2
		  | b-y == 0.0 && a-x >= 0.0 = -pi/2
		  | b-y > 0.0  && a-x > 0.0  = -(pi/2) + atan(abs((b-y)/(a-x)))
		  | b-y > 0.0  && a-x < 0.0  =  (pi/2) - atan(abs((b-y)/(a-x)))
		  | b-y < 0.0  && a-x > 0.0  = -pi     + atan(abs((a-x)/(b-y)))
		  | b-y < 0.0  && a-x < 0.0  =  pi     - atan(abs((a-x)/(b-y)))

-- draw a series of vertices. This just branches and passes the colours and vertices to drawline
verts :: [Pen] -> [Vertex2f] -> Command
verts _ [] = Sit
verts [] (x:xs) = error ("not enough pens, need " ++ show ((length xs)+1) ++ " more")
verts (p:ps) (x:y:xs) = Branch (drawline p (x,y)) :# verts ps xs
verts _ _ = error "uneven number of verts"

-- Projection constants and a lame hack to scale things up
zNear, zFar, aspect, scale, fovy :: Float
zNear = 1.0
zFar = 1500.0
scale = 100.0
aspect = 3.0/4.0
fovy = pi/4.0

-- give vertices a w component
homogenise :: Vertex3f -> Vertex4f
homogenise (x,y,z) = (x,y,z,1.0)

-- take away a vertex's w component by dividing through (so it is 1 and can be ommitted)
-- w = 0 is the infinity point
dehomogenise :: Vertex4f -> Vertex3f
dehomogenise (x,y,z,0.0) = error "w = 0"
dehomogenise (x,y,z,w) = (x/w,y/w,z/w)

-- render a series of points by homogenising, projecting and dehomogenising them. Scale them up with a cheap hack
render :: [Vertex3f] -> [Vertex2f]
render xs = [(x*scale,y*scale) | (x,y,z) <- (map dehomogenise (map project (map homogenise xs)))]

-- project a single point from world space to screen space. See derivation of a projection
-- matrix for more details here
project :: Vertex4f -> Vertex4f
project (x,y,z,w) = ((zNear*x)/(aspect*(tan fovy)),
		     (zNear*y)/(tan fovy),
		     -(((zFar+zNear)*z)/(zFar-zNear))-((2*zFar*zNear*w)/(zFar-zNear)),
		     -z)

-- the following three functions rotate xs by theta around an axis

rotz :: Float -> [Vertex3f] -> [Vertex3f]
rotz theta xs = [(
		  (x * (cos theta)) - (y * (sin theta)),
		  (y * (cos theta)) + (x * (sin theta)),
		  z
		 )
		 | (x,y,z) <- xs]

roty :: Float -> [Vertex3f] -> [Vertex3f]
roty theta xs = [(
		  (x * (cos theta)) + (z * (sin theta)),
		  y,
		  (z * (cos theta)) - (x * (sin theta))
		 )
		 | (x,y,z) <- xs]

rotx :: Float -> [Vertex3f] -> [Vertex3f]
rotx theta xs = [(
		  x,
		  (y * (cos theta)) + (z * (sin theta)),
		  (z * (cos theta)) - (y * (sin theta))
		 )
		 | (x,y,z) <- xs]

-- translate in 2 or 3 dimensions. Translate is a synonym for translate3f as it is most common

translate3f, translate :: Vertex3f -> [Vertex3f] -> [Vertex3f]
translate3f (dx,dy,dz) xs = [(x+dx, y+dy, z+dz) | (x,y,z) <- xs]
translate = translate3f

translate2f :: Vertex2f -> [Vertex2f] -> [Vertex2f]
translate2f (dx,dy) xs = [(x+dx, y+dy) | (x,y) <- xs]

-- generate a pseudorandom number based on a seed

-- RAND_MAX = 32768
rand :: Int -> Int
rand prev = (next `div` 65536) `mod` 32768
    where next = prev * 1103515245 + 12345

-- rands is an array of pseudorandom numbers

numrands :: Int
numrands = 100000

rands :: [Float]
rands = [((fromIntegral . rand) x)/32768.0 | x <- [1..numrands]]

-- random returns a number  between 0 and 1 based on a seed (aka index)

random :: Int -> Float
random x = rands!!(mod x numrands)

-- recursive tree generation function. Good luck understanding this one

treegenrec :: Vertex3f -> Float -> Int -> Int -> Int -> [Vertex3f]
treegenrec _ _ 0 _ _ = []
treegenrec (x, y, z) len (n+1) num seed =
    [(x, y, z), (x, y+len, z)] ++
    (translate (x, y+len, z) (roty phi0 (rotz theta0 (translate (-x, -y-len, -z) (treegenrec (x,y+len,z) (len*0.7) n num (seed*17)))))) ++
    (translate (x, y+len, z) (roty phi1 (rotz theta1 (translate (-x, -y-len, -z) (treegenrec (x,y+len,z) (len*0.7) n num (seed*18)))))) ++
    (translate (x, y+len, z) (roty phi2 (rotz theta2 (translate (-x, -y-len, -z) (treegenrec (x,y+len,z) (len*0.7) n num (seed*19))))))
	where
	theta0 = (-pi/6)+(randrange (-0.4) 0.4 (seed*4))
	theta1 = (randrange (-0.4) 0.4 (seed*5))
	theta2 = (pi/6)+(randrange (-0.4) 0.4 (seed*6))
	phi0 = (pi/3)+(randrange (-0.4) 0.4 (seed*7))
	phi1 = (4*pi/3)+(randrange (-0.4) 0.4 (seed*8))
	phi2 = (8*pi/3)+(randrange (-0.4) 0.4 (seed*9))
	randrange lower upper seed = ((upper-lower)*(random seed))+lower

-- alias to call the recursive function with a parameter doubled up

treegen :: Vertex3f -> Float -> Int -> Int -> [Vertex3f]
treegen a b c d = treegenrec a b c c d

-- generate colours for the tree. Each line gets a value between 0 and 1
-- used to interpolate between two colours (bark and leaf). It is randomised
-- a little to look better

colourgenrec :: Int -> Int -> Int -> [Float]
colourgenrec 0 _ _ = []
{-
colourgenrec (n+1) num seed = [1.0 - ((2/pi)*(acos w))] ++
		      (colourgenrec n num seed) ++
		      (colourgenrec n num seed) ++
		      (colourgenrec n num seed)
	where
	w = (fromIntegral (num-n))/(fromIntegral num)
-}
colourgenrec (n+1) num seed = [w] ++ 
		      (colourgenrec n num ((round . random) seed)) ++
		      (colourgenrec n num ((round . random) (seed+1))) ++
		      (colourgenrec n num ((round . random) (seed+2)))
    where 
    w | n == 0 = 1.0-((random seed)*0.4)
      | otherwise = 0.0+((random seed)*0.2)

-- another alias

colourgen :: Int -> [Float]
colourgen a = colourgenrec a a ((round .random) a)

-- interpolate linearly between two colours

interp :: Pen -> Pen -> Float -> Pen
interp (Colour r1 g1 b1) (Colour r2 g2 b2) f = (Colour ((r1*f)+(r2*(1.0-f))) ((g1*f)+(g2*(1.0-f))) ((b1*f)+(b2*(1.0-f))))
interp _ _ _ = Inkless

-- bark and leaf colours

bark, leaf :: Pen
bark = (Colour (151.0/255.0)
	       (107.0/255.0)
               (14.0/255.0))
leaf = (Colour 0 1.0 0)

-- do a little section of grass

grassbit :: Int -> Vertex2f -> [Vertex3f]
grassbit 0 _ = []
grassbit (n+1) (x, y) = [(x+dx,0,y+dy),(x+dx,height,y+dy)] ++ grassbit n (x,y)
    where dx = random (n*672)
	  dy = random (n*263)
	  height = (random (n*342))*0.5 + 0.5

-- put together sections of grass in a square of dimensions x and y

grass :: Vertex2f -> [Vertex3f]
grass (x, y) = foldr1 (++) (map (grassbit 5) ([(a,b) | (a, b) <- (zip (foldr1 (++) (replicate (round (y+1)) [-x/2..(x/2)-1])) (foldr1 (++) (map (replicate (round (x+1))) [-y/2..(y/2)-1])))]))

-- get grass colours for a x by y lawn of grass

grasscolours :: Vertex2f -> [Pen]
grasscolours (x, y) = colours ((lengrass (x,y)) `div` 2)
    where lengrass dim = length (grass dim)
	  scales n = random (n*2873)
	  colours n = [interp (Colour 0 0.6 0) (Colour 0.6 1.0 0.6) (scales x) | x <- [1..n]]

-- recursive function to generate a grid for the ground

groundrec :: Float -> Float -> Float -> Float -> [Vertex3f]
groundrec offx offy x y | offx > x || offy > y = []
		     | otherwise = [(-x/2, 0, y/2-offy), (x/2, 0, y/2-offy),
				    (-x/2+offx, 0, y/2), (-x/2+offx, 0, -y/2)] ++
				   groundrec (offx+1.0) (offy+1.0) x y

ground :: Float -> Float -> [Vertex3f]
ground = groundrec 0 0

-- get ground colours (not actually recursive)

groundcoloursrec :: Float -> Float -> Float -> Float -> [Pen]
groundcoloursrec a b c d = replicate ((lenground a b c d) `div` 2) (Colour 0 1 0)
    where lenground a b c d = length (groundrec a b c d)

groundcolours :: Float -> Float -> [Pen]
groundcolours a b = replicate ((lenground a b) `div` 2) (Colour 0 1 0)
    where lenground a b = length (ground a b)

-- parameters:
-- tree seed, x rotation angle, y rotation angle ground dimensions (square), tree depth, postscript scale
treedisplay :: Int -> Float -> Float -> Float -> Int -> Float -> IO ()
treedisplay treeseed xrot yrot gdim depth scale = (display scale) (verts (groundcolours gdim gdim ++ grasscolours (gdim, gdim) ++ (map (interp leaf bark) (colourgen depth))) (translate2f (0,-60) (render (translate (0, 0, -30) (rotx xrot (roty yrot (ground gdim gdim++grass (gdim, gdim)++(treegen (0, 0, 0) 8 depth treeseed))))))))

maindisplay :: Float -> IO ()
maindisplay = treedisplay 20 (-pi/6) (pi/3) 35 8




-- FINAL COMMENTS:
-- This takes 30 seconds to display on the DICE machine maesquoy. Please allow up to 1 minute on a slow computer, this is a computationally expensive
-- rendering, so please be patient. For the parameter to maindisplay, this is the scale passed to "display". 2.5 works well, but please adjust so the
-- whole image is viewable. You can call treedisplay directly and change some of the values. For example play with the two rotation values (not too much
-- or it might break) to check that the tree really is 3D. The last parameter given in maindisplay (8) is the number of subbranches. Turn that down and
-- reduce the computation time. Same with the second last (35) which is the dimensions of the grass. To generate different trees, change the seed (20).
-- This is limited by the pseudorandom number generator though.
--
-- Hope you like the picture,
--
-- Baldur Karlsson (16/11/05)