-- Informatics 1 - Functional Programming
-- Graphics Competition
--
-- HASKELL CHRISTMAS!
-- by Jose Emilio Munoz Lopez (s1008042)
{-
By typing merryxmas on the terminal you will get a nice Christmas card made entirely in Haskell. Enjoy and have a wonderful Christmas and a happy 2011!
-}
import LSystem
import Test.QuickCheck
copy :: Int -> Command -> Command
copy 0 c = Sit
copy n c = c :#: (copy (n-1) c)
branch :: Int -> Command
branch x = g x
where
g 0 = GrabPen (Colour 0 1 0) :#: Go 50
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 = GrabPen (Colour 0 0.5 0) :#: Go 50
f (x+1) = f x :#: f x
p = Turn ( 22.5)
n = Turn (-22.5)
branchRed :: Int -> Command
branchRed x = g x
where
g 0 = GrabPen red :#: Go 50
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 = GrabPen Inkless :#: Go 50
f (x+1) = f x :#: f x
p = Turn ( 22.5)
n = Turn (-22.5)
spiralCommand :: Distance -> Int -> Distance -> Angle -> (Int -> Command)-> Int -> Command
spiralCommand side n step angle c x = f side n
where
f side n | n>0 && side>0 = Go side :#: c x :#: Turn angle :#: f (side+step) (n-1)
| otherwise = Sit
curve :: Distance -> Int -> Angle -> Command
curve side n angle = f side n
where f side n | n >0 && side >0 = Go side :#: Turn (angle) :#: (f side (n-1))
| otherwise = Sit
mary :: Distance -> Command
mary x = Turn (-180) :#: Go (x*30) :#: (curve 0.1 130 (-1)) :#: Go (x*10) :#: (curve 0.1 50 (-1)) :#: Go (x*30) :#: (curve 1 60 (-1)) :#: Go (x*20) :#: curve 1 50 (-1) :#: curve 2 120 (-2) :#: GrabPen Inkless :#: Turn (-10) :#: Go (x*10) :#: GrabPen black :#: curve 2 100 (-2) :#: GrabPen Inkless :#: Turn (-10) :#: Go (x*17) :#: Turn (30) :#: GrabPen black :#: Go (x*30) :#: curve 1 50 (-1) :#: Go (x*3) :#: curve 0.1 140 (1) :#: Go (x*30)
jesus :: Distance -> Command
jesus x = curve 0.1 130 1 :#: Go (x*5) :#: curve 0.5 90 (-1) :#: Go (x*20) :#: curve 0.1 40 (-1) :#: Go (x*5):#: GrabPen Inkless :#: Go (x*10) :#: GrabPen black :#: Go (x*6) :#: curve 0.1 130 (-1) :#: Go (x*20) :#: curve 0.1 50 (-1) :#: Go (x*20) :#: curve 0.1 140 (-1):#: Go (x*18) :#: curve 0.1 180 (-1) :#: Go (x*10) :#: curve 0.1 140 1 :#: Go (x*8) :#: curve 0.1 40 (1) :#: Go (x*10) :#: curve 0.1 120 1 :#: curve 0.1 140 (-1) :#: curve 0.6 280 1 :#: GrabPen Inkless :#: Turn (140) :#: Go (x*8) :#: GrabPen black :#: curve 0.5 180 (-1) :#: GrabPen Inkless :#: Turn 10 :#: Go (x*15) :#: GrabPen black :#: Go (x*10)
joseph :: Distance -> Command
joseph x = GrabPen Inkless :#: Turn 90 :#: Go (x*25) :#: Turn 90 :#: GrabPen black :#: Go (x*40) :#: curve 0.4 180 1 :#: curve 0.1 180 (-1) :#: curve 0.6 180 (-1) :#: Go (x*40) :#: GrabPen Inkless :#: Turn 180 :#: Go (x*55) :#: GrabPen black :#: Turn 90 :#: curve 1 270 (-1) :#: curve 0.1 30 1 :#: Go (x*20) :#: curve 1 10 (-1) :#: Go (x*20) :#: curve 1 60 (-1) :#: Go (x*20) :#: curve 0.5 140 (-1) :#: Go (x*50) :#: GrabPen Inkless :#: Turn (45) :#: Go (x*18) :#: GrabPen black :#: curve 1 200 (-1)
putTogether :: Distance -> (Distance -> Command) -> (Distance -> Command) -> (Distance -> Command) -> Command
putTogether x c1 c2 c3 = c1 x :#: c2 x :#: c3 x
superimposeRing :: Command -> Command -> Command
superimposeRing c1 c2 = Branch (GrabPen Inkless :#: Go 430 :#: Turn (-90) :#: Go 430 :#: Turn (90) :#: GrabPen black :#: c1) :#: GrabPen black :#: c2
superimposeImages :: Command -> Command -> Command
superimposeImages c1 c2 = Branch (c1) :#: c2
merryxmas = display ((superimposeRing (putTogether 10 mary jesus joseph) (superimposeImages (copy 2 (spiralCommand 0.1 12 0.5 4 branch 4)) (spiralCommand 0.1 12 0.5 4 branchRed 4))))