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  - Library of CSG shapes.
   17  -
   18  -}
   19 
   20 module Shapes where
   21 
   22 import Interval
   23 import Kolor
   24 import Types
   25 
   26 cube = Object (Cube 0 0 0 1.2)
   27 
   28 sphere = Object (Sphere 0 0 0 1.2)
   29 
   30 x = Object X
   31 y = Object Y
   32 z = Object Z
   33 
   34 x' = Comp (Object X)
   35 y' = Comp (Object Y)
   36 z' = Comp (Object Z)
   37 
   38 rot1   = Geom cube  (RotX  0.1)
   39 rot2   = Geom cube  (RotX  0.2)
   40 rot3   = Geom cube  (RotX  0.3)
   41 
   42 rotz   = Geom cube  (RotZ  0.3)
   43 roty   = Geom cube  (RotY  0.3)
   44 rotx   = Geom cube  (RotX  0.3)
   45 rotxy  = Geom rotx  (RotY  0.3)
   46 rotxyz = Geom rotxy (RotZ  0.3)
   47 
   48 ex1 = cube `Sub` sphere
   49 ex2 = cube `Union` sphere
   50 
   51 plane = Object (Plane 0.0 0.0 1 0)
   52 
   53 complex = Geom ex1 (Trans  0 0 (-1.5))
   54 
   55 st1 = plane `Union` complex
   56 st2 = complex
   57 
   58 
   59 bin = Inter x z
   60 cin = Inter (Comp x) z
   61 
   62 a = Geom x' (Trans   0.8  0 0)
   63 b = Geom x  (Trans (-0.8) 0 0)
   64 c = a `Inter` b
   65 d = a `Union` b
   66 g = c `Inter` z
   67 h = d `Inter` z
   68 
   69 bigs = Object (Sphere 0 0 0 1.2)
   70 smls = Object (Sphere 0 0.3 0.3 1.0)
   71 bite = bigs `Sub` smls
   72 
   73 obja = Colour honeydew ( Object (Sphere (-0.5) (-1) 1 0.8) )
   74 objb = Colour violet   ( Object (Sphere 0.5 (-1) 0 0.6) )
   75 objc = Colour green_yellow ( Object (Sphere (-0.2) 0.5 (-0.8) 1.2) )
   76 pic = foldr1 Union [obja,objb,objc]
   77 
   78 pic2 =
   79   Union  (Object (Sphere 0.0 1.0 0.0 1.0))
   80          (Sub    (Object (Cube 0.0 0.0 0.0 3.0))
   81                  (Union (Object (Sphere 0.0 7.0   3.0  5.0))
   82                         (Object (Sphere 0.0 7.0 (-3.0) 5.0))))
   83