module RasterGraphics where

import RenderBMP

---------------

type Space  = (Double,Double)
type Color  = Int
type Pict   = Space -> Color
type Figure = Space -> Maybe Color
[black, white, red, orange, yellow, green, blue, purple] = 
	[0x000000, 0xffffff, 0xff0000, 0xff9900, 0xffff00, 0x00ff00, 0x0000ff, 0x6600cc] :: [Int]

---------------

blank = \(x,y) -> Nothing
when b y = if b then Just y else Nothing
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
layer figs = foldl on blank figs

---------------

range n = [-m..m] where m = (n-1) / 2
space n m = map (\y -> (map (\x -> (x,y)) (range n))) (reverse (range m))
render fig w h = map (map (scale mag mag (fig `orr` white))) (space w h)
try p = test (round x) (round y) (concat (render p x y))
        where size = base*mag
              x = 2*size-1
              y =   size-1
base = 30.0
mag  =  3.0		-- use (30,3) for Hugs, (50,8) for GHCi (on my Mac)

---------------

dist x y = sqrt (x^2 + y^2)
shift n m f = \(x,y) -> f (x-n, y-m)
scale n m f = \(x,y) -> f (x/n, y/m)
skew  n m f = \(x,y) -> f (x-(n*y/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)

---------------

within x n = -m<=x && x<=m where m = (n-1)/2
rect w h c = \(x,y) -> when (x `within` w && y `within` h) c
circ r c   = \(x,y) -> when (dist x y < r) c
square r c = rect (2*r) (2*r) c
radial  c = \(x,y) -> when (p x y) c
            where p x y = if y==0 then True else even (round (x / y))
stripe k c = skew k k (\(x,y) -> when (round x `mod` round k == 0) c)
checker c = \(x,y) -> when (even (round x + round y)) c

---------------

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

tree   = shift 0 3 (circ 9 green) `on` shift 0 (-8) (rect 5 11 black)
target = layer (zipWith circ [1,3..13] (cycle [red,white]))
wagon  = layer [shift 0 5 (rect 25 5 red), shift (-6) 0 wheel, shift 6 0 wheel]
         where wheel = circ 4 black
mickey = layer [circ 9 black, shift 8 8 ear, shift (-8) 8 ear]
         where ear = circ 5 black
dizzy  = skew 2 3 (mickey `on` radial orange `on` checker yellow)
scene  = tree `on` sun `on` field
         where sun   = shift 17 10   (circ 5 yellow)
               field = shift 0 (-13) (\(x,y) -> when (y `within` 3) green)
scene2 = shift (-18) (-10) (scale 0.75 0.75 wagon) `on` scene
galaxy = skew 3 3 (target `on` scale 2 2 (checker green))
stripy = scale 2 1 (stripe 4 blue)
messy  = skew 2 3 (layer [scale (-2) 2 (stripe 5 purple), target, stripy])

simple = (circ 5 red `on` shift 4 0 (rect 10 20 blue)) `on` radial yellow