----------------------
-- ASCII Graphics in Haskell
-- Fritz Ruehr, CS 254, Spring 08


-- fundamental type definitions

type Space = (Integer,Integer)

type Pict   = Space -> Color

type Color  = Char

type Figure = Space -> Maybe Color

[black, white, red, orange, yellow, green, blue, purple] = "@ Ri'gB#"


-- some Maybe utilities

f `orr` b = \x -> case f x of Nothing -> b   ; Just y -> y

f `on`  g = \x -> case f x of Nothing -> g x ; Just y -> Just y

when b y = if b then Just y else Nothing

blank = \(x,y) -> Nothing


-- number range utilities

rangep n = (-m, m) where m = (n-1) `div` 2
rangel n = [-m..m] where m = (n-1) `div` 2

inn x (a,b) = a<=x && x<=b


-- overall figure painting

-- space n m = [(x,y) | x<-[-n..n], y<-[-m..m]]

space n m = map (\y -> (map (\x -> (x,y)) (rangel n))) (reverse (rangel m))

render fig w h = map (map (fig `orr` white)) (space w h)

paint fig = putStr (unlines (render fig stdwidth stdheight))

stdwidth  = 59
stdheight = 29

layer figs = foldl on blank figs


-- some basic shapes

rect w h c = \(x,y) -> when (x `inn` rangep w && y `inn` rangep h) c
circ r c   = \(x,y) -> when (dist x y < r) c

dist :: Integer -> Integer -> Integer
dist x y = floor (sqrt (fromInteger (x^2 + y^2)))

square r c = rect (2*r) (2*r) c


-- some Pan-style patterns

checker c = \(x,y) -> when (even (x+y)) c

radial  c = \(x,y) -> when (p x y) c
            where p x y = if y==0 then True else even (x `div` y)

stripe k c = skew k k (\(x,y) -> when (x `mod` k == 0) c)


-- picture transformations

shift n m f = \(x,y) -> f (x-n, y-m)
scale n m f = \(x,y) -> f (x `div` n, y `div` m)
skew  n m f = \(x,y) -> f (x-((n*y) `div` m), y)

swap (x,y) = (y,x)
diag f = f . swap

flipv f = \(x,y) -> f (x,-y)
fliph f = \(x,y) -> f (-x,y)



-- sample pictures

squirc n = circ n yellow `on` square n blue

tree   = shift 0 3 (circ 9 green) `on` shift 0 (-8) (rect 5 11 black)

scene  = tree `on` sun `on` field
         where sun   = shift 17 10   (circ 5 yellow)
               field = shift 0 (-13) (rect stdwidth 3 green)

mickey = layer [circ 9 black, shift 8 8 ear, shift (-8) 8 ear]
         where ear = circ 5 black

wagon  = layer [shift 0 5 (rect 25 5 red), shift (-6) 0 wheel, shift 6 0 wheel]
         where wheel = circ 4 black

target = layer (zipWith circ [1,3..13] (cycle [red,white]))

galaxy = skew 3 3 (target `on` scale 2 2 (checker yellow))

stripy = scale 2 1 (stripe 4 blue)

messy  = skew 2 3 (layer [scale (-2) 2 (stripe 5 yellow), target, stripy])