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.
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)
24 sfun :: (Int -> Double -> Double -> Properties c v) -> SurfaceFn c v
26 sconst :: Properties c v -> SurfaceFn c v
29 type Properties c v = (c, v, v, v)
31 prop c d s p = (c, d, s, p)
33 matte = (white, 1.0, 0.0, 1.0)
34 shiny = (white, 0.0, 1.0, 1.0)
36 chgColor :: c -> Properties d v -> Properties c v
37 chgColor c (_, d, s, p) = (c, d, s, p)
39 instance (Show c, Show v) => Show (SurfaceFn c v) where
40 show (SFun _) = "Surface function"
41 -- show (SConst p) = "Surface constant: " ++ show p
42 show (SConst p) = "Surface constant"
44 evalSurface :: SurfaceFn Color Double -> Int -> Double -> Double -> Properties Color Double
45 evalSurface (SConst p) = \_ _ _ -> p
46 evalSurface (SFun f) = f
48 -- calculate surface properties, given the type of
49 -- surface, and intersection point in object coordinates
51 -- surface :: Surface SurfaceFn -> (Int, Point) -> (Vector, Properties)
53 surface (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
58 surface (Spherical _ v0 v1) (_, p0, fn)
59 = (norm, evalSurface fn 0 u v)
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
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)
78 u = clampf $ adjustRadian (atan2 x z) / (2 * pi)
80 norm = normalize $ cross v0 v1
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)
89 u = clampf $ adjustRadian (atan2 (x / y) (z / y)) / (2 * pi)
91 norm = normalize $ cross v0 v1
95 PlaneFace -> (0, x, z)
97 CubeFront -> (0, x, y)
100 CubeRight -> (3, z, y)
102 CubeBottom -> (5, x, z)
104 CylinderTop -> (1, (x + 1) / 2, (z + 1) / 2)
105 CylinderBottom -> (2, (x + 1) / 2, (z + 1) / 2)
107 ConeBase -> (1, (x + 1) / 2, (z + 1) / 2)
114 adjustRadian :: Radian -> Radian
115 adjustRadian r = if r > 0 then r else r + 2 * pi