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  - Oct-tree to Quad-tree processing.
   17  -
   18  -}
   19 
   20 module Quad(quadoct) where
   21 
   22 import Oct
   23 import Csg
   24 import Types
   25 import Interval
   26 
   27 quadoct o = qo o Q_Empty
   28 
   29 qo (o        ) q@(Q_Full t) = q
   30 qo (O_Empty  ) (q         ) = q
   31 qo (O_Sub s l) (Q_Empty   ) = Q_Sub s z
   32                    where
   33                      (l0:ll1) = l   ; (l1:ll2) = ll1
   34                      (l2:ll3) = ll2 ; (l3:ll4) = ll3
   35                      (l4:ll5) = ll4 ; (l5:ll6) = ll5
   36                      (l6:ll7) = ll6 ; (l7:ll8) = ll7
   37                      z = [ qo (l1) (qo (l0) Q_Empty) ,
   38                            qo (l3) (qo (l2) Q_Empty) ,
   39                            qo (l5) (qo (l4) Q_Empty) ,
   40                            qo (l7) (qo (l6) Q_Empty) ]
   41 qo (O_Sub s l) (Q_Sub t k) = Q_Sub t z
   42                    where
   43                      (l0:ll1) = l   ; (l1:ll2) = ll1
   44                      (l2:ll3) = ll2 ; (l3:ll4) = ll3
   45                      (l4:ll5) = ll4 ; (l5:ll6) = ll5
   46                      (l6:ll7) = ll6 ; (l7:ll8) = ll7
   47                      (k0:kk1) = k   ; (k1:kk2) = kk1
   48                      (k2:kk3) = kk2 ; (k3:kk4) = kk3
   49                      z = [ qo (l1) (qo (l0) (k0)) ,
   50                            qo (l3) (qo (l2) (k1)) ,
   51                            qo (l5) (qo (l4) (k2)) ,
   52                            qo (l7) (qo (l6) (k3)) ]
   53 qo o@(O_Full s) (Q_Sub t k) = Q_Sub t z
   54                    where
   55                      (k0:kk1) = k   ; (k1:kk2) = kk1
   56                      (k2:kk3) = kk2 ; (k3:kk4) = kk3
   57                      z = [ qo o (k0) , qo o (k1) ,
   58                            qo o (k2) , qo o (k3) ]
   59 qo (O_Full s ) (q         ) = Q_Full s
   60