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