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  - Csg to Oct-tree processing.
   17  -
   18  -}
   19 
   20 module Oct (octcsg) where
   21 
   22 import Csg
   23 import Interval
   24 import Types
   25 import Kolor
   26 import Vector
   27 
   28 startx = -2
   29 endx = 2
   30 
   31 starty = -2
   32 endy = 2
   33 
   34 startz = -2
   35 endz = 2
   36 
   37 makeoct :: Csg -> Oct
   38 makeoct csg = octer 1 csg xyz
   39   where
   40    xyz = (x,y,z)
   41    x = startx # endx
   42    y = starty # endy
   43    z = startz # endz
   44 
   45 
   46 -- octer :: Int -> Csg -> (R3 BI) -> Oct
   47 octer nn csg xyz
   48     = case (calc csg white xyz) of
   49         (res,newc',rgb,new) -> 
   50          let
   51           newc = if new then newc' else csg
   52           c = light rgb (calcn newc xyz)
   53           (x,y,z) = xyz
   54           bhx = bothalf x ; thx = tophalf x
   55           bhy = bothalf y ; thy = tophalf y
   56           tbz = topbit  z ; bhz = bothalf z
   57           os  = if nn == 1 then osb else osa
   58           n1  = nn + 1
   59           osa = map (octer n1 newc)
   60                [ (bhx,bhy,tbz) , (bhx,bhy,bhz) ,
   61                  (thx,bhy,tbz) , (thx,bhy,bhz) ,
   62                  (bhx,thy,tbz) , (bhx,thy,bhz) ,
   63                  (thx,thy,tbz) , (thx,thy,bhz) ]
   64           osb = [(octer n1 newc (bhx,bhy,tbz)) ,
   65                  (octer n1 newc (bhx,bhy,bhz)) ,
   66                  (octer n1 newc (thx,bhy,tbz)) ,
   67                  (octer n1 newc (thx,bhy,bhz)) ,
   68                  (octer n1 newc (bhx,thy,tbz)) ,
   69                  (octer n1 newc (bhx,thy,bhz)) ,
   70                  (octer n1 newc (thx,thy,tbz)) ,
   71                  (octer n1 newc (thx,thy,bhz)) ]
   72          in
   73              if res < (pt 0) then
   74               O_Full c
   75              else if res > (pt 0) then
   76               O_Empty
   77              else
   78               O_Sub c os
   79 
   80 {-
   81           os = map (octer newc)
   82                [ (bhx,bhy,tbz) , (bhx,bhy,bhz) ,
   83                 (thx,bhy,tbz) , (thx,bhy,bhz) ,
   84                 (bhx,thy,tbz) , (bhx,thy,bhz) ,
   85                 (thx,thy,tbz) , (thx,thy,bhz) ]
   86 -}
   87 
   88 calcn csg xyz = normalise (makevector f0 f1 f2 f3)
   89   where
   90     (f0,_,_,_) = calc csg black (mid1 x,mid1 y,mid2 z)
   91     (f1,_,_,_) = calc csg black (mid2 x,mid1 y,mid2 z)
   92     (f2,_,_,_) = calc csg black (mid1 x,mid2 y,mid2 z)
   93     (f3,_,_,_) = calc csg black (mid1 x,mid1 y, up  z)
   94     (x,y,z) = xyz
   95 
   96 
   97 pruneoct :: Int -> Oct -> Oct
   98 pruneoct 0 (O_Sub c os) = O_Full c
   99 pruneoct n (O_Sub c os) = O_Sub c (map (pruneoct (n-1)) os)
  100 pruneoct n o            = o
  101 
  102 octcsg :: Int -> Csg -> Oct
  103 octcsg depth = (pruneoct depth) . makeoct
  104 
  105