1 -- Copyright (c) 2000 Galois Connections, Inc. 2 -- All rights reserved. This software is distributed as 3 -- free software under the license in the file "LICENSE", 4 -- which is included in the distribution. 5 6 module Surface 7 ( SurfaceFn (..) 8 , Properties 9 , sfun, sconst 10 , prop 11 , matte, shiny 12 , chgColor 13 , surface 14 ) where 15 16 import Geometry 17 import CSG 18 import Misc 19 20 -- the surface gets passed face then u then v. 21 data SurfaceFn c v = SFun (Int -> Double -> Double -> Properties c v) 22 | SConst (Properties c v) 23 24 sfun :: (Int -> Double -> Double -> Properties c v) -> SurfaceFn c v 25 -- never enteredsfun = SFun 26 sconst :: Properties c v -> SurfaceFn c v 27 -- never enteredsconst = SConst 28 29 type Properties c v = (c, v, v, v) 30 31 -- entered 32,512 timesprop c d s p = (c, d, s, p) 32 33 -- never enteredmatte = (white, 1.0, 0.0, 1.0) 34 -- never enteredshiny = (white, 0.0, 1.0, 1.0) 35 36 chgColor :: c -> Properties d v -> Properties c v 37 -- never enteredchgColor c (_, d, s, p) = (c, d, s, p) 38 39 instance (Show c, Show v) => Show (SurfaceFn c v) where 40 -- never enteredshow (SFun _) = "Surface function" 41 -- show (SConst p) = "Surface constant: " ++ show p 42 show (SConst p) = "Surface constant" 43 44 evalSurface :: SurfaceFn Color Double -> Int -> Double -> Double -> Properties Color Double 45 -- entered 32,512 timesevalSurface (SConst p) = \_ _ _ -> p 46 evalSurface (SFun f) = f 47 48 -- calculate surface properties, given the type of 49 -- surface, and intersection point in object coordinates 50 51 -- surface :: Surface SurfaceFn -> (Int, Point) -> (Vector, Properties) 52 53 -- entered 32,512 timessurface (Planar _ v0 v1) (n, p0, fn) 54 = (norm, evalSurface fn n' u v) 55 where norm = normalize $ cross v0 v1 56 (n', u, v) = planarUV n p0 57 58 surface (Spherical _ v0 v1) (_, p0, fn) 59 = (norm, evalSurface fn 0 u v) 60 where x = xCoord p0 61 y = yCoord p0 62 z = zCoord p0 63 k = sqrt (1 - sq y) 64 theta = adjustRadian (atan2 (x / k) (z / k)) 65 -- correct so that the image grows left-to-right 66 -- instead of right-to-left 67 u = 1.0 - clampf (theta / (2 * pi)) 68 v = clampf ((y + 1) / 2) 69 norm = normalize $ cross v0 v1 70 71 -- ZZ ignore the (incorrect) surface model, and estimate the normal 72 -- from the intersection in object space 73 surface (Cylindrical _ v0 v1) (_, p0, fn) 74 = (norm, evalSurface fn 0 u v) 75 where x = xCoord p0 76 y = yCoord p0 77 z = zCoord p0 78 u = clampf $ adjustRadian (atan2 x z) / (2 * pi) 79 v = y 80 norm = normalize $ cross v0 v1 81 82 -- ZZ ignore the (incorrect) surface model, and estimate the normal 83 -- from the intersection in object space 84 surface (Conic _ v0 v1) (_, p0, fn) 85 = (norm, evalSurface fn 0 u v) 86 where x = xCoord p0 87 y = yCoord p0 88 z = zCoord p0 89 u = clampf $ adjustRadian (atan2 (x / y) (z / y)) / (2 * pi) 90 v = y 91 norm = normalize $ cross v0 v1 92 93 -- entered 32,512 timesplanarUV face p0 94 = case face of 95 PlaneFace -> (0, x, z) 96 97 CubeFront -> (0, x, y) 98 CubeBack -> (1, x, y) 99 CubeLeft -> (2, z, y) 100 CubeRight -> (3, z, y) 101 CubeTop -> (4, x, z) 102 CubeBottom -> (5, x, z) 103 104 CylinderTop -> (1, (x + 1) / 2, (z + 1) / 2) 105 CylinderBottom -> (2, (x + 1) / 2, (z + 1) / 2) 106 107 ConeBase -> (1, (x + 1) / 2, (z + 1) / 2) 108 where x = xCoord p0 109 y = yCoord p0 110 z = zCoord p0 111 112 -- misc 113 114 adjustRadian :: Radian -> Radian 115 -- never enteredadjustRadian r = if r > 0 then r else r + 2 * pi