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 6 module 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 17 import 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 32 type IList a = (Bool, [Intersection a], Bool) 33 type Intersection a = (Double, Bool, a) 34 35 -- entered onceemptyIList = (False, [], False) 36 -- never enteredopenIList = (True, [], True) 37 38 -- entered 132,847 timesmapI f (b1, is, b2) = (b1, map f is, b2) 39 40 -- entered 9754 timesisEntry (_, entry, _) = entry 41 -- never enteredisExit (_, entry, _) = not entry 42 43 -- entered 39,754 timesmkEntry (t, a) = (t, True, a) 44 -- entered 87,565 timesmkExit (t, a) = (t, False, a) 45 46 -- entered 9754 timesentryexit w1 w2 = (False, [mkEntry w1, mkExit w2], False) 47 -- never enteredexitentry w1 w2 = (True, [mkExit w1, mkEntry w2], True) 48 -- never enteredarrange w1@(t1, _) w2@(t2, _) | t1 < t2 = entryexit w1 w2 49 | otherwise = entryexit w2 w1 50 51 52 cmpI :: Intersection a -> Intersection a -> Ordering 53 -- entered 9754 timescmpI (i, _, _) (j, _, _) 54 | i `near` j = EQ 55 | i < j = LT 56 | otherwise = GT 57 58 -- never enteredbad (b1, [], b2) = b1 /= b2 59 bad (b1, is, b2) = bad' b1 is || b2 /= b3 60 where (_, b3, _) = last is 61 62 -- never enteredbad' b [] = False 63 bad' b ((_, c, _) : is) = b == c || bad' c is 64 65 unionIntervals :: IList a -> IList a -> IList a 66 -- entered 115,538 timesunionIntervals (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 81 intersectIntervals :: IList a -> IList a -> IList a 82 -- never enteredintersectIntervals is js 83 = complementIntervals (unionIntervals is' js') 84 where is' = complementIntervals is 85 js' = complementIntervals js 86 87 differenceIntervals :: IList a -> IList a -> IList a 88 -- never entereddifferenceIntervals is js 89 = complementIntervals (unionIntervals is' js) 90 where is' = complementIntervals is 91 92 complementIntervals :: IList a -> IList a 93 -- never enteredcomplementIntervals (o1, is, o2) 94 = (not o1, [ (i, not isentry, a) | (i, isentry, a) <- is ], not o2) 95 96 -- tests... 97 98 {- 99 mkIn, mkOut :: Double -> Intersection a 100 mkIn x = (x, True, undefined) 101 mkOut x = (x, False, undefined) 102 103 i1 = (False, [ mkIn 2, mkOut 7 ], False) 104 i1' = (True, [ mkOut 2, mkIn 7 ], True) 105 i2 = (False, [ mkIn 1, mkOut 3, mkIn 4, mkOut 5, mkIn 6, mkOut 8 ], False) 106 107 t1 = unionIntervals i1 i2 108 t2 = intersectIntervals i1 i2 109 t3 = intersectIntervals i2 i1 110 t4 = complementIntervals i1 111 t5 = intersectIntervals i2 i1' 112 t6 = differenceIntervals i2 i1 113 t7 = differenceIntervals i2 i2 114 115 sh (o1,is,o2) = 116 do if o1 then putStr "..." else return () 117 putStr $ foldr1 (++) (map si is) 118 if o2 then putStr "..." else return () 119 si (i, True, _, _) = "<" ++ show i 120 si (i, False, _, _) = " " ++ show i ++ ">" 121 -}