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