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