1 {- 2 - Fulsom (The Solid Modeller, written in Haskell) 3 - 4 - Copyright 1990,1991,1992,1993 Duncan Sinclair 5 - 6 - Permissiom to use, copy, modify, and distribute this software for any 7 - purpose and without fee is hereby granted, provided that the above 8 - copyright notice and this permission notice appear in all copies, and 9 - that my name not be used in advertising or publicity pertaining to this 10 - software without specific, written prior permission. I makes no 11 - representations about the suitability of this software for any purpose. 12 - It is provided ``as is'' without express or implied warranty. 13 - 14 - Duncan Sinclair 1993. 15 - 16 - Quad-tree to raster-format processing. 17 - 18 -} 19 20 module Raster(draw,cdraw) where 21 22 import Interval 23 import Kolor 24 import Quad 25 import Types 26 27 {- 28 29 Description of raster protocol: 30 31 Each value is a "Word", which is a two byte value, MSB, then LSB. 32 33 Flags, Dimensions, (Location, Value)* 34 35 Flags : F (defined below.) 36 Dimensions : XX,YY (If not square.) 37 : S (If square.) 38 Location : X,Y,H,W (If not square.) 39 : X,Y,D (If square.) 40 Value : V (If mono.) 41 : R,G,B (If colour.) 42 43 Flags: 0x0001 = square - expect only one dimension. 44 0x0002 = colour - expect triples. 45 46 Background is defined as values unassigned at end. 47 48 -} 49 50 51 -- square, colour... 52 53 cdraw :: Int -> Quad -> [Char] 54 cdraw depth q = (wordy (3:w:(cout (0,0) w q [])) ) 55 where 56 w :: Int 57 w = 2 ^ (depth::Int) 58 59 cout :: (Int,Int) -> Int -> Quad -> [Int] -> [Int] 60 cout xy w (Q_Empty ) = \ints -> ints 61 cout xy w (Q_Full a ) = \ints -> (coutlines xy w a) ints 62 -- cout xy@(x,y) w (Q_Sub a l) = (coutlines xy w a) . e . f . g . h 63 cout (x,y) w (Q_Sub a l) = e . f . g . h 64 where 65 (l0:ll1) = l ; (l1:ll2) = ll1 66 (l2:ll3) = ll2 ; (l3:ll4) = ll3 67 e = cout (x ,y ) n (l0) 68 f = cout (x+n,y ) n (l1) 69 g = cout (x ,y+n) n (l2) 70 h = cout (x+n,y+n) n (l3) 71 n = w `div` 2 72 73 coutlines :: (Int,Int) -> Int -> Color -> [Int] -> [Int] 74 coutlines (x,y) l colour = \next -> x:y:l:r:g:b:next 75 where 76 (r,g,b) = unmkcolor colour 77 78 -- non-square, monochrome... 79 80 draw :: Int -> Quad -> [Char] 81 draw depth q = (wordy (0:w:w:(out (0,0) w q [])) ) 82 where 83 w :: Int 84 w = 2 ^ (depth::Int) 85 86 out :: (Int,Int) -> Int -> Quad -> [Int] -> [Int] 87 out xy w (Q_Empty ) = \ints -> ints 88 out xy w (Q_Full a ) = \ints -> (outlines xy w a) ints 89 -- out xy@(x,y) w (Q_Sub a l) = (outlines xy w a) . e . f . g . h 90 out (x,y) w (Q_Sub a l) = e . f . g . h 91 where 92 (l0:ll1) = l ; (l1:ll2) = ll1 93 (l2:ll3) = ll2 ; (l3:ll4) = ll3 94 e = out (x ,y ) n (l0) 95 f = out (x+n,y ) n (l1) 96 g = out (x ,y+n) n (l2) 97 h = out (x+n,y+n) n (l3) 98 n = w `div` 2 99 100 outlines :: (Int,Int) -> Int -> Color -> [Int] -> [Int] 101 outlines (x,y) l s = \n -> x:y:l:l:(shade s):n 102 103 shade :: Color -> Int 104 shade (RGB r g b) = round ((sqrt r)*255) 105 106 -- and (<256) (wordy x) = True 107 108 wordy :: [Int] -> [Char] 109 wordy [] = [] 110 wordy (a:bs) = (toEnum b):(toEnum c):(wordy bs) 111 where 112 (b,c) = a `divMod` 256 113