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 -}