---------------------- -- 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])