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