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