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
6module Interval
7    ( IList
8    , Intersection
9    , emptyIList, openIList
10    , mkEntry, mkExit
11    , entryexit, exitentry
12    , mapI
13    , unionIntervals, intersectIntervals, differenceIntervals
14    , complementIntervals
15    ) where
16
17import Geometry
18
19-- The result of a ray trace is represented as a list of surface
20-- intersections.  Each intersection is a point along the ray with
21-- a flag indicating whether this intersection is an entry or an
22-- exit from the solid.  Each intersection also carries unspecified
23-- surface data for use by the illumination model.
24
25-- Just the list of intersections isn't enough, however.  An empty
26-- list can denote either a trace that is always within the solid
27-- or never in the solid.  To dissambiguate, an extra flag is kept
28-- that indicates whether we are starting inside or outside of the
29-- solid.  As a convenience, we also keep an additional flag that
30-- indicates whether the last intersection ends inside or outside.
31
32type IList a		= (Bool, [Intersection a], Bool)
33type Intersection a	= (Double, Bool, a)
34
35emptyIList = (False, [], False)
36openIList = (True, [], True)
37
38mapI f (b1, is, b2) = (b1, map f is, b2)
39
40isEntry (_, entry, _) = entry
41isExit  (_, entry, _) = not entry
42
43mkEntry (t, a) = (t, True,  a)
44mkExit  (t, a) = (t, False, a)
45
46entryexit w1 w2 = (False, [mkEntry w1, mkExit w2], False)
47exitentry w1 w2 = (True, [mkExit w1, mkEntry w2], True)
48arrange   w1@(t1, _) w2@(t2, _) | t1 < t2   = entryexit w1 w2
49				| otherwise = entryexit w2 w1
50
51
52cmpI :: Intersection a -> Intersection a -> Ordering
53cmpI (i, _, _) (j, _, _)
54  | i `near` j = EQ
55  | i   <    j = LT
56  | otherwise  = GT
57
58bad (b1, [], b2) = b1 /= b2
59bad (b1, is, b2) = bad' b1 is || b2 /= b3
60  where (_, b3, _) = last is
61
62bad' b [] = False
63bad' b ((_, c, _) : is) = b == c || bad' c is
64
65unionIntervals :: IList a -> IList a -> IList a
66unionIntervals (isStartOpen, is, isEndOpen) (jsStartOpen, js, jsEndOpen)
67  = (isStartOpen || jsStartOpen, uniIntervals is js, isEndOpen || jsEndOpen)
68  where uniIntervals is [] | jsEndOpen = []
69			   | otherwise = is
70	uniIntervals [] js | isEndOpen = []
71			   | otherwise = js
72	uniIntervals is@(i : is') js@(j : js')
73	  = case cmpI i j of
74	    EQ -> if isEntry i == isEntry j then i : uniIntervals is' js'
75					    else uniIntervals is' js'
76	    LT -> if isEntry j then i : uniIntervals is' js
77			       else     uniIntervals is' js
78	    GT -> if isEntry i then j : uniIntervals is js'
79			       else     uniIntervals is js'
80
81intersectIntervals :: IList a -> IList a -> IList a
82intersectIntervals is js
83  = complementIntervals (unionIntervals is' js')
84  where is' = complementIntervals is
85	js' = complementIntervals js
86
87differenceIntervals :: IList a -> IList a -> IList a
88differenceIntervals is js
89  = complementIntervals (unionIntervals is' js)
90  where is' = complementIntervals is
91
92complementIntervals :: IList a -> IList a
93complementIntervals (o1, is, o2)
94  = (not o1, [ (i, not isentry, a) | (i, isentry, a) <- is ], not o2)
95
96-- tests...
97
98{-
99mkIn, mkOut :: Double -> Intersection a
100mkIn x = (x, True, undefined)
101mkOut x = (x, False, undefined)
102
103i1 =  (False, [ mkIn 2, mkOut 7 ], False)
104i1' = (True, [ mkOut 2, mkIn 7 ], True)
105i2 =  (False, [ mkIn 1, mkOut 3, mkIn 4, mkOut 5, mkIn 6, mkOut 8 ], False)
106
107t1 = unionIntervals i1 i2
108t2 = intersectIntervals i1 i2
109t3 = intersectIntervals i2 i1
110t4 = complementIntervals i1
111t5 = intersectIntervals i2 i1'
112t6 = differenceIntervals i2 i1
113t7 = differenceIntervals i2 i2
114
115sh (o1,is,o2) =
116    do  if o1 then putStr "..." else return ()
117	putStr $ foldr1 (++) (map si is)
118	if o2 then putStr "..." else return ()
119si (i, True, _, _) = "<" ++ show i
120si (i, False, _, _) = " " ++ show i ++ ">"
121-}
122