“It is more blessed to give than to receive” (Acts 20:35)

http://itunes.apple.com/gb/album/poetry-in-motion-dreamboats/id399086174?i=399086967

When I see my baby
What do I see
Poetry
Poetry in motion
Poetry in motion
Walkin’ by my side
Her lovely locomotion
Keeps my eyes open wide
Poetry in motion
See her gentle sway
A wave out on the ocean
Could never move that way
I love every movement
And there’s nothing I would change
She doesn’t need improvement
She’s much too nice to rearrange
Poetry in motion
Dancing close to me
A flower of devotion
A swaying gracefully
Whoa
Whoa, whoa, whoa, whoa, whoa
Whoa, whoa, whoa, whoa, whoa
Whoa, whoa, whoa, whoa, whoa
Whooooooooa
Poetry in motion
See her gentle sway
A wave out on the ocean
Could never move that way
I love every movement
There’s nothing I would change
She doesn’t need improvement
She’s much too nice to rearrange
Poetry in motion
All that I adore
No number-nine love potion
Could make me love her more
Whoa
Whoa, whoa, whoa, whoa, whoa
Whoa, whoa, whoa, whoa, whoa
Whoa, whoa, whoa, whoa, whoa

Am soooo proud that I worked it out myself!!! XD

–
– EXERCISE 4
– Turtle graphics and L-systems (actually simple DOL)

import ICGraphics
import Graphics.HGL

type Rule = ( Char, String )

type Rules = [ Rule ]

type Vertex = ( Float, Float )

type TurtleState = ( Vertex, Float )

type ColouredLine = ( Vertex, Vertex, Color, Int )

type Stack = [ TurtleState ]

—————————————————————————-

– some test systems

system :: Int -> ( Float, String, Rules )

– Cross
system 1 = ( 90, “M-M-M-M”, [ ( ‘M’, “M-M+M+MM-M-M+M” ),
( ‘+’, “+” ),
( ‘-‘, “-“ ) ] )

– Triangle
system 2 = ( 90, “-M”, [ ( ‘M’, “M+M-M-M+M” ),
( ‘+’, “+” ),
( ‘-‘, “-“ ) ] )

– Arrowhead
system 3 = ( 60, “N”, [ ( ‘M’, “N+M+N” ),
( ‘N’, “M-N-M” ),
( ‘+’, “+” ),
( ‘-‘, “-“ ) ] )

– Peano-Gosper
system 4 = ( 60, “M”, [ ( ‘M’, “M+N++N-M–MM-N+” ),
( ‘N’, “-M+NN++N+M–M-N” ),
( ‘+’, “+” ),
( ‘-‘, “-“ ) ] )

– Dragon
system 5 = ( 45, “MX”, [ ( ‘M’, “A” ),
( ‘X’, “+MX–MY+” ),
( ‘Y’, “-MX++MY-“ ),
( ‘A’, “A” ),
( ‘+’, “+” ),
( ‘-‘, “-“ ) ] )

– Snowflake
system 6 = ( 60, “M–M–M”, [ ( ‘M’, “M+M–M+M” ),
( ‘+’, “+” ),
( ‘-‘, “-“ ) ] )

– Tree
system 7 = ( 45, “M”, [ ( ‘M’, “N[-M][+M][NM]”),
( ‘N’, “NN”),
( ‘[‘, “[“ ),
( ‘]’, “]” ),
( ‘+’, “+” ),
( ‘-‘, “-“ ) ] )

– Bush
system 8 = ( 22.5, “X”, [ ( ‘X’, “M-[[X]+X]+M[+MX]-X” ),
( ‘M’, “MM” ),
( ‘[‘, “[“ ),
( ‘]’, “]” ),
( ‘+’, “+” ),
( ‘-‘, “-“ ) ] )

mapper = [ ( ‘M’, “F” ),
( ‘N’, “F” ),
( ‘X’, “” ),
( ‘Y’, “” ),
( ‘A’, “” ),
( ‘[‘, “[“ ),
( ‘]’, “]” ),
( ‘+’, “L” ),
( ‘-‘, “R” ) ]

angle :: Int -> Float
angle index = a
where ( a, b, ru ) = system index

base :: Int -> String
base index = b
where ( a, b, ru ) = system index

rules :: Int -> Rules
rules index = ru
where ( a, b, ru ) = system index

lookupChar :: Char -> Rules -> String
– Looks up command character in rule table
– pre: the character has a binding in the table
lookupChar cha ( ( c, ru ) : rus )
| cha == c = ru
| otherwise = lookupChar cha rus

expandOne :: Rules -> String -> String
– Expand command string s once using rule table r
expandOne any [] = []
expandOne ru ( b : bs )
= lookupChar b ru ++ expandOne ru bs

expand :: Rules -> String -> Int -> String
– Expands command string s n times using rule table r
expand ru bs 0 = bs
expand ru bs n = expand ru ( expandOne ru bs ) ( n - 1 )

move :: Char -> TurtleState -> Float -> TurtleState
– Move turtle: ‘F’ moves distance 1, ‘L’, ‘R’ rotate left and right
– by give angle
move ‘F’ ( ( x, y ), dir ) angleturn
= ( ( x + cos ang , y + sin ang ), dir )
where ang = dir * pi / 180

move ‘L’ ( ver, dir ) angleturn
= ( ver, dir + angleturn )

move ‘R’ ( ver, dir ) angleturn
= ( ver, dir - angleturn )

move ‘[‘ ( ver, dir ) angleturn
= ( ver, dir )

move ‘]’ ( ver, dir ) angleturn
= ( ver, dir )

trace :: String -> Float -> Color -> [ ColouredLine ]
– Traces lines drawn by turtle using given colour following commands in cs
– assuming given angle of rotation
trace mo angleturn colour
= traceHelper ( ( 0.0, 0.0 ), 90 ) [] mo angleturn colour

traceHelper :: TurtleState -> [ TurtleState ] -> String -> Float -> Color -> [ ColouredLine ]
traceHelper ( ver, dir ) brackets [] angleturn colour = []
traceHelper ( ver, dir ) brackets ( movement : movements ) angleturn colour
| movement == ‘[‘
= traceHelper nextstate ( ( ver, dir ) : brackets ) movements angleturn colour
| movement == ‘]’
= traceHelper ba bas movements angleturn colour
| movement == ‘L’ || movement == ‘R’
= traceHelper nextstate brackets movements angleturn colour
| otherwise = ( ver, fst nextstate, colour, 1 ) :
traceHelper nextstate brackets movements angleturn colour
where nextstate = move movement ( ver, dir ) angleturn
( ba, bas ) = ( head brackets, tail brackets )