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
116
117
118
119
120
121
|
-- 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 Interval
( IList
, Intersection
, emptyIList, openIList
, mkEntry, mkExit
, entryexit, exitentry
, mapI
, unionIntervals, intersectIntervals, differenceIntervals
, complementIntervals
) where
import Geometry
-- The result of a ray trace is represented as a list of surface
-- intersections. Each intersection is a point along the ray with
-- a flag indicating whether this intersection is an entry or an
-- exit from the solid. Each intersection also carries unspecified
-- surface data for use by the illumination model.
-- Just the list of intersections isn't enough, however. An empty
-- list can denote either a trace that is always within the solid
-- or never in the solid. To dissambiguate, an extra flag is kept
-- that indicates whether we are starting inside or outside of the
-- solid. As a convenience, we also keep an additional flag that
-- indicates whether the last intersection ends inside or outside.
type IList a = (Bool, [Intersection a], Bool)
type Intersection a = (Double, Bool, a)
emptyIList = (False, [], False)
openIList = (True, [], True)
mapI f (b1, is, b2) = (b1, map f is, b2)
isEntry (_, entry, _) = entry
isExit (_, entry, _) = not entry
mkEntry (t, a) = (t, True, a)
mkExit (t, a) = (t, False, a)
entryexit w1 w2 = (False, [mkEntry w1, mkExit w2], False)
exitentry w1 w2 = (True, [mkExit w1, mkEntry w2], True)
arrange w1@(t1, _) w2@(t2, _) | t1 < t2 = entryexit w1 w2
| otherwise = entryexit w2 w1
cmpI :: Intersection a -> Intersection a -> Ordering
cmpI (i, _, _) (j, _, _)
| i `near` j = EQ
| i < j = LT
| otherwise = GT
bad (b1, [], b2) = b1 /= b2
bad (b1, is, b2) = bad' b1 is || b2 /= b3
where (_, b3, _) = last is
bad' b [] = False
bad' b ((_, c, _) : is) = b == c || bad' c is
unionIntervals :: IList a -> IList a -> IList a
unionIntervals (isStartOpen, is, isEndOpen) (jsStartOpen, js, jsEndOpen)
= (isStartOpen || jsStartOpen, uniIntervals is js, isEndOpen || jsEndOpen)
where uniIntervals is [] | jsEndOpen = []
| otherwise = is
uniIntervals [] js | isEndOpen = []
| otherwise = js
uniIntervals is@(i : is') js@(j : js')
= case cmpI i j of
EQ -> if isEntry i == isEntry j then i : uniIntervals is' js'
else uniIntervals is' js'
LT -> if isEntry j then i : uniIntervals is' js
else uniIntervals is' js
GT -> if isEntry i then j : uniIntervals is js'
else uniIntervals is js'
intersectIntervals :: IList a -> IList a -> IList a
intersectIntervals is js
= complementIntervals (unionIntervals is' js')
where is' = complementIntervals is
js' = complementIntervals js
differenceIntervals :: IList a -> IList a -> IList a
differenceIntervals is js
= complementIntervals (unionIntervals is' js)
where is' = complementIntervals is
complementIntervals :: IList a -> IList a
complementIntervals (o1, is, o2)
= (not o1, [ (i, not isentry, a) | (i, isentry, a) <- is ], not o2)
-- tests...
{-
mkIn, mkOut :: Double -> Intersection a
mkIn x = (x, True, undefined)
mkOut x = (x, False, undefined)
i1 = (False, [ mkIn 2, mkOut 7 ], False)
i1' = (True, [ mkOut 2, mkIn 7 ], True)
i2 = (False, [ mkIn 1, mkOut 3, mkIn 4, mkOut 5, mkIn 6, mkOut 8 ], False)
t1 = unionIntervals i1 i2
t2 = intersectIntervals i1 i2
t3 = intersectIntervals i2 i1
t4 = complementIntervals i1
t5 = intersectIntervals i2 i1'
t6 = differenceIntervals i2 i1
t7 = differenceIntervals i2 i2
sh (o1,is,o2) =
do if o1 then putStr "..." else return ()
putStr $ foldr1 (++) (map si is)
if o2 then putStr "..." else return ()
si (i, True, _, _) = "<" ++ show i
si (i, False, _, _) = " " ++ show i ++ ">"
-}
|
