Changing raytracer tests to work with 6.9
authorandygill@ku.edu <unknown>
Tue, 29 Jul 2008 16:11:55 +0000 (16:11 +0000)
committerandygill@ku.edu <unknown>
Tue, 29 Jul 2008 16:11:55 +0000 (16:11 +0000)
tests/raytrace/hpc_raytrace.stdout
tests/raytrace/test.T

index e4324a7..60fd7e2 100644 (file)
@@ -1,14 +1,14 @@
 "GOOD MATCH"
 
 
 "GOOD MATCH"
 
 
- 48% expressions used (2292/4715)
+ 48% expressions used (2292/4718)
  21% boolean coverage (18/83)
       21% guards (12/55), 17 always True, 8 always False, 18 unevaluated
       22% 'if' conditions (6/27), 3 always True, 3 always False, 15 unevaluated
        0% qualifiers (0/1), 1 unevaluated
  38% alternatives used (124/322)
  21% boolean coverage (18/83)
       21% guards (12/55), 17 always True, 8 always False, 18 unevaluated
       22% 'if' conditions (6/27), 3 always True, 3 always False, 15 unevaluated
        0% qualifiers (0/1), 1 unevaluated
  38% alternatives used (124/322)
- 41% local declarations used (89/216)
57% top-level declarations used (142/245)
+ 40% local declarations used (89/218)
49% top-level declarations used (146/295)
 
 
 -----<module CSG>-----
 
 
 -----<module CSG>-----
      100% qualifiers (0/0)
  41% alternatives used (5/12)
 100% local declarations used (5/5)
      100% qualifiers (0/0)
  41% alternatives used (5/12)
 100% local declarations used (5/5)
- 48% top-level declarations used (17/35)
+ 41% top-level declarations used (17/41)
 -----<module Data>-----
 -----<module Data>-----
- 39% expressions used (254/646)
+ 39% expressions used (254/647)
   0% boolean coverage (0/4)
        0% guards (0/4), 1 always True, 3 unevaluated
      100% 'if' conditions (0/0)
      100% qualifiers (0/0)
   3% alternatives used (2/51)
   0% boolean coverage (0/4)
        0% guards (0/4), 1 always True, 3 unevaluated
      100% 'if' conditions (0/0)
      100% qualifiers (0/0)
   3% alternatives used (2/51)
-100% local declarations used (0/0)
- 24% top-level declarations used (6/25)
+  0% local declarations used (0/2)
+ 22% top-level declarations used (10/45)
 -----<module Eval>-----
 -----<module Eval>-----
- 57% expressions used (361/628)
+ 57% expressions used (361/629)
  20% boolean coverage (1/5)
      100% guards (0/0)
       20% 'if' conditions (1/5), 1 always False, 3 unevaluated
      100% qualifiers (0/0)
  59% alternatives used (40/67)
  36% local declarations used (4/11)
  20% boolean coverage (1/5)
      100% guards (0/0)
       20% 'if' conditions (1/5), 1 always False, 3 unevaluated
      100% qualifiers (0/0)
  59% alternatives used (40/67)
  36% local declarations used (4/11)
70% top-level declarations used (22/31)
62% top-level declarations used (22/35)
 -----<module Geometry>-----
  70% expressions used (300/427)
  10% boolean coverage (1/10)
 -----<module Geometry>-----
  70% expressions used (300/427)
  10% boolean coverage (1/10)
      100% qualifiers (0/0)
  40% alternatives used (4/10)
  66% local declarations used (2/3)
      100% qualifiers (0/0)
  40% alternatives used (4/10)
  66% local declarations used (2/3)
75% top-level declarations used (42/56)
58% top-level declarations used (42/72)
 -----<module Illumination>-----
 -----<module Illumination>-----
- 44% expressions used (299/678)
+ 44% expressions used (299/679)
  18% boolean coverage (3/16)
       16% guards (2/12), 2 always True, 1 always False, 7 unevaluated
       33% 'if' conditions (1/3), 1 always True, 1 always False
        0% qualifiers (0/1), 1 unevaluated
  38% alternatives used (16/42)
  57% local declarations used (27/47)
  18% boolean coverage (3/16)
       16% guards (2/12), 2 always True, 1 always False, 7 unevaluated
       33% 'if' conditions (1/3), 1 always True, 1 always False
        0% qualifiers (0/1), 1 unevaluated
  38% alternatives used (16/42)
  57% local declarations used (27/47)
55% top-level declarations used (11/20)
45% top-level declarations used (11/24)
 -----<module Intersections>-----
  38% expressions used (382/1001)
  33% boolean coverage (11/33)
 -----<module Intersections>-----
  38% expressions used (382/1001)
  33% boolean coverage (11/33)
@@ -162,159 +162,7 @@ span.spaces    { background: white }
 
 </pre>
 </html>
 
 </pre>
 </html>
-Writing: Parse.hs.html
-<html><style type="text/css">
-span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
-span.nottickedoff { background: yellow}
-span.istickedoff { background: white }
-span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
-span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
-span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
-span.decl { font-weight: bold }
-span.spaces    { background: white }
-</style>
-<pre>
-<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
-<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
-<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
-<span class="lineno">    4 </span>-- which is included in the distribution.
-<span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module Parse where
-<span class="lineno">    7 </span>
-<span class="lineno">    8 </span>import Char
-<span class="lineno">    9 </span>import Text.ParserCombinators.Parsec hiding (token)
-<span class="lineno">   10 </span>
-<span class="lineno">   11 </span>import Data
-<span class="lineno">   12 </span>
-<span class="lineno">   13 </span>
-<span class="lineno">   14 </span>program :: Parser Code
-<span class="lineno">   15 </span><span class="decl"><span class="istickedoff">program =</span>
-<span class="lineno">   16 </span><span class="spaces">  </span><span class="istickedoff">do { whiteSpace</span>
-<span class="lineno">   17 </span><span class="spaces">     </span><span class="istickedoff">; ts &lt;- tokenList</span>
-<span class="lineno">   18 </span><span class="spaces">     </span><span class="istickedoff">; eof</span>
-<span class="lineno">   19 </span><span class="spaces">     </span><span class="istickedoff">; return ts</span>
-<span class="lineno">   20 </span><span class="spaces">     </span><span class="istickedoff">}</span></span>
-<span class="lineno">   21 </span>
-<span class="lineno">   22 </span>tokenList :: Parser Code
-<span class="lineno">   23 </span><span class="decl"><span class="istickedoff">tokenList = many token &lt;?&gt; <span class="nottickedoff">&quot;list of tokens&quot;</span></span></span>
-<span class="lineno">   24 </span>
-<span class="lineno">   25 </span>token :: Parser GMLToken
-<span class="lineno">   26 </span><span class="decl"><span class="istickedoff">token =</span>
-<span class="lineno">   27 </span><span class="spaces">       </span><span class="istickedoff">do { ts &lt;- braces   tokenList          ; return (TBody ts) } </span>
-<span class="lineno">   28 </span><span class="spaces">  </span><span class="istickedoff">&lt;|&gt;  do { ts &lt;- brackets tokenList          ; return (TArray ts) }</span>
-<span class="lineno">   29 </span><span class="spaces">  </span><span class="istickedoff">&lt;|&gt; (do { s  &lt;- gmlString                   ; return (TString <span class="nottickedoff">s</span>) } &lt;?&gt; <span class="nottickedoff">&quot;string&quot;</span>)</span>
-<span class="lineno">   30 </span><span class="spaces">  </span><span class="istickedoff">&lt;|&gt; (do { t &lt;- pident False                 ; return t }           &lt;?&gt; <span class="nottickedoff">&quot;identifier&quot;</span>)</span>
-<span class="lineno">   31 </span><span class="spaces">  </span><span class="istickedoff">&lt;|&gt; (do { char '/'   -- No whitespace after slash</span>
-<span class="lineno">   32 </span><span class="spaces">          </span><span class="istickedoff">; t &lt;- pident True                  ; return t } &lt;?&gt; <span class="nottickedoff">&quot;binding identifier&quot;</span>)</span>
-<span class="lineno">   33 </span><span class="spaces">  </span><span class="istickedoff">&lt;|&gt; (do { n &lt;- number                       ; return n } &lt;?&gt; <span class="nottickedoff">&quot;number&quot;</span>)</span></span>
-<span class="lineno">   34 </span>
-<span class="lineno">   35 </span>pident :: Bool -&gt; Parser GMLToken
-<span class="lineno">   36 </span><span class="decl"><span class="istickedoff">pident rebind =</span>
-<span class="lineno">   37 </span><span class="spaces">  </span><span class="istickedoff">do { id &lt;- ident</span>
-<span class="lineno">   38 </span><span class="spaces">     </span><span class="istickedoff">; case (lookup id opTable) of</span>
-<span class="lineno">   39 </span><span class="spaces">       </span><span class="istickedoff">Nothing -&gt; if rebind then return (TBind id) else return (TId id)</span>
-<span class="lineno">   40 </span><span class="spaces">       </span><span class="istickedoff">Just t  -&gt; if <span class="tickonlyfalse">rebind</span> then <span class="nottickedoff">error (&quot;Attempted rebinding of identifier &quot; ++ id)</span> else return t</span>
-<span class="lineno">   41 </span><span class="spaces">     </span><span class="istickedoff">}</span></span>
-<span class="lineno">   42 </span>
-<span class="lineno">   43 </span>ident :: Parser String
-<span class="lineno">   44 </span><span class="decl"><span class="istickedoff">ident = lexeme $</span>
-<span class="lineno">   45 </span><span class="spaces">  </span><span class="istickedoff">do { l &lt;- letter</span>
-<span class="lineno">   46 </span><span class="spaces">     </span><span class="istickedoff">; ls &lt;- many (satisfy (\x -&gt; isAlphaNum x || x == '-' || x == '_'))</span>
-<span class="lineno">   47 </span><span class="spaces">     </span><span class="istickedoff">; return (l:ls)</span>
-<span class="lineno">   48 </span><span class="spaces">     </span><span class="istickedoff">}</span></span>
-<span class="lineno">   49 </span>
-<span class="lineno">   50 </span>gmlString :: Parser String
-<span class="lineno">   51 </span><span class="decl"><span class="istickedoff">gmlString = lexeme $ between (char '&quot;') (char '&quot;') (many (satisfy (\x -&gt; isPrint x &amp;&amp; x /= '&quot;')))</span></span>
-<span class="lineno">   52 </span>
-<span class="lineno">   53 </span>-- Tests for numbers
-<span class="lineno">   54 </span>-- Hugs breaks on big exponents (&gt; ~40)
-<span class="lineno">   55 </span><span class="decl"><span class="nottickedoff">test_number = &quot;1234 -1234 1 -0 0&quot; ++</span>
-<span class="lineno">   56 </span><span class="spaces">              </span><span class="nottickedoff">&quot; 1234.5678 -1234.5678 1234.5678e12 1234.5678e-12 -1234.5678e-12&quot; ++</span>
-<span class="lineno">   57 </span><span class="spaces">              </span><span class="nottickedoff">&quot; -1234.5678e12 -1234.5678E-12 -1234.5678E12&quot; ++</span>
-<span class="lineno">   58 </span><span class="spaces">              </span><span class="nottickedoff">&quot; 1234e11 1234E33 -1234e33 1234e-33&quot; ++</span>
-<span class="lineno">   59 </span><span class="spaces">              </span><span class="nottickedoff">&quot; 123e 123.4e 123ee 123.4ee 123E 123.4E 123EE 123.4EE&quot;</span></span>
-<span class="lineno">   60 </span>              
-<span class="lineno">   61 </span>
-<span class="lineno">   62 </span>-- Always int or real
-<span class="lineno">   63 </span>number :: Parser GMLToken
-<span class="lineno">   64 </span><span class="decl"><span class="istickedoff">number = lexeme $</span>
-<span class="lineno">   65 </span><span class="spaces">  </span><span class="istickedoff">do { s &lt;- optSign</span>
-<span class="lineno">   66 </span><span class="spaces">     </span><span class="istickedoff">; n &lt;- decimal</span>
-<span class="lineno">   67 </span><span class="spaces">     </span><span class="istickedoff">;     do { string &quot;.&quot;</span>
-<span class="lineno">   68 </span><span class="spaces">              </span><span class="istickedoff">; m &lt;- decimal</span>
-<span class="lineno">   69 </span><span class="spaces">              </span><span class="istickedoff">; e &lt;- option &quot;&quot; exponent'</span>
-<span class="lineno">   70 </span><span class="spaces">              </span><span class="istickedoff">; return (TReal (read (s ++ n ++ &quot;.&quot; ++ m ++ e)))  -- FIXME: Handle error conditions</span>
-<span class="lineno">   71 </span><span class="spaces">              </span><span class="istickedoff">}</span>
-<span class="lineno">   72 </span><span class="spaces">       </span><span class="istickedoff">&lt;|&gt; do { e &lt;- exponent'</span>
-<span class="lineno">   73 </span><span class="spaces">              </span><span class="istickedoff">; <span class="nottickedoff">return (TReal (read (s ++ n ++ &quot;.0&quot; ++ e)))</span></span>
-<span class="lineno">   74 </span><span class="spaces">              </span><span class="istickedoff">}</span>
-<span class="lineno">   75 </span><span class="spaces">       </span><span class="istickedoff">&lt;|&gt; do { return (TInt (read (s ++ n))) }</span>
-<span class="lineno">   76 </span><span class="spaces">     </span><span class="istickedoff">}</span></span>
-<span class="lineno">   77 </span>
-<span class="lineno">   78 </span>exponent' :: Parser String
-<span class="lineno">   79 </span><span class="decl"><span class="istickedoff">exponent' = try $</span>
-<span class="lineno">   80 </span><span class="spaces">  </span><span class="istickedoff">do { e &lt;- oneOf &quot;eE&quot;</span>
-<span class="lineno">   81 </span><span class="spaces">     </span><span class="istickedoff">; s &lt;- <span class="nottickedoff">optSign</span></span>
-<span class="lineno">   82 </span><span class="spaces">     </span><span class="istickedoff">; n &lt;- <span class="nottickedoff">decimal</span></span>
-<span class="lineno">   83 </span><span class="spaces">     </span><span class="istickedoff">; <span class="nottickedoff">return (e:s ++ n)</span></span>
-<span class="lineno">   84 </span><span class="spaces">     </span><span class="istickedoff">}</span></span>
-<span class="lineno">   85 </span>
-<span class="lineno">   86 </span><span class="decl"><span class="istickedoff">decimal = many1 digit</span></span>
-<span class="lineno">   87 </span>
-<span class="lineno">   88 </span>optSign :: Parser String
-<span class="lineno">   89 </span><span class="decl"><span class="istickedoff">optSign = option &quot;&quot; (string &quot;-&quot;)</span></span>
-<span class="lineno">   90 </span>
-<span class="lineno">   91 </span>
-<span class="lineno">   92 </span>------------------------------------------------------
-<span class="lineno">   93 </span>-- Library for tokenizing.
-<span class="lineno">   94 </span>
-<span class="lineno">   95 </span><span class="decl"><span class="istickedoff">braces   p = between (symbol &quot;{&quot;) (symbol &quot;}&quot;) p</span></span>
-<span class="lineno">   96 </span><span class="decl"><span class="istickedoff">brackets p = between (symbol &quot;[&quot;) (symbol &quot;]&quot;) p</span></span>
-<span class="lineno">   97 </span>
-<span class="lineno">   98 </span><span class="decl"><span class="istickedoff">symbol name = lexeme (string name)</span></span>
-<span class="lineno">   99 </span>
-<span class="lineno">  100 </span><span class="decl"><span class="istickedoff">lexeme p = do{ x &lt;- p; whiteSpace; return x  }</span></span>
-<span class="lineno">  101 </span>
-<span class="lineno">  102 </span><span class="decl"><span class="istickedoff">whiteSpace  = skipMany (simpleSpace &lt;|&gt; oneLineComment &lt;?&gt; <span class="nottickedoff">&quot;&quot;</span>)</span>
-<span class="lineno">  103 </span><span class="spaces">  </span><span class="istickedoff">where simpleSpace = skipMany1 (oneOf &quot; \t\n\r\v&quot;)    </span>
-<span class="lineno">  104 </span><span class="spaces">        </span><span class="istickedoff">oneLineComment =</span>
-<span class="lineno">  105 </span><span class="spaces">            </span><span class="istickedoff">do{ string &quot;%&quot;</span>
-<span class="lineno">  106 </span><span class="spaces">              </span><span class="istickedoff">; skipMany (noneOf &quot;\n\r\v&quot;)</span>
-<span class="lineno">  107 </span><span class="spaces">              </span><span class="istickedoff">; return ()</span>
-<span class="lineno">  108 </span><span class="spaces">              </span><span class="istickedoff">}</span></span>
-<span class="lineno">  109 </span>
-<span class="lineno">  110 </span>
-<span class="lineno">  111 </span>------------------------------------------------------------------------------
-<span class="lineno">  112 </span>
-<span class="lineno">  113 </span>rayParse :: String -&gt; Code
-<span class="lineno">  114 </span><span class="decl"><span class="istickedoff">rayParse is = case (parse program <span class="nottickedoff">&quot;&lt;stdin&gt;&quot;</span> is) of</span>
-<span class="lineno">  115 </span><span class="spaces">              </span><span class="istickedoff">Left err -&gt; <span class="nottickedoff">error (show err)</span></span>
-<span class="lineno">  116 </span><span class="spaces">              </span><span class="istickedoff">Right x  -&gt; x</span></span>
-<span class="lineno">  117 </span>
-<span class="lineno">  118 </span>rayParseF :: String -&gt; IO Code
-<span class="lineno">  119 </span><span class="decl"><span class="nottickedoff">rayParseF file =</span>
-<span class="lineno">  120 </span><span class="spaces">  </span><span class="nottickedoff">do { r &lt;- parseFromFile program file</span>
-<span class="lineno">  121 </span><span class="spaces">     </span><span class="nottickedoff">; case r of</span>
-<span class="lineno">  122 </span><span class="spaces">       </span><span class="nottickedoff">Left err -&gt; error (show err)</span>
-<span class="lineno">  123 </span><span class="spaces">       </span><span class="nottickedoff">Right x  -&gt; return x</span>
-<span class="lineno">  124 </span><span class="spaces">     </span><span class="nottickedoff">}</span></span>
-<span class="lineno">  125 </span>
-<span class="lineno">  126 </span>run :: String -&gt; IO ()
-<span class="lineno">  127 </span><span class="decl"><span class="nottickedoff">run is = case (parse program &quot;&quot; is) of</span>
-<span class="lineno">  128 </span><span class="spaces">         </span><span class="nottickedoff">Left err -&gt; print err</span>
-<span class="lineno">  129 </span><span class="spaces">         </span><span class="nottickedoff">Right x  -&gt; print x</span></span>
-<span class="lineno">  130 </span>
-<span class="lineno">  131 </span>runF :: IO ()
-<span class="lineno">  132 </span><span class="decl"><span class="nottickedoff">runF =</span>
-<span class="lineno">  133 </span><span class="spaces">  </span><span class="nottickedoff">do { r &lt;- parseFromFile program &quot;simple.gml&quot;</span>
-<span class="lineno">  134 </span><span class="spaces">     </span><span class="nottickedoff">; case r of</span>
-<span class="lineno">  135 </span><span class="spaces">       </span><span class="nottickedoff">Left err -&gt; print err</span>
-<span class="lineno">  136 </span><span class="spaces">       </span><span class="nottickedoff">Right x  -&gt; print x</span>
-<span class="lineno">  137 </span><span class="spaces">     </span><span class="nottickedoff">}</span></span>
-
-</pre>
-</html>
-Writing: Data.hs.html
+Writing: Eval.hs.html
 <html><style type="text/css">
 span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
 span.nottickedoff { background: yellow}
 <html><style type="text/css">
 span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
 span.nottickedoff { background: yellow}
@@ -331,1718 +179,783 @@ span.spaces    { background: white }
 <span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
 <span class="lineno">    4 </span>-- which is included in the distribution.
 <span class="lineno">    5 </span>
 <span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
 <span class="lineno">    4 </span>-- which is included in the distribution.
 <span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module Data where
+<span class="lineno">    6 </span>module Eval where
 <span class="lineno">    7 </span>
 <span class="lineno">    8 </span>import Array
 <span class="lineno">    9 </span>
 <span class="lineno">    7 </span>
 <span class="lineno">    8 </span>import Array
 <span class="lineno">    9 </span>
-<span class="lineno">   10 </span>import CSG      
-<span class="lineno">   11 </span>import Geometry
-<span class="lineno">   12 </span>import Illumination
-<span class="lineno">   13 </span>import Primitives
-<span class="lineno">   14 </span>import Surface
+<span class="lineno">   10 </span>import Geometry
+<span class="lineno">   11 </span>import CSG
+<span class="lineno">   12 </span>import Surface
+<span class="lineno">   13 </span>import Data
+<span class="lineno">   14 </span>import Parse (rayParse, rayParseF)
 <span class="lineno">   15 </span>
 <span class="lineno">   15 </span>
-<span class="lineno">   16 </span>import Debug.Trace
-<span class="lineno">   17 </span>
-<span class="lineno">   18 </span>-- Now the parsed (expresssion) language
-<span class="lineno">   19 </span>
-<span class="lineno">   20 </span>type Name = String
-<span class="lineno">   21 </span>
-<span class="lineno">   22 </span>type Code = [GMLToken]
-<span class="lineno">   23 </span>
-<span class="lineno">   24 </span>data GMLToken
-<span class="lineno">   25 </span>    -- All these can occur in parsed code
-<span class="lineno">   26 </span>        = TOp     GMLOp
-<span class="lineno">   27 </span>        | TId     Name
-<span class="lineno">   28 </span>        | TBind   Name
-<span class="lineno">   29 </span>        | TBool   Bool
-<span class="lineno">   30 </span>        | TInt    Int
-<span class="lineno">   31 </span>        | TReal   Double
-<span class="lineno">   32 </span>        | TString String
-<span class="lineno">   33 </span>        | TBody   Code
-<span class="lineno">   34 </span>        | TArray  Code
-<span class="lineno">   35 </span>        | TApply
-<span class="lineno">   36 </span>        | TIf
-<span class="lineno">   37 </span>         -- These can occur in optimized/transformed code
-<span class="lineno">   38 </span>         -- NONE (yet!)
-<span class="lineno">   39 </span>
+<span class="lineno">   16 </span>class Monad m =&gt; MonadEval m where
+<span class="lineno">   17 </span>  doOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; m Stack
+<span class="lineno">   18 </span>  tick :: m ()
+<span class="lineno">   19 </span>  err  :: String -&gt; m a
+<span class="lineno">   20 </span>
+<span class="lineno">   21 </span>  <span class="decl"><span class="istickedoff">tick = return <span class="nottickedoff">()</span></span></span>
+<span class="lineno">   22 </span>
+<span class="lineno">   23 </span>newtype Pure a = Pure a deriving <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>
+<span class="lineno">   24 </span>
+<span class="lineno">   25 </span>instance Monad Pure where
+<span class="lineno">   26 </span>    <span class="decl"><span class="istickedoff">Pure x &gt;&gt;= k = k x</span></span>
+<span class="lineno">   27 </span>    <span class="decl"><span class="istickedoff">return       = Pure</span></span>
+<span class="lineno">   28 </span>    <span class="decl"><span class="nottickedoff">fail s       = error s</span></span>
+<span class="lineno">   29 </span>
+<span class="lineno">   30 </span>instance MonadEval Pure where
+<span class="lineno">   31 </span>  <span class="decl"><span class="istickedoff">doOp   = doPureOp</span></span> 
+<span class="lineno">   32 </span>  <span class="decl"><span class="nottickedoff">err  s = error s</span></span>
+<span class="lineno">   33 </span>
+<span class="lineno">   34 </span>instance MonadEval IO where
+<span class="lineno">   35 </span>  <span class="decl"><span class="istickedoff">doOp prim op stk = do { -- putStrLn (&quot;Calling &quot; ++ show op</span>
+<span class="lineno">   36 </span><span class="spaces">                          </span><span class="istickedoff">--           ++ &quot; &lt;&lt; &quot; ++ show stk ++ &quot; &gt;&gt;&quot;)</span>
+<span class="lineno">   37 </span><span class="spaces">                          </span><span class="istickedoff">doAllOp  prim op stk</span>
+<span class="lineno">   38 </span><span class="spaces">                        </span><span class="istickedoff">}</span></span>
+<span class="lineno">   39 </span>  <span class="decl"><span class="nottickedoff">err  s = error s</span></span>
 <span class="lineno">   40 </span>
 <span class="lineno">   40 </span>
-<span class="lineno">   41 </span>instance Show GMLToken where
-<span class="lineno">   42 </span>   <span class="decl"><span class="nottickedoff">showsPrec p (TOp op)     = shows op</span>
-<span class="lineno">   43 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TId id)     = showString id</span>
-<span class="lineno">   44 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TBind id)   = showString ('/' : id)</span>
-<span class="lineno">   45 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TBool bool) = shows bool</span>
-<span class="lineno">   46 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TInt i)     = shows i</span>
-<span class="lineno">   47 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TReal d)    = shows d</span>
-<span class="lineno">   48 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TString s)  = shows s</span>
-<span class="lineno">   49 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TBody code) = shows code</span>
-<span class="lineno">   50 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TArray code) = showString &quot;[ &quot; </span>
-<span class="lineno">   51 </span><span class="spaces">                            </span><span class="nottickedoff">. foldr (\ a b -&gt; a . showChar ' ' . b) id (map shows code) </span>
-<span class="lineno">   52 </span><span class="spaces">                            </span><span class="nottickedoff">. showString &quot;]&quot;</span>
-<span class="lineno">   53 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TApply)     = showString &quot;apply&quot; </span>
-<span class="lineno">   54 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TIf)        = showString &quot;if&quot;</span></span> 
-<span class="lineno">   55 </span>
-<span class="lineno">   56 </span>   <span class="decl"><span class="nottickedoff">showList  code = showString &quot;{ &quot; </span>
-<span class="lineno">   57 </span><span class="spaces">                  </span><span class="nottickedoff">. foldr (\ a b -&gt; a . showChar ' ' . b) id (map shows code) </span>
-<span class="lineno">   58 </span><span class="spaces">                  </span><span class="nottickedoff">. showString &quot;}&quot;</span></span>
-<span class="lineno">   59 </span>
-<span class="lineno">   60 </span>
-<span class="lineno">   61 </span>-- Now the value language, used inside the interpreter
-<span class="lineno">   62 </span>
-<span class="lineno">   63 </span>type Stack = [GMLValue]
-<span class="lineno">   64 </span>
-<span class="lineno">   65 </span>data GMLValue
-<span class="lineno">   66 </span>        = VBool    !Bool
-<span class="lineno">   67 </span>        | VInt     !Int
-<span class="lineno">   68 </span>        | VReal    !Double
-<span class="lineno">   69 </span>        | VString  String
-<span class="lineno">   70 </span>        | VClosure Env Code
-<span class="lineno">   71 </span>        | VArray   (Array Int GMLValue)               -- FIXME: Haskell array
-<span class="lineno">   72 </span>        -- uses the interpreter version of point
-<span class="lineno">   73 </span>        | VPoint   { xPoint :: !Double
-<span class="lineno">   74 </span>                   , yPoint :: !Double 
-<span class="lineno">   75 </span>                   , zPoint :: !Double 
-<span class="lineno">   76 </span>                   } 
-<span class="lineno">   77 </span>        -- these are abstract to the interpreter
-<span class="lineno">   78 </span>        | VObject  Object
-<span class="lineno">   79 </span>        | VLight   Light 
-<span class="lineno">   80 </span>        -- This is an abstract object, used by the abstract interpreter
-<span class="lineno">   81 </span>        | VAbsObj  AbsObj
-<span class="lineno">   82 </span>
-<span class="lineno">   83 </span>
-<span class="lineno">   84 </span>-- There are only *3* basic abstract values,
-<span class="lineno">   85 </span>-- and the combinators also.
-<span class="lineno">   86 </span>
-<span class="lineno">   87 </span>data AbsObj 
-<span class="lineno">   88 </span>    = AbsFACE 
-<span class="lineno">   89 </span>    | AbsU 
-<span class="lineno">   90 </span>    | AbsV
-<span class="lineno">   91 </span>      deriving (Show)
-<span class="lineno">   92 </span>
-<span class="lineno">   93 </span>instance Show GMLValue where
-<span class="lineno">   94 </span>   <span class="decl"><span class="nottickedoff">showsPrec p value = showString (showStkEle value)</span></span>
-<span class="lineno">   95 </span>
-<span class="lineno">   96 </span>showStkEle :: GMLValue -&gt; String
-<span class="lineno">   97 </span><span class="decl"><span class="nottickedoff">showStkEle (VBool b)      = show b ++ &quot; :: Bool&quot;</span>
-<span class="lineno">   98 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VInt i)       = show i ++ &quot; :: Int&quot;</span>
-<span class="lineno">   99 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VReal r)      = show r ++ &quot; :: Real&quot;</span>
-<span class="lineno">  100 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VString s)    = show s ++ &quot; :: String&quot;</span>
-<span class="lineno">  101 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VClosure {})  = &quot;&lt;closure&gt; :: Closure&quot;</span>
-<span class="lineno">  102 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VArray arr)   </span>
-<span class="lineno">  103 </span><span class="spaces">     </span><span class="nottickedoff">= &quot;&lt;array (&quot; ++  show (succ (snd (bounds arr))) ++ &quot; elements)&gt; :: Array&quot;</span>
-<span class="lineno">  104 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VPoint x y z) = &quot;(&quot; ++ show x </span>
-<span class="lineno">  105 </span><span class="spaces">                         </span><span class="nottickedoff">++ &quot;,&quot; ++ show y</span>
-<span class="lineno">  106 </span><span class="spaces">                         </span><span class="nottickedoff">++ &quot;,&quot; ++ show z</span>
-<span class="lineno">  107 </span><span class="spaces">                         </span><span class="nottickedoff">++ &quot;) :: Point&quot;</span>
-<span class="lineno">  108 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VObject {})   = &quot;&lt;Object&gt; :: Object&quot;</span>
-<span class="lineno">  109 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VLight {})    = &quot;&lt;Light&gt; :: Object&quot;</span>
-<span class="lineno">  110 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VAbsObj vobs) = &quot;{{ &quot; ++ show vobs ++ &quot;}} :: AbsObj&quot;</span></span>
-<span class="lineno">  111 </span>
-<span class="lineno">  112 </span>-- An abstract environment
-<span class="lineno">  113 </span>
-<span class="lineno">  114 </span>newtype Env = Env [(Name, GMLValue)] deriving Show
-<span class="lineno">  115 </span>
-<span class="lineno">  116 </span>emptyEnv :: Env
-<span class="lineno">  117 </span><span class="decl"><span class="nottickedoff">emptyEnv = Env []</span></span>
-<span class="lineno">  118 </span>
-<span class="lineno">  119 </span>extendEnv :: Env -&gt; Name -&gt; GMLValue -&gt; Env
-<span class="lineno">  120 </span><span class="decl"><span class="istickedoff">extendEnv (Env e) n v = Env ((n, v):e)</span></span>
-<span class="lineno">  121 </span>
-<span class="lineno">  122 </span>lookupEnv :: Env -&gt; Name -&gt; Maybe GMLValue
-<span class="lineno">  123 </span><span class="decl"><span class="istickedoff">lookupEnv (Env e) n = lookup n e</span></span>
-<span class="lineno">  124 </span>
-<span class="lineno">  125 </span>-- All primitive operators
-<span class="lineno">  126 </span>-- 
-<span class="lineno">  127 </span>-- There is no Op_apply, Op_false, Op_true and Op_if
-<span class="lineno">  128 </span>-- (because they appear explcitly in the rules).
-<span class="lineno">  129 </span>
-<span class="lineno">  130 </span>data GMLOp
-<span class="lineno">  131 </span>   = Op_acos
-<span class="lineno">  132 </span>   | Op_addi
-<span class="lineno">  133 </span>   | Op_addf
-<span class="lineno">  134 </span>   | Op_asin
-<span class="lineno">  135 </span>   | Op_clampf
-<span class="lineno">  136 </span>   | Op_cone
-<span class="lineno">  137 </span>   | Op_cos
-<span class="lineno">  138 </span>   | Op_cube
-<span class="lineno">  139 </span>   | Op_cylinder
-<span class="lineno">  140 </span>   | Op_difference
-<span class="lineno">  141 </span>   | Op_divi
-<span class="lineno">  142 </span>   | Op_divf
-<span class="lineno">  143 </span>   | Op_eqi
-<span class="lineno">  144 </span>   | Op_eqf
-<span class="lineno">  145 </span>   | Op_floor
-<span class="lineno">  146 </span>   | Op_frac
-<span class="lineno">  147 </span>   | Op_get
-<span class="lineno">  148 </span>   | Op_getx
-<span class="lineno">  149 </span>   | Op_gety
-<span class="lineno">  150 </span>   | Op_getz
-<span class="lineno">  151 </span>   | Op_intersect
-<span class="lineno">  152 </span>   | Op_length
-<span class="lineno">  153 </span>   | Op_lessi
-<span class="lineno">  154 </span>   | Op_lessf
-<span class="lineno">  155 </span>   | Op_light
-<span class="lineno">  156 </span>   | Op_modi
-<span class="lineno">  157 </span>   | Op_muli
-<span class="lineno">  158 </span>   | Op_mulf
-<span class="lineno">  159 </span>   | Op_negi
-<span class="lineno">  160 </span>   | Op_negf
-<span class="lineno">  161 </span>   | Op_plane
-<span class="lineno">  162 </span>   | Op_point
-<span class="lineno">  163 </span>   | Op_pointlight
-<span class="lineno">  164 </span>   | Op_real
-<span class="lineno">  165 </span>   | Op_render
-<span class="lineno">  166 </span>   | Op_rotatex
-<span class="lineno">  167 </span>   | Op_rotatey
-<span class="lineno">  168 </span>   | Op_rotatez
-<span class="lineno">  169 </span>   | Op_scale
-<span class="lineno">  170 </span>   | Op_sin
-<span class="lineno">  171 </span>   | Op_sphere
-<span class="lineno">  172 </span>   | Op_spotlight
-<span class="lineno">  173 </span>   | Op_sqrt
-<span class="lineno">  174 </span>   | Op_subi
-<span class="lineno">  175 </span>   | Op_subf
-<span class="lineno">  176 </span>   | Op_trace       -- non standard, for debugging GML programs
-<span class="lineno">  177 </span>   | Op_translate
-<span class="lineno">  178 </span>   | Op_union
-<span class="lineno">  179 </span>   | Op_uscale
-<span class="lineno">  180 </span>    deriving (Eq,Ord,Ix,Bounded)
-<span class="lineno">  181 </span>
-<span class="lineno">  182 </span>instance Show GMLOp where
-<span class="lineno">  183 </span>   <span class="decl"><span class="nottickedoff">showsPrec _ op = showString (opNameTable ! op)</span></span>
-<span class="lineno">  184 </span>
-<span class="lineno">  185 </span>
-<span class="lineno">  186 </span>------------------------------------------------------------------------------
-<span class="lineno">  187 </span>
-<span class="lineno">  188 </span>-- And how we use the op codes (there names, there interface)
-<span class="lineno">  189 </span>
-<span class="lineno">  190 </span>-- These keywords include, &quot;apply&quot;, &quot;if&quot;, &quot;true&quot; and &quot;false&quot;,
-<span class="lineno">  191 </span>-- they are not parsed as operators, but are
-<span class="lineno">  192 </span>-- captured by the parser as a special case.
-<span class="lineno">  193 </span>
-<span class="lineno">  194 </span>keyWords :: [String]
-<span class="lineno">  195 </span><span class="decl"><span class="nottickedoff">keyWords = [ kwd | (kwd,_,_) &lt;- opcodes ]</span></span>
-<span class="lineno">  196 </span>
-<span class="lineno">  197 </span>-- Lookup has to look from the start (or else...)
-<span class="lineno">  198 </span>opTable :: [(Name,GMLToken)]
-<span class="lineno">  199 </span><span class="decl"><span class="istickedoff">opTable = [ (kwd,op) | (kwd,op,_) &lt;- opcodes ]</span></span>
-<span class="lineno">  200 </span>
-<span class="lineno">  201 </span>opNameTable :: Array GMLOp Name
-<span class="lineno">  202 </span><span class="decl"><span class="nottickedoff">opNameTable = array (minBound,maxBound) </span>
-<span class="lineno">  203 </span><span class="spaces">                  </span><span class="nottickedoff">[ (op,name) | (name,TOp op,_) &lt;- opcodes ]</span></span>
-<span class="lineno">  204 </span>
-<span class="lineno">  205 </span><span class="decl"><span class="nottickedoff">undef = error &quot;undefined function&quot;</span></span>
-<span class="lineno">  206 </span><span class="decl"><span class="nottickedoff">image = error &quot;undefined function: talk to image group&quot;</span></span>
-<span class="lineno">  207 </span>
-<span class="lineno">  208 </span>-- typically, its best to have *one* opcode table,
-<span class="lineno">  209 </span>-- so that mis-alignments do not happen.
-<span class="lineno">  210 </span>
-<span class="lineno">  211 </span>opcodes :: [(String,GMLToken,PrimOp)]
-<span class="lineno">  212 </span><span class="decl"><span class="istickedoff">opcodes =</span>
-<span class="lineno">  213 </span><span class="spaces"> </span><span class="istickedoff">[ (&quot;apply&quot;,      TApply,           <span class="nottickedoff">error &quot;incorrect use of apply&quot;</span>)</span>
-<span class="lineno">  214 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;if&quot;,         TIf,                   <span class="nottickedoff">error &quot;incorrect use of if&quot;</span>)</span>
-<span class="lineno">  215 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;false&quot;,      TBool <span class="nottickedoff">False</span>,        <span class="nottickedoff">error &quot;incorrect use of false&quot;</span>)</span>
-<span class="lineno">  216 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;true&quot;,       TBool <span class="nottickedoff">True</span>,            <span class="nottickedoff">error &quot;incorrect use of true&quot;</span>)</span>
-<span class="lineno">  217 </span><span class="spaces"> </span><span class="istickedoff">] ++ map (\ (a,b,c) -&gt; (a,TOp b,c))</span>
-<span class="lineno">  218 </span><span class="spaces">   </span><span class="istickedoff">-- These are just invocation, any coersions need to occur between here</span>
-<span class="lineno">  219 </span><span class="spaces">   </span><span class="istickedoff">-- and before arriving at the application code (like deg -&gt; rad).</span>
-<span class="lineno">  220 </span><span class="spaces"> </span><span class="istickedoff">[ (&quot;acos&quot;,       Op_acos,   <span class="nottickedoff">Real_Real (rad2deg . acos)</span>)</span>
-<span class="lineno">  221 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;addi&quot;,       Op_addi,   <span class="nottickedoff">Int_Int_Int (+)</span>)</span>
-<span class="lineno">  222 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;addf&quot;,       Op_addf,   Real_Real_Real (+))</span>
-<span class="lineno">  223 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;asin&quot;,       Op_asin,   <span class="nottickedoff">Real_Real (rad2deg . asin)</span>)</span>
-<span class="lineno">  224 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;clampf&quot;,     Op_clampf,       <span class="nottickedoff">Real_Real clampf</span>)</span>
-<span class="lineno">  225 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;cone&quot;,       Op_cone,   <span class="nottickedoff">Surface_Obj cone</span>)</span>
-<span class="lineno">  226 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;cos&quot;,        Op_cos,     <span class="nottickedoff">Real_Real (cos . deg2rad)</span>)</span>
-<span class="lineno">  227 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;cube&quot;,       Op_cube,   Surface_Obj cube)</span>
-<span class="lineno">  228 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;cylinder&quot;,   Op_cylinder,   <span class="nottickedoff">Surface_Obj cylinder</span>)</span>
-<span class="lineno">  229 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;difference&quot;, Op_difference, <span class="nottickedoff">Obj_Obj_Obj difference</span>)</span>
-<span class="lineno">  230 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;divi&quot;,       Op_divi,   <span class="nottickedoff">Int_Int_Int (ourQuot)</span>)</span>
-<span class="lineno">  231 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;divf&quot;,       Op_divf,   Real_Real_Real (/))</span>
-<span class="lineno">  232 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;eqi&quot;,        Op_eqi,     Int_Int_Bool (==))</span>
-<span class="lineno">  233 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;eqf&quot;,        Op_eqf,     <span class="nottickedoff">Real_Real_Bool (==)</span>)</span>
-<span class="lineno">  234 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;floor&quot;,      Op_floor,         Real_Int floor)</span>
-<span class="lineno">  235 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;frac&quot;,       Op_frac,   Real_Real (snd . properFraction))</span>
-<span class="lineno">  236 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;get&quot;,        Op_get,     Arr_Int_Value ixGet)</span>
-<span class="lineno">  237 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;getx&quot;,       Op_getx,   <span class="nottickedoff">Point_Real (\ x y z -&gt; x)</span>)</span>
-<span class="lineno">  238 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;gety&quot;,       Op_gety,   <span class="nottickedoff">Point_Real (\ x y z -&gt; y)</span>)</span>
-<span class="lineno">  239 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;getz&quot;,       Op_getz,   <span class="nottickedoff">Point_Real (\ x y z -&gt; z)</span>)</span>
-<span class="lineno">  240 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;intersect&quot;,  Op_intersect,  <span class="nottickedoff">Obj_Obj_Obj intersect</span>)</span>
-<span class="lineno">  241 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;length&quot;,     Op_length,       <span class="nottickedoff">Arr_Int (succ . snd . bounds)</span>)</span>
-<span class="lineno">  242 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;lessi&quot;,      Op_lessi,         <span class="nottickedoff">Int_Int_Bool (&lt;)</span>)</span>
-<span class="lineno">  243 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;lessf&quot;,      Op_lessf,         Real_Real_Bool (&lt;))</span>
-<span class="lineno">  244 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;light&quot;,      Op_light,         Point_Color_Light light)</span>
-<span class="lineno">  245 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;modi&quot;,       Op_modi,   Int_Int_Int (ourRem))</span>
-<span class="lineno">  246 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;muli&quot;,       Op_muli,   <span class="nottickedoff">Int_Int_Int (*)</span>)</span>
-<span class="lineno">  247 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;mulf&quot;,       Op_mulf,   Real_Real_Real (*))</span>
-<span class="lineno">  248 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;negi&quot;,       Op_negi,   <span class="nottickedoff">Int_Int negate</span>)</span>
-<span class="lineno">  249 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;negf&quot;,       Op_negf,   <span class="nottickedoff">Real_Real negate</span>)</span>
-<span class="lineno">  250 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;plane&quot;,      Op_plane,         Surface_Obj plane)</span>
-<span class="lineno">  251 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;point&quot;,      Op_point,         Real_Real_Real_Point VPoint)</span>
-<span class="lineno">  252 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;pointlight&quot;, Op_pointlight, <span class="nottickedoff">Point_Color_Light pointlight</span>)</span>
-<span class="lineno">  253 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;real&quot;,       Op_real,   Int_Real fromIntegral)</span>
-<span class="lineno">  254 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;render&quot;,     Op_render,       Render $ render eye)</span>
-<span class="lineno">  255 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;rotatex&quot;,    Op_rotatex,     Obj_Real_Obj (\ o d -&gt; rotateX (deg2rad d) o))</span>
-<span class="lineno">  256 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;rotatey&quot;,    Op_rotatey,     Obj_Real_Obj (\ o d -&gt; rotateY (deg2rad d) o)) </span>
-<span class="lineno">  257 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;rotatez&quot;,    Op_rotatez,     <span class="nottickedoff">Obj_Real_Obj (\ o d -&gt; rotateZ (deg2rad d) o)</span>)</span>
-<span class="lineno">  258 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;scale&quot;,      Op_scale,         <span class="nottickedoff">Obj_Real_Real_Real_Obj (\ o x y z -&gt; scale (x,y,z) o)</span>)</span>
-<span class="lineno">  259 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;sin&quot;,        Op_sin,     <span class="nottickedoff">Real_Real (sin . deg2rad)</span>)</span>
-<span class="lineno">  260 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;sphere&quot;,     Op_sphere,       <span class="nottickedoff">Surface_Obj sphere'</span>) -- see comment at end of file</span>
-<span class="lineno">  261 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;spotlight&quot;,  Op_spotlight,  <span class="nottickedoff">Point_Point_Color_Real_Real_Light mySpotlight</span>)</span>
-<span class="lineno">  262 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;sqrt&quot;,       Op_sqrt,   <span class="nottickedoff">Real_Real ourSqrt</span>)</span>
-<span class="lineno">  263 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;subi&quot;,       Op_subi,   <span class="nottickedoff">Int_Int_Int (-)</span>)</span>
-<span class="lineno">  264 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;subf&quot;,       Op_subf,   <span class="nottickedoff">Real_Real_Real (-)</span>)</span>
-<span class="lineno">  265 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;trace&quot;,      Op_trace,      <span class="nottickedoff">Value_String_Value mytrace</span>)</span>
-<span class="lineno">  266 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;translate&quot;,  Op_translate,  Obj_Real_Real_Real_Obj (\ o x y z -&gt; translate (x,y,z) o))</span>
-<span class="lineno">  267 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;union&quot;,      Op_union,         Obj_Obj_Obj union)</span>
-<span class="lineno">  268 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;uscale&quot;,     Op_uscale,       Obj_Real_Obj (\ o r -&gt; uscale r o))</span>
-<span class="lineno">  269 </span><span class="spaces"> </span><span class="istickedoff">]</span></span>
-<span class="lineno">  270 </span>
-<span class="lineno">  271 </span>-- This enumerate all possible ways of calling the fixed primitives
-<span class="lineno">  272 </span>
-<span class="lineno">  273 </span>-- The datatype captures the type at the *interp* level,
-<span class="lineno">  274 </span>-- the type of the functional is mirrored on this (using Haskell types).
-<span class="lineno">  275 </span>
-<span class="lineno">  276 </span>data PrimOp
-<span class="lineno">  277 </span>
-<span class="lineno">  278 </span>    -- 1 argument 
-<span class="lineno">  279 </span>    = Int_Int         (Int -&gt; Int)
-<span class="lineno">  280 </span>    | Real_Real       (Double -&gt; Double)
-<span class="lineno">  281 </span>    | Point_Real      (Double -&gt; Double -&gt; Double -&gt; Double)
-<span class="lineno">  282 </span>    | Surface_Obj     (SurfaceFn Color Double -&gt; Object)
-<span class="lineno">  283 </span>    | Real_Int        (Double -&gt; Int)
-<span class="lineno">  284 </span>    | Int_Real        (Int -&gt; Double)
-<span class="lineno">  285 </span>    | Arr_Int         (Array Int GMLValue -&gt; Int)
-<span class="lineno">  286 </span>
-<span class="lineno">  287 </span>    -- 2 arguments 
-<span class="lineno">  288 </span>    | Int_Int_Int     (Int -&gt; Int -&gt; Int)
-<span class="lineno">  289 </span>    | Int_Int_Bool    (Int -&gt; Int -&gt; Bool)
-<span class="lineno">  290 </span>    | Real_Real_Real  (Double -&gt; Double -&gt; Double)
-<span class="lineno">  291 </span>    | Real_Real_Bool  (Double -&gt; Double -&gt; Bool)
-<span class="lineno">  292 </span>    | Arr_Int_Value   (Array Int GMLValue -&gt; Int -&gt; GMLValue)
-<span class="lineno">  293 </span>
-<span class="lineno">  294 </span>    -- Many arguments, typically image mangling
-<span class="lineno">  295 </span>
-<span class="lineno">  296 </span>    | Obj_Obj_Obj            (Object -&gt; Object -&gt; Object)
-<span class="lineno">  297 </span>    | Point_Color_Light      (Coords -&gt; Color -&gt; Light)
-<span class="lineno">  298 </span>    | Real_Real_Real_Point   (Double -&gt; Double -&gt; Double -&gt; GMLValue)
-<span class="lineno">  299 </span>    | Obj_Real_Obj           (Object -&gt; Double -&gt; Object)
-<span class="lineno">  300 </span>    | Obj_Real_Real_Real_Obj (Object -&gt; Double -&gt; Double -&gt; Double -&gt; Object)
-<span class="lineno">  301 </span>    | Value_String_Value     (GMLValue -&gt; String -&gt; GMLValue)
-<span class="lineno">  302 </span>
-<span class="lineno">  303 </span>    | Point_Point_Color_Real_Real_Light 
-<span class="lineno">  304 </span>                             (Coords -&gt; Coords -&gt; Color -&gt; Radian -&gt; Radian -&gt; Light)
-<span class="lineno">  305 </span>    -- And finally render
-<span class="lineno">  306 </span>    | Render                 (Color -&gt; [Light] -&gt; Object -&gt; Int -&gt; Double -&gt; Int -&gt; Int -&gt; String -&gt; IO ())
-<span class="lineno">  307 </span>
-<span class="lineno">  308 </span>data Type 
-<span class="lineno">  309 </span>    = TyBool 
-<span class="lineno">  310 </span>    | TyInt 
-<span class="lineno">  311 </span>    | TyReal 
-<span class="lineno">  312 </span>    | TyString 
-<span class="lineno">  313 </span>    | TyCode 
-<span class="lineno">  314 </span>    | TyArray 
-<span class="lineno">  315 </span>    | TyPoint 
-<span class="lineno">  316 </span>    | TyObject 
-<span class="lineno">  317 </span>    | TyLight
-<span class="lineno">  318 </span>    | TyAlpha
-<span class="lineno">  319 </span>    | TyAbsObj
-<span class="lineno">  320 </span>      deriving (Eq,Ord,Ix,Bounded)
-<span class="lineno">  321 </span>
-<span class="lineno">  322 </span><span class="decl"><span class="nottickedoff">typeTable = </span>
-<span class="lineno">  323 </span><span class="spaces">  </span><span class="nottickedoff">[ ( TyBool,   &quot;Bool&quot;)</span>
-<span class="lineno">  324 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyInt,    &quot;Int&quot;)</span>
-<span class="lineno">  325 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyReal,   &quot;Real&quot;)</span>
-<span class="lineno">  326 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyString, &quot;String&quot;)</span>
-<span class="lineno">  327 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyCode,   &quot;Code&quot;)</span>
-<span class="lineno">  328 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyArray,  &quot;Array&quot;)</span>
-<span class="lineno">  329 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyPoint,  &quot;Point&quot;)</span>
-<span class="lineno">  330 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyObject, &quot;Object&quot;)</span>
-<span class="lineno">  331 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyLight,  &quot;Light&quot;)</span>
-<span class="lineno">  332 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyAlpha,  &quot;&lt;anything&gt;&quot;)</span>
-<span class="lineno">  333 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyAbsObj, &quot;&lt;abs&gt;&quot;)</span>
-<span class="lineno">  334 </span><span class="spaces">  </span><span class="nottickedoff">]</span></span>
-<span class="lineno">  335 </span>
-<span class="lineno">  336 </span><span class="decl"><span class="nottickedoff">typeNames = array (minBound,maxBound) typeTable</span></span>
-<span class="lineno">  337 </span>
-<span class="lineno">  338 </span>instance Show Type where
-<span class="lineno">  339 </span>   <span class="decl"><span class="nottickedoff">showsPrec _ op = showString (typeNames ! op)</span></span>
-<span class="lineno">  340 </span>
-<span class="lineno">  341 </span>getPrimOpType :: PrimOp -&gt; [Type]
-<span class="lineno">  342 </span><span class="decl"><span class="nottickedoff">getPrimOpType (Int_Int         _) = [TyInt]</span>
-<span class="lineno">  343 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Real       _) = [TyReal]</span>
-<span class="lineno">  344 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Point_Real      _) = [TyPoint]</span>
-<span class="lineno">  345 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Surface_Obj     _) = [TyCode]</span>
-<span class="lineno">  346 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Int        _) = [TyReal]</span>
-<span class="lineno">  347 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Int_Real        _) = [TyInt]</span>
-<span class="lineno">  348 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Arr_Int         _) = [TyArray]</span>
-<span class="lineno">  349 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Int_Int_Int     _) = [TyInt,TyInt]</span>
-<span class="lineno">  350 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Int_Int_Bool    _) = [TyInt,TyInt]</span>
-<span class="lineno">  351 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Real_Real  _) = [TyReal,TyReal]</span>
-<span class="lineno">  352 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Real_Bool  _) = [TyReal,TyReal]</span>
-<span class="lineno">  353 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Arr_Int_Value   _) = [TyArray,TyInt]</span>
-<span class="lineno">  354 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Obj_Obj_Obj            _) = [TyObject,TyObject]</span>
-<span class="lineno">  355 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Point_Color_Light      _) = [TyPoint,TyPoint]</span>
-<span class="lineno">  356 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Real_Real_Point   _) = [TyReal,TyReal,TyReal]</span>
-<span class="lineno">  357 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Obj_Real_Obj           _) = [TyObject,TyReal]</span>
-<span class="lineno">  358 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Obj_Real_Real_Real_Obj _) = [TyObject,TyReal,TyReal,TyReal]</span>
-<span class="lineno">  359 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Value_String_Value     _) = [TyAlpha,TyString]</span>
-<span class="lineno">  360 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Point_Point_Color_Real_Real_Light _) </span>
-<span class="lineno">  361 </span><span class="spaces">                                         </span><span class="nottickedoff">= [TyPoint,TyPoint,TyPoint,TyReal,TyReal]</span>
-<span class="lineno">  362 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Render                 _) = [TyPoint,</span>
-<span class="lineno">  363 </span><span class="spaces">                                            </span><span class="nottickedoff">TyLight,</span>
-<span class="lineno">  364 </span><span class="spaces">                                            </span><span class="nottickedoff">TyObject,</span>
-<span class="lineno">  365 </span><span class="spaces">                                            </span><span class="nottickedoff">TyInt,</span>
-<span class="lineno">  366 </span><span class="spaces">                                            </span><span class="nottickedoff">TyReal,</span>
-<span class="lineno">  367 </span><span class="spaces">                                            </span><span class="nottickedoff">TyReal,</span>
-<span class="lineno">  368 </span><span class="spaces">                                            </span><span class="nottickedoff">TyReal,</span>
-<span class="lineno">  369 </span><span class="spaces">                                            </span><span class="nottickedoff">TyString]</span></span>
-<span class="lineno">  370 </span>
-<span class="lineno">  371 </span>
-<span class="lineno">  372 </span>-- Some primitives with better error message
-<span class="lineno">  373 </span>
-<span class="lineno">  374 </span><span class="decl"><span class="nottickedoff">mytrace v s = trace (s ++&quot; : &quot;++ show v ++ &quot;\n&quot;) v</span></span>
-<span class="lineno">  375 </span>
-<span class="lineno">  376 </span>
-<span class="lineno">  377 </span>ixGet :: Array Int GMLValue -&gt; Int -&gt; GMLValue
-<span class="lineno">  378 </span><span class="decl"><span class="istickedoff">ixGet arr i</span>
-<span class="lineno">  379 </span><span class="spaces">   </span><span class="istickedoff">| <span class="tickonlytrue">inRange (bounds arr) i</span> = arr ! i</span>
-<span class="lineno">  380 </span><span class="spaces">   </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">error (&quot;failed access with index value &quot; </span></span>
-<span class="lineno">  381 </span><span class="spaces">                     </span><span class="istickedoff"><span class="nottickedoff">++ show i </span></span>
-<span class="lineno">  382 </span><span class="spaces">                     </span><span class="istickedoff"><span class="nottickedoff">++ &quot; (should be between 0 and &quot; </span></span>
-<span class="lineno">  383 </span><span class="spaces">                     </span><span class="istickedoff"><span class="nottickedoff">++ show (snd (bounds arr)) ++ &quot;)&quot;)</span></span></span>
-<span class="lineno">  384 </span>
-<span class="lineno">  385 </span>ourQuot :: Int -&gt; Int -&gt; Int
-<span class="lineno">  386 </span><span class="decl"><span class="nottickedoff">ourQuot _ 0 = error &quot;attempt to use divi to divide by 0&quot;</span>
-<span class="lineno">  387 </span><span class="spaces"></span><span class="nottickedoff">ourQuot a b = a `quot` b</span></span>
-<span class="lineno">  388 </span>
-<span class="lineno">  389 </span>ourRem :: Int -&gt; Int -&gt; Int
-<span class="lineno">  390 </span><span class="decl"><span class="istickedoff">ourRem _ 0 = <span class="nottickedoff">error &quot;attempt to use remi to divide by 0&quot;</span></span>
-<span class="lineno">  391 </span><span class="spaces"></span><span class="istickedoff">ourRem a b = a `rem` b</span></span>
-<span class="lineno">  392 </span>
-<span class="lineno">  393 </span>ourSqrt :: Double -&gt; Double
-<span class="lineno">  394 </span><span class="decl"><span class="nottickedoff">ourSqrt n | n &lt; 0     = error &quot;attempt to use sqrt on a negative number&quot;</span>
-<span class="lineno">  395 </span><span class="spaces">          </span><span class="nottickedoff">| otherwise = sqrt n</span></span>
-<span class="lineno">  396 </span>
-<span class="lineno">  397 </span>
-<span class="lineno">  398 </span><span class="decl"><span class="nottickedoff">mySpotlight p1 p2 col cutoff exp = spotlight p1 p2 col (deg2rad cutoff) exp</span></span>
-<span class="lineno">  399 </span>
-<span class="lineno">  400 </span>-- The problem specification gets the mapping for spheres backwards
-<span class="lineno">  401 </span>-- (it maps the image from right to left).
-<span class="lineno">  402 </span>-- We've fixed that in the raytracing library so that it goes from left
-<span class="lineno">  403 </span>-- to right, but to keep the GML front compatible with the problem
-<span class="lineno">  404 </span>-- statement, we reverse it here.
-<span class="lineno">  405 </span>
-<span class="lineno">  406 </span>sphere' :: SurfaceFn Color Double -&gt; CSG (SurfaceFn Color Double)
-<span class="lineno">  407 </span><span class="decl"><span class="nottickedoff">sphere' (SFun f) = sphere (SFun (\i u v -&gt; f i (1 - u) v))</span>
-<span class="lineno">  408 </span><span class="spaces"></span><span class="nottickedoff">sphere' s = sphere s</span></span>
-
-</pre>
-</html>
-Writing: Illumination.hs.html
-<html><style type="text/css">
-span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
-span.nottickedoff { background: yellow}
-span.istickedoff { background: white }
-span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
-span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
-span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
-span.decl { font-weight: bold }
-span.spaces    { background: white }
-</style>
-<pre>
-<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
-<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
-<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
-<span class="lineno">    4 </span>-- which is included in the distribution.
-<span class="lineno">    5 </span>
-<span class="lineno">    6 </span>-- Modified to use stdout (for testing)
-<span class="lineno">    7 </span>
-<span class="lineno">    8 </span>module Illumination
-<span class="lineno">    9 </span>    ( Object
-<span class="lineno">   10 </span>    , Light (..)
-<span class="lineno">   11 </span>    , light, pointlight, spotlight
-<span class="lineno">   12 </span>    , render
-<span class="lineno">   13 </span>    ) where
-<span class="lineno">   14 </span>
-<span class="lineno">   15 </span>import Array
-<span class="lineno">   16 </span>import Char(chr)
-<span class="lineno">   17 </span>import Maybe
-<span class="lineno">   18 </span>
-<span class="lineno">   19 </span>import Geometry
-<span class="lineno">   20 </span>import CSG
-<span class="lineno">   21 </span>import Surface
-<span class="lineno">   22 </span>import Misc
-<span class="lineno">   23 </span>
-<span class="lineno">   24 </span>type Object = CSG (SurfaceFn Color Double)
-<span class="lineno">   25 </span>
-<span class="lineno">   26 </span>data Cxt = Cxt {ambient::Color, lights::[Light], object::Object, depth::Int}
-<span class="lineno">   27 </span>        deriving Show
-<span class="lineno">   28 </span>
-<span class="lineno">   29 </span>render :: (Matrix,Matrix) -&gt; Color -&gt; [Light] -&gt; Object -&gt; Int -&gt;
-<span class="lineno">   30 </span>          Radian -&gt; Int -&gt; Int -&gt; String -&gt; IO ()
-<span class="lineno">   31 </span><span class="decl"><span class="istickedoff">render (m,m') amb ls obj dep fov wid ht file</span>
-<span class="lineno">   32 </span><span class="spaces">  </span><span class="istickedoff">= do { debugging</span>
-<span class="lineno">   33 </span><span class="spaces">       </span><span class="istickedoff">; txt &lt;- readFile &quot;galois.sample&quot;</span>
-<span class="lineno">   34 </span><span class="spaces">       </span><span class="istickedoff">; let vals = read txt</span>
-<span class="lineno">   35 </span><span class="spaces">       </span><span class="istickedoff">; let rt_vals = showBitmap' <span class="nottickedoff">wid</span> <span class="nottickedoff">ht</span> pixels</span>
-<span class="lineno">   36 </span><span class="spaces">       </span><span class="istickedoff">; if <span class="tickonlyfalse">length vals /= length rt_vals</span></span>
-<span class="lineno">   37 </span><span class="spaces">           </span><span class="istickedoff">then <span class="nottickedoff">print (&quot;BAD LENGTH&quot;,length vals,length rt_vals)</span></span>
-<span class="lineno">   38 </span><span class="spaces">           </span><span class="istickedoff">else do {</span>
-<span class="lineno">   39 </span><span class="spaces">                   </span><span class="istickedoff">; let cmp = sum(zipWith (\ a b -&gt; abs (a - b) * abs (a - b)) vals rt_vals)</span>
-<span class="lineno">   40 </span><span class="spaces">                   </span><span class="istickedoff">; print $ if <span class="tickonlytrue">cmp &lt;= (length vals * 16)</span> then (&quot;GOOD MATCH&quot;) else <span class="nottickedoff">(&quot;BAD MATCH:&quot; ++ show cmp)</span></span>
-<span class="lineno">   41 </span><span class="spaces">                   </span><span class="istickedoff">}}</span>
-<span class="lineno">   42 </span><span class="spaces">                   </span><span class="istickedoff"></span>
-<span class="lineno">   43 </span><span class="spaces">  </span><span class="istickedoff">where</span>
-<span class="lineno">   44 </span><span class="spaces">    </span><span class="istickedoff">debugging = return <span class="nottickedoff">()</span></span>
-<span class="lineno">   45 </span><span class="spaces"></span><span class="istickedoff">{-</span>
-<span class="lineno">   46 </span><span class="spaces">                </span><span class="istickedoff">do { putStrLn (show cxt)</span>
-<span class="lineno">   47 </span><span class="spaces">                   </span><span class="istickedoff">; putStrLn (show (width, delta, aspect, left, top))</span>
-<span class="lineno">   48 </span><span class="spaces">                   </span><span class="istickedoff">}</span>
-<span class="lineno">   49 </span><span class="spaces"></span><span class="istickedoff">-}</span>
-<span class="lineno">   50 </span><span class="spaces">    </span><span class="istickedoff">obj' = transform (m',m) obj</span>
-<span class="lineno">   51 </span><span class="spaces">    </span><span class="istickedoff">ls'  = [ transformLight m' l | l &lt;- ls ]</span>
-<span class="lineno">   52 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">pixelA = listArray ((1,1), (ht,wid))</span></span>
-<span class="lineno">   53 </span><span class="spaces">                       </span><span class="istickedoff"><span class="nottickedoff">[ illumination cxt (start,pixel i j)</span></span>
-<span class="lineno">   54 </span><span class="spaces">                       </span><span class="istickedoff"><span class="nottickedoff">| j &lt;- take ht  [0.5..]</span></span>
-<span class="lineno">   55 </span><span class="spaces">                       </span><span class="istickedoff"><span class="nottickedoff">, i &lt;- take wid [0.5..] ]</span></span>
-<span class="lineno">   56 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">antiA  = pixelA //</span></span>
-<span class="lineno">   57 </span><span class="spaces">             </span><span class="istickedoff"><span class="nottickedoff">[ (ix, superSample ix (pixelA ! ix))</span></span>
-<span class="lineno">   58 </span><span class="spaces">             </span><span class="istickedoff"><span class="nottickedoff">| j &lt;- [2 .. ht - 1], i &lt;- [2 .. wid - 1]</span></span>
-<span class="lineno">   59 </span><span class="spaces">             </span><span class="istickedoff"><span class="nottickedoff">, let ix = (j, i)</span></span>
-<span class="lineno">   60 </span><span class="spaces">             </span><span class="istickedoff"><span class="nottickedoff">, contrast ix pixelA ]</span></span>
-<span class="lineno">   61 </span><span class="spaces">    </span><span class="istickedoff">pixels = [ [ illumination cxt (start,pixel i j) | i&lt;- take wid [0.5..] ]</span>
-<span class="lineno">   62 </span><span class="spaces">             </span><span class="istickedoff">| j &lt;- take ht [0.5..]</span>
-<span class="lineno">   63 </span><span class="spaces">             </span><span class="istickedoff">]</span>
-<span class="lineno">   64 </span><span class="spaces">    </span><span class="istickedoff">cxt    = Cxt {ambient=amb, lights=ls',  object=obj', depth=dep}</span>
-<span class="lineno">   65 </span><span class="spaces">    </span><span class="istickedoff">start  = point  0 0 (-1)</span>
-<span class="lineno">   66 </span><span class="spaces">    </span><span class="istickedoff">width  = 2 * tan (fov/2)</span>
-<span class="lineno">   67 </span><span class="spaces">    </span><span class="istickedoff">delta  = width / fromIntegral wid</span>
-<span class="lineno">   68 </span><span class="spaces">    </span><span class="istickedoff">aspect = fromIntegral ht / fromIntegral wid</span>
-<span class="lineno">   69 </span><span class="spaces">    </span><span class="istickedoff">left   = - width / 2</span>
-<span class="lineno">   70 </span><span class="spaces">    </span><span class="istickedoff">top    = - left * aspect</span>
-<span class="lineno">   71 </span><span class="spaces">    </span><span class="istickedoff">pixel i j = vector (left + i*delta) (top - j*delta) 1</span>
-<span class="lineno">   72 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   73 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">superSample (y, x) col = avg $ col:</span></span>
-<span class="lineno">   74 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">[ illumination cxt (start, pixel (fromIntegral x - 0.5 + xd) (fromIntegral y - 0.5 + yd))</span></span>
-<span class="lineno">   75 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">| (xd, yd) &lt;- [(-0.333, 0.0), (0.333, 0.0), (0.0, -0.333), (0.0, 0.333)]</span></span>
-<span class="lineno">   76 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">]</span></span></span> 
-<span class="lineno">   77 </span>
-<span class="lineno">   78 </span><span class="decl"><span class="nottickedoff">avg cs = divN (fromIntegral (length cs)) (uncolor (sumCC cs))</span>
-<span class="lineno">   79 </span><span class="spaces">  </span><span class="nottickedoff">where divN n (r,g,b) = color (r / n) (g / n) (b / n)</span></span>
-<span class="lineno">   80 </span>
-<span class="lineno">   81 </span>contrast :: (Int, Int) -&gt; Array (Int, Int) Color -&gt; Bool
-<span class="lineno">   82 </span><span class="decl"><span class="nottickedoff">contrast (x, y) arr = any diffMax [ subCC cur (arr ! (x + xd, y + yd))</span>
-<span class="lineno">   83 </span><span class="spaces">                                  </span><span class="nottickedoff">| xd &lt;- [-1, 1], yd &lt;- [-1, 1]</span>
-<span class="lineno">   84 </span><span class="spaces">                                  </span><span class="nottickedoff">]</span>
-<span class="lineno">   85 </span><span class="spaces">  </span><span class="nottickedoff">where cur = arr ! (x, y)</span>
-<span class="lineno">   86 </span><span class="spaces">        </span><span class="nottickedoff">diffMax col = (abs r) &gt; 0.25 || (abs g) &gt;  0.2 || (abs b) &gt; 0.4</span>
-<span class="lineno">   87 </span><span class="spaces">           </span><span class="nottickedoff">where</span>
-<span class="lineno">   88 </span><span class="spaces">                 </span><span class="nottickedoff">(r,g,b) = uncolor col</span></span>
-<span class="lineno">   89 </span>
-<span class="lineno">   90 </span>
-<span class="lineno">   91 </span>illumination :: Cxt -&gt; Ray -&gt; Color
-<span class="lineno">   92 </span><span class="decl"><span class="istickedoff">illumination cxt (r,v)</span>
-<span class="lineno">   93 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlyfalse">depth cxt &lt;= 0</span> = <span class="nottickedoff">black</span></span>
-<span class="lineno">   94 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>     = case castRay (r,v) (object cxt) of</span>
-<span class="lineno">   95 </span><span class="spaces">                      </span><span class="istickedoff">Nothing -&gt; black</span>
-<span class="lineno">   96 </span><span class="spaces">                      </span><span class="istickedoff">Just info -&gt; illum (cxt{depth=(depth cxt)-1}) info v</span></span>
-<span class="lineno">   97 </span>
-<span class="lineno">   98 </span>illum :: Cxt -&gt; (Point,Vector,Properties Color Double) -&gt; Vector -&gt; Color
-<span class="lineno">   99 </span><span class="decl"><span class="istickedoff">illum cxt (pos,normV,(col,kd,ks,n)) v</span>
-<span class="lineno">  100 </span><span class="spaces">  </span><span class="istickedoff">= ambTerm `addCC` difTerm `addCC` spcTerm `addCC` recTerm</span>
-<span class="lineno">  101 </span><span class="spaces">  </span><span class="istickedoff">where</span>
-<span class="lineno">  102 </span><span class="spaces">    </span><span class="istickedoff">visibleLights = unobscured pos (object cxt) (lights cxt) normV</span>
-<span class="lineno">  103 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">d = depth cxt</span></span>
-<span class="lineno">  104 </span><span class="spaces">    </span><span class="istickedoff">amb = ambient cxt</span>
-<span class="lineno">  105 </span><span class="spaces">    </span><span class="istickedoff">newV = subVV v (multSV (2 * dot normV v) normV)</span>
-<span class="lineno">  106 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  107 </span><span class="spaces">    </span><span class="istickedoff">ambTerm = multSC kd (multCC amb col)</span>
-<span class="lineno">  108 </span><span class="spaces">    </span><span class="istickedoff">difTerm = multSC kd (sumCC [multSC (dot normV lj) (multCC intensity col)</span>
-<span class="lineno">  109 </span><span class="spaces">               </span><span class="istickedoff">|(loc,intensity) &lt;- visibleLights,</span>
-<span class="lineno">  110 </span><span class="spaces">               </span><span class="istickedoff">let lj = normalize ({- pos `subVV` -} loc)])</span>
-<span class="lineno">  111 </span><span class="spaces">    </span><span class="istickedoff">-- ZZ might want to avoid the phong, when you can...</span>
-<span class="lineno">  112 </span><span class="spaces">    </span><span class="istickedoff">spcTerm = multSC ks (sumCC [multSC ((dot normV hj) ** n ) (multCC intensity col)</span>
-<span class="lineno">  113 </span><span class="spaces">               </span><span class="istickedoff">|(loc,intensity) &lt;- visibleLights,</span>
-<span class="lineno">  114 </span><span class="spaces">               </span><span class="istickedoff">-- ZZ note this is specific to the light at infinity</span>
-<span class="lineno">  115 </span><span class="spaces">               </span><span class="istickedoff">let lj = {- pos `subVV` -} normalize loc,</span>
-<span class="lineno">  116 </span><span class="spaces">               </span><span class="istickedoff">let hj = normalize (lj `subVV` normalize v)])</span>
-<span class="lineno">  117 </span><span class="spaces">    </span><span class="istickedoff">recTerm  = if recCoeff `nearC` black then black else multCC recCoeff recRay</span>
-<span class="lineno">  118 </span><span class="spaces">    </span><span class="istickedoff">recCoeff = multSC ks col</span>
-<span class="lineno">  119 </span><span class="spaces">    </span><span class="istickedoff">recRay   = illumination cxt (pos,newV)</span></span>
-<span class="lineno">  120 </span>
-<span class="lineno">  121 </span>showBitmapA :: Int -&gt; Int -&gt; Array (Int, Int) Color -&gt; String
-<span class="lineno">  122 </span><span class="decl"><span class="nottickedoff">showBitmapA wid ht arr</span>
-<span class="lineno">  123 </span><span class="spaces">  </span><span class="nottickedoff">= header ++ concatMap scaleColor (elems arr)</span>
-<span class="lineno">  124 </span><span class="spaces">  </span><span class="nottickedoff">where</span>
-<span class="lineno">  125 </span><span class="spaces">    </span><span class="nottickedoff">scaleColor col = [scalePixel r, scalePixel g, scalePixel b]</span>
-<span class="lineno">  126 </span><span class="spaces">           </span><span class="nottickedoff">where (r,g,b) = uncolor col</span>
-<span class="lineno">  127 </span><span class="spaces">    </span><span class="nottickedoff">header = &quot;P6\n#Galois\n&quot; ++ show wid ++ &quot; &quot; ++ show ht ++ &quot;\n255\n&quot;</span></span>
-<span class="lineno">  128 </span>
-<span class="lineno">  129 </span>showBitmap :: Int -&gt; Int -&gt;[[Color]] -&gt; String
-<span class="lineno">  130 </span><span class="decl"><span class="nottickedoff">showBitmap wid ht pss</span>
-<span class="lineno">  131 </span><span class="spaces"></span><span class="nottickedoff">-- type of assert  | length pss == ht &amp;&amp; all (\ ps -&gt; length ps == wid) pss</span>
-<span class="lineno">  132 </span><span class="spaces">  </span><span class="nottickedoff">= header ++ concat [[scalePixel r,scalePixel g,scalePixel b] </span>
-<span class="lineno">  133 </span><span class="spaces">                      </span><span class="nottickedoff">| ps &lt;- pss, (r,g,b) &lt;- map uncolor ps]</span>
-<span class="lineno">  134 </span><span class="spaces">  </span><span class="nottickedoff">where</span>
-<span class="lineno">  135 </span><span class="spaces">    </span><span class="nottickedoff">header = &quot;P6\n#Galois\n&quot; ++ show wid ++ &quot; &quot; ++ show ht ++ &quot;\n255\n&quot;</span>
-<span class="lineno">  136 </span><span class="spaces"></span><span class="nottickedoff">showBitmap _ _ _ = error &quot;incorrect length of bitmap string&quot;</span></span>
-<span class="lineno">  137 </span>
-<span class="lineno">  138 </span>scalePixel :: Double -&gt; Char
-<span class="lineno">  139 </span><span class="decl"><span class="nottickedoff">scalePixel p = chr (floor (clampf p * 255))</span></span>
-<span class="lineno">  140 </span>
-<span class="lineno">  141 </span>showBitmap' :: Int -&gt; Int -&gt;[[Color]] -&gt; [Int]
-<span class="lineno">  142 </span><span class="decl"><span class="istickedoff">showBitmap' wid ht pss</span>
-<span class="lineno">  143 </span><span class="spaces"></span><span class="istickedoff">-- type of assert  | length pss == ht &amp;&amp; all (\ ps -&gt; length ps == wid) pss</span>
-<span class="lineno">  144 </span><span class="spaces">  </span><span class="istickedoff">= concat [ concat [  [scalePixel' r,scalePixel' g,scalePixel' b]</span>
-<span class="lineno">  145 </span><span class="spaces">                    </span><span class="istickedoff">| (r,g,b) &lt;- map uncolor ps]</span>
-<span class="lineno">  146 </span><span class="spaces">           </span><span class="istickedoff">| ps &lt;- pss ]</span>
-<span class="lineno">  147 </span><span class="spaces">  </span><span class="istickedoff">where</span>
-<span class="lineno">  148 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">header = &quot;P3\n#Galois\n&quot; ++ show wid ++ &quot; &quot; ++ show ht ++ &quot;\n255\n&quot;</span></span>
-<span class="lineno">  149 </span><span class="spaces"></span><span class="istickedoff">showBitmap' _ _ _ = <span class="nottickedoff">error &quot;incorrect length of bitmap string&quot;</span></span></span>
-<span class="lineno">  150 </span>
-<span class="lineno">  151 </span>scalePixel' :: Double -&gt; Int
-<span class="lineno">  152 </span><span class="decl"><span class="istickedoff">scalePixel' p = floor (clampf p * 255)</span></span>
-<span class="lineno">  153 </span>
-<span class="lineno">  154 </span>-- Lights
-<span class="lineno">  155 </span>
-<span class="lineno">  156 </span>data Light = Light Vector Color
-<span class="lineno">  157 </span>           | PointLight Point Color 
-<span class="lineno">  158 </span>           | SpotLight Point Point Color Radian Double
-<span class="lineno">  159 </span>   deriving Show
-<span class="lineno">  160 </span>
-<span class="lineno">  161 </span>light :: Coords -&gt; Color -&gt; Light
-<span class="lineno">  162 </span><span class="decl"><span class="istickedoff">light (x,y,z) color =</span>
-<span class="lineno">  163 </span><span class="spaces">  </span><span class="istickedoff">Light (normalize (vector (-x) (-y) (-z))) color</span></span>
-<span class="lineno">  164 </span><span class="decl"><span class="nottickedoff">pointlight (x,y,z) color =</span>
-<span class="lineno">  165 </span><span class="spaces">  </span><span class="nottickedoff">PointLight (point x y z) color</span></span>
-<span class="lineno">  166 </span><span class="decl"><span class="nottickedoff">spotlight (x,y,z) (p,q,r) col cutoff exp =</span>
-<span class="lineno">  167 </span><span class="spaces">  </span><span class="nottickedoff">SpotLight (point x y z) (point p q r) col cutoff exp</span></span>
-<span class="lineno">  168 </span>
-<span class="lineno">  169 </span><span class="decl"><span class="istickedoff">transformLight m (Light v c) = Light (multMV m v) c</span>
-<span class="lineno">  170 </span><span class="spaces"></span><span class="istickedoff">transformLight m (PointLight p c) = <span class="nottickedoff">PointLight (multMP m p) c</span></span>
-<span class="lineno">  171 </span><span class="spaces"></span><span class="istickedoff">transformLight m (SpotLight p q c r d) = <span class="nottickedoff">SpotLight (multMP m p) (multMP m q) c r d</span></span></span>
-<span class="lineno">  172 </span>
-<span class="lineno">  173 </span>unobscured :: Point -&gt; Object -&gt; [Light] -&gt;  Vector -&gt; [(Vector,Color)]
-<span class="lineno">  174 </span><span class="decl"><span class="istickedoff">unobscured pos obj lights normV = catMaybes (map (unobscure pos obj normV) lights)</span></span>
-<span class="lineno">  175 </span>
-<span class="lineno">  176 </span>unobscure :: Point -&gt; Object -&gt; Vector -&gt;  Light -&gt; Maybe (Vector,Color)
-<span class="lineno">  177 </span><span class="decl"><span class="istickedoff">unobscure pos obj normV (Light vec color)</span>
-<span class="lineno">  178 </span><span class="spaces">  </span><span class="istickedoff">-- ZZ probably want to make this faster</span>
-<span class="lineno">  179 </span><span class="spaces">  </span><span class="istickedoff">| vec `dot` normV &lt; 0 = Nothing</span>
-<span class="lineno">  180 </span><span class="spaces">  </span><span class="istickedoff">| intersects (pos `addPV` (0.0001 `multSV` vec),vec) obj = Nothing</span>
-<span class="lineno">  181 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>               = Just (vec,color)</span>
-<span class="lineno">  182 </span><span class="spaces"></span><span class="istickedoff">unobscure pos obj normV (PointLight pp color)</span>
-<span class="lineno">  183 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">vec `dot` normV &lt; 0</span>     = <span class="nottickedoff">Nothing</span></span>
-<span class="lineno">  184 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">intersectWithin (pos `addPV` (0.0001 `multSV` (normalize vec)), vec) obj</span> = <span class="nottickedoff">Nothing</span></span>
-<span class="lineno">  185 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span>               = <span class="nottickedoff">Just (vec,is)</span></span>
-<span class="lineno">  186 </span><span class="spaces">      </span><span class="istickedoff">where <span class="nottickedoff">vec = pp `subPP` pos</span></span>
-<span class="lineno">  187 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">is  = attenuate vec color</span></span>
-<span class="lineno">  188 </span><span class="spaces"></span><span class="istickedoff">unobscure org obj normV (SpotLight pos at color cutoff exp)</span>
-<span class="lineno">  189 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">vec `dot` normV &lt; 0</span>                                                 = <span class="nottickedoff">Nothing</span></span>
-<span class="lineno">  190 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">intersectWithin (org `addPV` (0.0001 `multSV` (normalize vec)), vec) obj</span> = <span class="nottickedoff">Nothing</span></span>
-<span class="lineno">  191 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">angle &gt; cutoff</span>                                                      = <span class="nottickedoff">Nothing</span></span>
-<span class="lineno">  192 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span>                                                           = <span class="nottickedoff">Just (vec, is)</span></span>
-<span class="lineno">  193 </span><span class="spaces">      </span><span class="istickedoff">where <span class="nottickedoff">vec   = pos `subPP` org</span></span>
-<span class="lineno">  194 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">vec'  = pos `subPP` at</span></span>
-<span class="lineno">  195 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">angle = acos (normalize vec `dot` (normalize vec'))</span></span>
-<span class="lineno">  196 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  197 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">asp   = normalize (at `subPP` pos)</span>            </span>
-<span class="lineno">  198 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">qsp   = normalize (org `subPP` pos)</span></span>
-<span class="lineno">  199 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">is    = attenuate vec (((asp `dot` qsp) ** exp) `multSC` color)</span></span></span>
-<span class="lineno">  200 </span>
-<span class="lineno">  201 </span>attenuate :: Vector -&gt; Color -&gt; Color
-<span class="lineno">  202 </span><span class="decl"><span class="nottickedoff">attenuate vec color = (100 / (99 + sq (norm vec))) `multSC` color</span></span>
-<span class="lineno">  203 </span>
-<span class="lineno">  204 </span>--
-<span class="lineno">  205 </span>
-<span class="lineno">  206 </span><span class="decl"><span class="istickedoff">castRay ray p</span>
-<span class="lineno">  207 </span><span class="spaces">  </span><span class="istickedoff">= case intersectRayWithObject ray p of</span>
-<span class="lineno">  208 </span><span class="spaces">    </span><span class="istickedoff">(True, _, _)                     -&gt; <span class="nottickedoff">Nothing</span> -- eye is inside</span>
-<span class="lineno">  209 </span><span class="spaces">    </span><span class="istickedoff">(False, [], _)                   -&gt; Nothing -- eye is inside</span>
-<span class="lineno">  210 </span><span class="spaces">    </span><span class="istickedoff">(False, (0, b, _) : _, _)        -&gt; <span class="nottickedoff">Nothing</span> -- eye is inside</span>
-<span class="lineno">  211 </span><span class="spaces">    </span><span class="istickedoff">(False, (i, False, _) : _, _)    -&gt; <span class="nottickedoff">Nothing</span> -- eye is inside</span>
-<span class="lineno">  212 </span><span class="spaces">    </span><span class="istickedoff">(False, (t, b, (s, p0)) : _, _)     -&gt;</span>
-<span class="lineno">  213 </span><span class="spaces">        </span><span class="istickedoff">let (v, prop) = surface s p0 in</span>
-<span class="lineno">  214 </span><span class="spaces">            </span><span class="istickedoff">Just (offsetToPoint ray t, v, prop)</span></span>
-<span class="lineno">  215 </span>
-<span class="lineno">  216 </span><span class="decl"><span class="istickedoff">intersects ray p</span>
-<span class="lineno">  217 </span><span class="spaces">  </span><span class="istickedoff">= case intersectRayWithObject ray p of</span>
-<span class="lineno">  218 </span><span class="spaces">    </span><span class="istickedoff">(True, _, _)                  -&gt; <span class="nottickedoff">False</span></span>
-<span class="lineno">  219 </span><span class="spaces">    </span><span class="istickedoff">(False, [], _)                -&gt; False</span>
-<span class="lineno">  220 </span><span class="spaces">    </span><span class="istickedoff">(False, (0, b, _) : _, _)     -&gt; <span class="nottickedoff">False</span></span>
-<span class="lineno">  221 </span><span class="spaces">    </span><span class="istickedoff">(False, (i, False, _) : _, _) -&gt; <span class="nottickedoff">False</span></span>
-<span class="lineno">  222 </span><span class="spaces">    </span><span class="istickedoff">(False, (i, b, _) : _, _)     -&gt; True</span></span>
-<span class="lineno">  223 </span>
-<span class="lineno">  224 </span>intersectWithin :: Ray -&gt; Object -&gt; Bool
-<span class="lineno">  225 </span><span class="decl"><span class="nottickedoff">intersectWithin ray p</span>
-<span class="lineno">  226 </span><span class="spaces">  </span><span class="nottickedoff">= case intersectRayWithObject ray p of</span>
-<span class="lineno">  227 </span><span class="spaces">    </span><span class="nottickedoff">(True, _, _)                  -&gt; False -- eye is inside</span>
-<span class="lineno">  228 </span><span class="spaces">    </span><span class="nottickedoff">(False, [], _)                -&gt; False -- eye is inside</span>
-<span class="lineno">  229 </span><span class="spaces">    </span><span class="nottickedoff">(False, (0, b, _) : _, _)     -&gt; False -- eye is inside</span>
-<span class="lineno">  230 </span><span class="spaces">    </span><span class="nottickedoff">(False, (i, False, _) : _, _) -&gt; False -- eye is inside</span>
-<span class="lineno">  231 </span><span class="spaces">    </span><span class="nottickedoff">(False, (t, b, _) : _, _)     -&gt; t &lt; 1.0</span></span>
-
-</pre>
-</html>
-Writing: Geometry.hs.html
-<html><style type="text/css">
-span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
-span.nottickedoff { background: yellow}
-span.istickedoff { background: white }
-span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
-span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
-span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
-span.decl { font-weight: bold }
-span.spaces    { background: white }
-</style>
-<pre>
-<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
-<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
-<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
-<span class="lineno">    4 </span>-- which is included in the distribution.
-<span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module Geometry
-<span class="lineno">    7 </span>    ( Coords
-<span class="lineno">    8 </span>    , Ray
-<span class="lineno">    9 </span>    , Point  -- abstract
-<span class="lineno">   10 </span>    , Vector -- abstract
-<span class="lineno">   11 </span>    , Matrix -- abstract
-<span class="lineno">   12 </span>    , Color  -- abstract
-<span class="lineno">   13 </span>    , Box(..)
-<span class="lineno">   14 </span>    , Radian
-<span class="lineno">   15 </span>    , matrix
-<span class="lineno">   16 </span>    , coord
-<span class="lineno">   17 </span>    , color
-<span class="lineno">   18 </span>    , uncolor
-<span class="lineno">   19 </span>    , xCoord , yCoord , zCoord
-<span class="lineno">   20 </span>    , xComponent , yComponent , zComponent
-<span class="lineno">   21 </span>    , point
-<span class="lineno">   22 </span>    , vector
-<span class="lineno">   23 </span>    , nearV
-<span class="lineno">   24 </span>    , point_to_vector
-<span class="lineno">   25 </span>    , vector_to_point
-<span class="lineno">   26 </span>    , dot
-<span class="lineno">   27 </span>    , cross
-<span class="lineno">   28 </span>    , tangents
-<span class="lineno">   29 </span>    , addVV
-<span class="lineno">   30 </span>    , addPV
-<span class="lineno">   31 </span>    , subVV
-<span class="lineno">   32 </span>    , negV
-<span class="lineno">   33 </span>    , subPP
-<span class="lineno">   34 </span>    , norm
-<span class="lineno">   35 </span>    , normalize
-<span class="lineno">   36 </span>    , dist2
-<span class="lineno">   37 </span>    , sq
-<span class="lineno">   38 </span>    , distFrom0Sq
-<span class="lineno">   39 </span>    , distFrom0
-<span class="lineno">   40 </span>    , multSV
-<span class="lineno">   41 </span>    , multMM
-<span class="lineno">   42 </span>    , transposeM
-<span class="lineno">   43 </span>    , multMV
-<span class="lineno">   44 </span>    , multMP
-<span class="lineno">   45 </span>    , multMQ
-<span class="lineno">   46 </span>    , multMR
-<span class="lineno">   47 </span>    , white
-<span class="lineno">   48 </span>    , black
-<span class="lineno">   49 </span>    , addCC
-<span class="lineno">   50 </span>    , subCC
-<span class="lineno">   51 </span>    , sumCC
-<span class="lineno">   52 </span>    , multCC
-<span class="lineno">   53 </span>    , multSC
-<span class="lineno">   54 </span>    , nearC
-<span class="lineno">   55 </span>    , offsetToPoint
-<span class="lineno">   56 </span>    , epsilon
-<span class="lineno">   57 </span>    , inf
-<span class="lineno">   58 </span>    , nonZero
-<span class="lineno">   59 </span>    , eqEps
-<span class="lineno">   60 </span>    , near
-<span class="lineno">   61 </span>    , clampf
-<span class="lineno">   62 </span>    ) where
-<span class="lineno">   63 </span>
-<span class="lineno">   64 </span>import List 
-<span class="lineno">   65 </span>
-<span class="lineno">   66 </span>type Coords = (Double,Double,Double)
-<span class="lineno">   67 </span>
-<span class="lineno">   68 </span>type Ray = (Point,Vector)    -- origin of ray, and unit vector giving direction
-<span class="lineno">   69 </span>
-<span class="lineno">   70 </span>data Point  = P !Double !Double !Double -- implicit extra arg of 1
-<span class="lineno">   71 </span>    deriving (Show)
-<span class="lineno">   72 </span>data Vector = V !Double !Double !Double -- implicit extra arg of 0
-<span class="lineno">   73 </span>    deriving (Show, Eq)
-<span class="lineno">   74 </span>data Matrix = M !Quad   !Quad   !Quad   !Quad
-<span class="lineno">   75 </span>    deriving (Show)
-<span class="lineno">   76 </span>
-<span class="lineno">   77 </span>data Color  = C !Double !Double !Double
-<span class="lineno">   78 </span>    deriving (Show, Eq)
-<span class="lineno">   79 </span>
-<span class="lineno">   80 </span>data Box = B !Double !Double !Double !Double !Double !Double
-<span class="lineno">   81 </span>    deriving (Show)
-<span class="lineno">   82 </span>
-<span class="lineno">   83 </span>data Quad   = Q !Double !Double !Double !Double
-<span class="lineno">   84 </span>    deriving (Show)
-<span class="lineno">   85 </span>
-<span class="lineno">   86 </span>type Radian = Double
-<span class="lineno">   87 </span>
-<span class="lineno">   88 </span>type Tup4 a = (a,a,a,a)
-<span class="lineno">   89 </span>
-<span class="lineno">   90 </span>--{-# INLINE matrix #-}
-<span class="lineno">   91 </span>matrix :: Tup4 (Tup4 Double) -&gt; Matrix
-<span class="lineno">   92 </span><span class="decl"><span class="istickedoff">matrix ((m11, m12, m13, m14),</span>
-<span class="lineno">   93 </span><span class="spaces">          </span><span class="istickedoff">(m21, m22, m23, m24),</span>
-<span class="lineno">   94 </span><span class="spaces">          </span><span class="istickedoff">(m31, m32, m33, m34),</span>
-<span class="lineno">   95 </span><span class="spaces">          </span><span class="istickedoff">(m41, m42, m43, m44))</span>
-<span class="lineno">   96 </span><span class="spaces">  </span><span class="istickedoff">= M (Q m11 m12 m13 m14)</span>
-<span class="lineno">   97 </span><span class="spaces">      </span><span class="istickedoff">(Q m21 m22 m23 m24)</span>
-<span class="lineno">   98 </span><span class="spaces">      </span><span class="istickedoff">(Q m31 m32 m33 m34)</span>
-<span class="lineno">   99 </span><span class="spaces">      </span><span class="istickedoff">(Q m41 m42 m43 m44)</span></span>
-<span class="lineno">  100 </span>
-<span class="lineno">  101 </span><span class="decl"><span class="nottickedoff">coord x y z = (x, y, z)</span></span>
-<span class="lineno">  102 </span>
-<span class="lineno">  103 </span><span class="decl"><span class="istickedoff">color r g b = C r g b</span></span>
-<span class="lineno">  104 </span>
-<span class="lineno">  105 </span><span class="decl"><span class="istickedoff">uncolor (C r g b) = (r,g,b)</span></span>
-<span class="lineno">  106 </span>
-<span class="lineno">  107 </span>{-# INLINE xCoord #-}
-<span class="lineno">  108 </span><span class="decl"><span class="istickedoff">xCoord (P x y z) = x</span></span>
-<span class="lineno">  109 </span>{-# INLINE yCoord #-}
-<span class="lineno">  110 </span><span class="decl"><span class="istickedoff">yCoord (P x y z) = y</span></span>
-<span class="lineno">  111 </span>{-# INLINE zCoord #-}
-<span class="lineno">  112 </span><span class="decl"><span class="istickedoff">zCoord (P x y z) = z</span></span>
-<span class="lineno">  113 </span>
-<span class="lineno">  114 </span>{-# INLINE xComponent #-}
-<span class="lineno">  115 </span><span class="decl"><span class="istickedoff">xComponent (V x y z) = x</span></span>
-<span class="lineno">  116 </span>{-# INLINE yComponent #-}
-<span class="lineno">  117 </span><span class="decl"><span class="istickedoff">yComponent (V x y z) = y</span></span>
-<span class="lineno">  118 </span>{-# INLINE zComponent #-}
-<span class="lineno">  119 </span><span class="decl"><span class="istickedoff">zComponent (V x y z) = z</span></span>
-<span class="lineno">  120 </span>
-<span class="lineno">  121 </span>point :: Double -&gt; Double -&gt; Double -&gt; Point
-<span class="lineno">  122 </span><span class="decl"><span class="istickedoff">point x y z = P x y z</span></span>
-<span class="lineno">  123 </span>
-<span class="lineno">  124 </span>vector :: Double -&gt; Double -&gt; Double -&gt; Vector
-<span class="lineno">  125 </span><span class="decl"><span class="istickedoff">vector x y z = V x y z</span></span>
-<span class="lineno">  126 </span>
-<span class="lineno">  127 </span>nearV :: Vector -&gt; Vector -&gt; Bool
-<span class="lineno">  128 </span><span class="decl"><span class="nottickedoff">nearV (V a b c) (V d e f) = a `near` d &amp;&amp; b `near` e &amp;&amp; c `near` f</span></span>
-<span class="lineno">  129 </span>
-<span class="lineno">  130 </span>point_to_vector :: Point -&gt; Vector
-<span class="lineno">  131 </span><span class="decl"><span class="nottickedoff">point_to_vector (P x y z) = V x y z</span></span>
-<span class="lineno">  132 </span>
-<span class="lineno">  133 </span>vector_to_point :: Vector -&gt; Point
-<span class="lineno">  134 </span><span class="decl"><span class="nottickedoff">vector_to_point (V x y z)  = P x y z</span></span> 
-<span class="lineno">  135 </span>
-<span class="lineno">  136 </span>{-# INLINE vector_to_quad #-}
-<span class="lineno">  137 </span>vector_to_quad :: Vector -&gt; Quad
-<span class="lineno">  138 </span><span class="decl"><span class="istickedoff">vector_to_quad (V x y z) = Q x y z 0</span></span>
-<span class="lineno">  139 </span>
-<span class="lineno">  140 </span>{-# INLINE point_to_quad #-}
-<span class="lineno">  141 </span>point_to_quad :: Point -&gt; Quad
-<span class="lineno">  142 </span><span class="decl"><span class="istickedoff">point_to_quad (P x y z) = Q x y z 1</span></span>
-<span class="lineno">  143 </span>
-<span class="lineno">  144 </span>{-# INLINE quad_to_point #-}
-<span class="lineno">  145 </span>quad_to_point :: Quad -&gt; Point
-<span class="lineno">  146 </span><span class="decl"><span class="istickedoff">quad_to_point (Q x y z _) = P x y z</span></span>
-<span class="lineno">  147 </span>
-<span class="lineno">  148 </span>{-# INLINE quad_to_vector #-}
-<span class="lineno">  149 </span>quad_to_vector :: Quad -&gt; Vector
-<span class="lineno">  150 </span><span class="decl"><span class="istickedoff">quad_to_vector (Q x y z _) = V x y z</span></span>
-<span class="lineno">  151 </span>
-<span class="lineno">  152 </span>--{-# INLINE dot #-}
-<span class="lineno">  153 </span>dot :: Vector -&gt; Vector -&gt; Double
-<span class="lineno">  154 </span><span class="decl"><span class="istickedoff">dot (V x1 y1 z1) (V x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2</span></span>
-<span class="lineno">  155 </span>
-<span class="lineno">  156 </span>cross :: Vector -&gt; Vector -&gt; Vector
-<span class="lineno">  157 </span><span class="decl"><span class="istickedoff">cross (V x1 y1 z1) (V x2 y2 z2)</span>
-<span class="lineno">  158 </span><span class="spaces">  </span><span class="istickedoff">= V (y1 * z2 - z1 * y2) (z1 * x2 - x1 * z2) (x1 * y2 - y1 * x2)</span></span>
-<span class="lineno">  159 </span>
-<span class="lineno">  160 </span>-- assumption: the input vector is a normal
-<span class="lineno">  161 </span>tangents :: Vector -&gt; (Vector, Vector)
-<span class="lineno">  162 </span><span class="decl"><span class="nottickedoff">tangents v@(V x y z)</span>
-<span class="lineno">  163 </span><span class="spaces">  </span><span class="nottickedoff">= (v1, v `cross` v1)</span>
-<span class="lineno">  164 </span><span class="spaces">  </span><span class="nottickedoff">where v1 | x == 0    = normalize (vector 0 z (-y))</span>
-<span class="lineno">  165 </span><span class="spaces">           </span><span class="nottickedoff">| otherwise = normalize (vector (-y) x 0)</span></span>
-<span class="lineno">  166 </span>
-<span class="lineno">  167 </span>{-# INLINE dot4 #-}
-<span class="lineno">  168 </span>dot4 :: Quad -&gt; Quad -&gt; Double
-<span class="lineno">  169 </span><span class="decl"><span class="istickedoff">dot4 (Q x1 y1 z1 w1) (Q x2 y2 z2 w2) = x1 * x2 + y1 * y2 + z1 * z2 + w1 * w2</span></span>
-<span class="lineno">  170 </span>
-<span class="lineno">  171 </span>addVV :: Vector -&gt; Vector -&gt; Vector
-<span class="lineno">  172 </span><span class="decl"><span class="nottickedoff">addVV (V x1 y1 z1) (V x2 y2 z2) </span>
-<span class="lineno">  173 </span><span class="spaces">    </span><span class="nottickedoff">= V (x1 + x2) (y1 + y2) (z1 + z2)</span></span>
-<span class="lineno">  174 </span>
-<span class="lineno">  175 </span>addPV :: Point -&gt; Vector -&gt; Point
-<span class="lineno">  176 </span><span class="decl"><span class="istickedoff">addPV (P x1 y1 z1) (V x2 y2 z2) </span>
-<span class="lineno">  177 </span><span class="spaces">    </span><span class="istickedoff">= P (x1 + x2) (y1 + y2) (z1 + z2)</span></span>
-<span class="lineno">  178 </span>
-<span class="lineno">  179 </span>subVV :: Vector -&gt; Vector -&gt; Vector
-<span class="lineno">  180 </span><span class="decl"><span class="istickedoff">subVV (V x1 y1 z1) (V x2 y2 z2) </span>
-<span class="lineno">  181 </span><span class="spaces">    </span><span class="istickedoff">= V (x1 - x2) (y1 - y2) (z1 - z2)</span></span>
-<span class="lineno">  182 </span>
-<span class="lineno">  183 </span>negV :: Vector -&gt; Vector
-<span class="lineno">  184 </span><span class="decl"><span class="nottickedoff">negV (V x1 y1 z1) </span>
-<span class="lineno">  185 </span><span class="spaces">    </span><span class="nottickedoff">= V (-x1) (-y1) (-z1)</span></span>
-<span class="lineno">  186 </span>
-<span class="lineno">  187 </span>subPP :: Point -&gt; Point -&gt; Vector
-<span class="lineno">  188 </span><span class="decl"><span class="nottickedoff">subPP (P x1 y1 z1) (P x2 y2 z2) </span>
-<span class="lineno">  189 </span><span class="spaces">    </span><span class="nottickedoff">= V (x1 - x2) (y1 - y2) (z1 - z2)</span></span>
-<span class="lineno">  190 </span>
-<span class="lineno">  191 </span>--{-# INLINE norm #-}
-<span class="lineno">  192 </span>norm :: Vector -&gt; Double
-<span class="lineno">  193 </span><span class="decl"><span class="nottickedoff">norm (V x y z) = sqrt (sq x + sq y + sq z)</span></span>
-<span class="lineno">  194 </span>
-<span class="lineno">  195 </span>--{-# INLINE normalize #-}
-<span class="lineno">  196 </span>-- normalize a vector to a unit vector
-<span class="lineno">  197 </span>normalize :: Vector -&gt; Vector
-<span class="lineno">  198 </span><span class="decl"><span class="istickedoff">normalize v@(V x y z)</span>
-<span class="lineno">  199 </span><span class="spaces">             </span><span class="istickedoff">| <span class="tickonlytrue">norm /= 0</span> = multSV (1/norm) v</span>
-<span class="lineno">  200 </span><span class="spaces">             </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">error &quot;normalize empty!&quot;</span></span>
-<span class="lineno">  201 </span><span class="spaces">    </span><span class="istickedoff">where norm = sqrt (sq x + sq y + sq z)</span></span>
-<span class="lineno">  202 </span>
-<span class="lineno">  203 </span>-- This does computes the distance *squared*
-<span class="lineno">  204 </span>dist2 :: Point -&gt; Point -&gt; Double
-<span class="lineno">  205 </span><span class="decl"><span class="nottickedoff">dist2 us vs = sq x + sq y + sq z</span>
-<span class="lineno">  206 </span><span class="spaces">    </span><span class="nottickedoff">where</span>
-<span class="lineno">  207 </span><span class="spaces">       </span><span class="nottickedoff">(V x y z) = subPP us vs</span></span>
-<span class="lineno">  208 </span>
-<span class="lineno">  209 </span>{-# INLINE sq #-}
-<span class="lineno">  210 </span>sq :: Double -&gt; Double
-<span class="lineno">  211 </span><span class="decl"><span class="istickedoff">sq d = d * d</span></span> 
-<span class="lineno">  212 </span>
-<span class="lineno">  213 </span>{-# INLINE distFrom0Sq #-}
-<span class="lineno">  214 </span>distFrom0Sq :: Point -&gt; Double  -- Distance of point from origin.
-<span class="lineno">  215 </span><span class="decl"><span class="nottickedoff">distFrom0Sq (P x y z) = sq x + sq y + sq z</span></span>
-<span class="lineno">  216 </span>
-<span class="lineno">  217 </span>{-# INLINE distFrom0 #-}
-<span class="lineno">  218 </span>distFrom0 :: Point -&gt; Double  -- Distance of point from origin.
-<span class="lineno">  219 </span><span class="decl"><span class="nottickedoff">distFrom0 p = sqrt (distFrom0Sq p)</span></span>
-<span class="lineno">  220 </span>
-<span class="lineno">  221 </span>--{-# INLINE multSV #-}
-<span class="lineno">  222 </span>multSV :: Double -&gt; Vector -&gt; Vector
-<span class="lineno">  223 </span><span class="decl"><span class="istickedoff">multSV k (V x y z) = V (k*x) (k*y) (k*z)</span></span>
-<span class="lineno">  224 </span>
-<span class="lineno">  225 </span>--{-# INLINE multMM #-}
-<span class="lineno">  226 </span>multMM :: Matrix -&gt; Matrix -&gt; Matrix
-<span class="lineno">  227 </span><span class="decl"><span class="istickedoff">multMM m1@(M q1 q2 q3 q4) m2</span>
-<span class="lineno">  228 </span><span class="spaces">     </span><span class="istickedoff">= M (multMQ m2' q1)</span>
-<span class="lineno">  229 </span><span class="spaces">         </span><span class="istickedoff">(multMQ m2' q2)</span>
-<span class="lineno">  230 </span><span class="spaces">         </span><span class="istickedoff">(multMQ m2' q3)</span>
-<span class="lineno">  231 </span><span class="spaces">         </span><span class="istickedoff">(multMQ m2' q4)</span>
-<span class="lineno">  232 </span><span class="spaces">  </span><span class="istickedoff">where</span>
-<span class="lineno">  233 </span><span class="spaces">     </span><span class="istickedoff">m2' = transposeM m2</span></span>
-<span class="lineno">  234 </span>
-<span class="lineno">  235 </span>{-# INLINE transposeM #-}     
-<span class="lineno">  236 </span>transposeM :: Matrix -&gt; Matrix
-<span class="lineno">  237 </span><span class="decl"><span class="istickedoff">transposeM (M (Q e11  e12  e13  e14)</span>
-<span class="lineno">  238 </span><span class="spaces">              </span><span class="istickedoff">(Q e21  e22  e23  e24)</span>
-<span class="lineno">  239 </span><span class="spaces">              </span><span class="istickedoff">(Q e31  e32  e33  e34)</span>
-<span class="lineno">  240 </span><span class="spaces">              </span><span class="istickedoff">(Q e41  e42  e43  e44)) = (M (Q e11  e21  e31  e41)</span>
-<span class="lineno">  241 </span><span class="spaces">                                           </span><span class="istickedoff">(Q e12  e22  e32  e42)</span>
-<span class="lineno">  242 </span><span class="spaces">                                           </span><span class="istickedoff">(Q e13  e23  e33  e43)</span>
-<span class="lineno">  243 </span><span class="spaces">                                           </span><span class="istickedoff">(Q e14  e24  e34  e44))</span></span>
-<span class="lineno">  244 </span>
-<span class="lineno">  245 </span>
-<span class="lineno">  246 </span>--multMM m1 m2 = [map (dot4 row) (transpose m2) | row &lt;- m1]
-<span class="lineno">  247 </span>
-<span class="lineno">  248 </span>--{-# INLINE multMV #-}
-<span class="lineno">  249 </span>multMV :: Matrix -&gt; Vector -&gt; Vector
-<span class="lineno">  250 </span><span class="decl"><span class="istickedoff">multMV m v = quad_to_vector (multMQ m (vector_to_quad v))</span></span>
-<span class="lineno">  251 </span>
-<span class="lineno">  252 </span>--{-# INLINE multMP #-}
-<span class="lineno">  253 </span>multMP :: Matrix -&gt; Point -&gt; Point
-<span class="lineno">  254 </span><span class="decl"><span class="istickedoff">multMP m p = quad_to_point (multMQ m (point_to_quad p))</span></span>
-<span class="lineno">  255 </span>
-<span class="lineno">  256 </span>-- mat vec = map (dot4 vec) mat
-<span class="lineno">  257 </span>
-<span class="lineno">  258 </span>{-# INLINE multMQ #-}
-<span class="lineno">  259 </span>multMQ :: Matrix -&gt; Quad -&gt; Quad
-<span class="lineno">  260 </span><span class="decl"><span class="istickedoff">multMQ (M q1 q2 q3 q4) q</span>
-<span class="lineno">  261 </span><span class="spaces">       </span><span class="istickedoff">= Q (dot4 q q1)</span>
-<span class="lineno">  262 </span><span class="spaces">           </span><span class="istickedoff">(dot4 q q2)</span>
-<span class="lineno">  263 </span><span class="spaces">           </span><span class="istickedoff">(dot4 q q3)</span>
-<span class="lineno">  264 </span><span class="spaces">           </span><span class="istickedoff">(dot4 q q4)</span></span>
-<span class="lineno">  265 </span>
-<span class="lineno">  266 </span>{-# INLINE multMR #-}
-<span class="lineno">  267 </span>multMR :: Matrix -&gt; Ray -&gt; Ray
-<span class="lineno">  268 </span><span class="decl"><span class="istickedoff">multMR m (r, v) = (multMP m r, multMV m v)</span></span>
-<span class="lineno">  269 </span>
-<span class="lineno">  270 </span>white :: Color
-<span class="lineno">  271 </span><span class="decl"><span class="nottickedoff">white = C 1 1 1</span></span>
-<span class="lineno">  272 </span>black :: Color
-<span class="lineno">  273 </span><span class="decl"><span class="istickedoff">black = C 0 0 0</span></span>
-<span class="lineno">  274 </span>
-<span class="lineno">  275 </span>addCC :: Color -&gt; Color -&gt; Color
-<span class="lineno">  276 </span><span class="decl"><span class="istickedoff">addCC (C a b c) (C d e f) = C (a+d) (b+e) (c+f)</span></span>
-<span class="lineno">  277 </span>
-<span class="lineno">  278 </span>subCC :: Color -&gt; Color -&gt; Color
-<span class="lineno">  279 </span><span class="decl"><span class="nottickedoff">subCC (C a b c) (C d e f) = C (a-d) (b-e) (c-f)</span></span>
-<span class="lineno">  280 </span>
-<span class="lineno">  281 </span>sumCC :: [Color] -&gt; Color
-<span class="lineno">  282 </span><span class="decl"><span class="istickedoff">sumCC = foldr addCC black</span></span>
-<span class="lineno">  283 </span>
-<span class="lineno">  284 </span>multCC :: Color -&gt; Color -&gt; Color
-<span class="lineno">  285 </span><span class="decl"><span class="istickedoff">multCC (C a b c) (C d e f) = C (a*d) (b*e) (c*f)</span></span>
-<span class="lineno">  286 </span>
-<span class="lineno">  287 </span>multSC :: Double -&gt; Color -&gt; Color
-<span class="lineno">  288 </span><span class="decl"><span class="istickedoff">multSC k       (C a b c) = C (a*k) (b*k) (c*k)</span></span>
-<span class="lineno">  289 </span>
-<span class="lineno">  290 </span>nearC :: Color -&gt; Color -&gt; Bool
-<span class="lineno">  291 </span><span class="decl"><span class="istickedoff">nearC (C a b c) (C d e f) = a `near` d &amp;&amp; b `near` e &amp;&amp; c `near` f</span></span>
-<span class="lineno">  292 </span>
-<span class="lineno">  293 </span>offsetToPoint :: Ray -&gt; Double -&gt; Point
-<span class="lineno">  294 </span><span class="decl"><span class="istickedoff">offsetToPoint (r,v) i = r `addPV` (i `multSV` v)</span></span>
-<span class="lineno">  295 </span>
-<span class="lineno">  296 </span>--
-<span class="lineno">  297 </span>
-<span class="lineno">  298 </span>epsilon, inf :: Double      -- aproximate zero and infinity
-<span class="lineno">  299 </span><span class="decl"><span class="istickedoff">epsilon = 1.0e-10</span></span>
-<span class="lineno">  300 </span><span class="decl"><span class="istickedoff">inf = 1.0e20</span></span>
-<span class="lineno">  301 </span>
-<span class="lineno">  302 </span>nonZero :: Double -&gt; Double         -- Use before a division. It makes definitions
-<span class="lineno">  303 </span><span class="decl"><span class="istickedoff">nonZero x | <span class="tickonlytrue">x &gt; epsilon</span>  = x        -- more complete and I bet the errors that get </span>
-<span class="lineno">  304 </span><span class="spaces">          </span><span class="istickedoff">| <span class="nottickedoff">x &lt; -epsilon</span> = <span class="nottickedoff">x</span>        -- introduced will be undetectable if epsilon</span>
-<span class="lineno">  305 </span><span class="spaces">          </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span>    = <span class="nottickedoff">epsilon</span></span></span>  -- is small enough
-<span class="lineno">  306 </span>
-<span class="lineno">  307 </span>
-<span class="lineno">  308 </span><span class="decl"><span class="istickedoff">eqEps x y = abs (x-y) &lt; epsilon</span></span>
-<span class="lineno">  309 </span><span class="decl"><span class="istickedoff">near = eqEps</span></span>
-<span class="lineno">  310 </span>
-<span class="lineno">  311 </span>clampf :: Double -&gt; Double
-<span class="lineno">  312 </span><span class="decl"><span class="istickedoff">clampf p | <span class="tickonlyfalse">p &lt; 0</span> = <span class="nottickedoff">0</span></span>
-<span class="lineno">  313 </span><span class="spaces">         </span><span class="istickedoff">| p &gt; 1 = 1</span>
-<span class="lineno">  314 </span><span class="spaces">         </span><span class="istickedoff">| <span class="tickonlytrue">True</span>  = p</span></span>
-
-</pre>
-</html>
-Writing: CSG.hs.html
-<html><style type="text/css">
-span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
-span.nottickedoff { background: yellow}
-span.istickedoff { background: white }
-span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
-span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
-span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
-span.decl { font-weight: bold }
-span.spaces    { background: white }
-</style>
-<pre>
-<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
-<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
-<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
-<span class="lineno">    4 </span>-- which is included in the distribution.
-<span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module CSG(module Construct,
-<span class="lineno">    7 </span>           module Geometry,
-<span class="lineno">    8 </span>           module Intersections,
-<span class="lineno">    9 </span>           module Interval,
-<span class="lineno">   10 </span>           module Misc) where
-<span class="lineno">   11 </span>
-<span class="lineno">   12 </span>import Construct
-<span class="lineno">   13 </span>import Geometry
-<span class="lineno">   14 </span>import Intersections
-<span class="lineno">   15 </span>import Interval
-<span class="lineno">   16 </span>import Misc
-
-</pre>
-</html>
-Writing: Construct.hs.html
-<html><style type="text/css">
-span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
-span.nottickedoff { background: yellow}
-span.istickedoff { background: white }
-span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
-span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
-span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
-span.decl { font-weight: bold }
-span.spaces    { background: white }
-</style>
-<pre>
-<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
-<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
-<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
-<span class="lineno">    4 </span>-- which is included in the distribution.
-<span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module Construct
-<span class="lineno">    7 </span>    ( Surface (..)
-<span class="lineno">    8 </span>    , Face (..)
-<span class="lineno">    9 </span>    , CSG (..)
-<span class="lineno">   10 </span>    , Texture
-<span class="lineno">   11 </span>    , Transform
-<span class="lineno">   12 </span>    , union, intersect, difference
-<span class="lineno">   13 </span>    , plane, sphere, cube, cylinder, cone
-<span class="lineno">   14 </span>    , transform
-<span class="lineno">   15 </span>    , translate, translateX, translateY, translateZ
-<span class="lineno">   16 </span>    , scale, scaleX, scaleY, scaleZ, uscale
-<span class="lineno">   17 </span>    , rotateX, rotateY, rotateZ
-<span class="lineno">   18 </span>    , eye, translateEye
-<span class="lineno">   19 </span>    , rotateEyeX, rotateEyeY, rotateEyeZ
-<span class="lineno">   20 </span>    ) where
-<span class="lineno">   21 </span>
-<span class="lineno">   22 </span>import Geometry
-<span class="lineno">   23 </span>
-<span class="lineno">   24 </span>-- In each case, we model the surface by a point and a pair of tangent vectors.
-<span class="lineno">   25 </span>-- This gives us enough information to determine the surface
-<span class="lineno">   26 </span>-- normal at that point, which is all that is required by the current
-<span class="lineno">   27 </span>-- illumination model.  We can't just save the surface normal because
-<span class="lineno">   28 </span>-- that isn't preserved by transformations.
-<span class="lineno">   29 </span>
-<span class="lineno">   30 </span>data Surface
-<span class="lineno">   31 </span>  = Planar Point Vector Vector
-<span class="lineno">   32 </span>  | Spherical Point Vector Vector
-<span class="lineno">   33 </span>  | Cylindrical Point Vector Vector
-<span class="lineno">   34 </span>  | Conic Point Vector Vector
-<span class="lineno">   35 </span>  deriving Show
-<span class="lineno">   36 </span>
-<span class="lineno">   37 </span>data Face
-<span class="lineno">   38 </span>  = PlaneFace
-<span class="lineno">   39 </span>  | SphereFace
-<span class="lineno">   40 </span>  | CubeFront
-<span class="lineno">   41 </span>  | CubeBack
-<span class="lineno">   42 </span>  | CubeLeft
-<span class="lineno">   43 </span>  | CubeRight
-<span class="lineno">   44 </span>  | CubeTop
-<span class="lineno">   45 </span>  | CubeBottom
-<span class="lineno">   46 </span>  | CylinderSide
-<span class="lineno">   47 </span>  | CylinderTop
-<span class="lineno">   48 </span>  | CylinderBottom
-<span class="lineno">   49 </span>  | ConeSide
-<span class="lineno">   50 </span>  | ConeBase
-<span class="lineno">   51 </span>  deriving Show
-<span class="lineno">   52 </span>
-<span class="lineno">   53 </span>data CSG a
-<span class="lineno">   54 </span>  = Plane a
-<span class="lineno">   55 </span>  | Sphere a
-<span class="lineno">   56 </span>  | Cylinder a
-<span class="lineno">   57 </span>  | Cube a
-<span class="lineno">   58 </span>  | Cone a
-<span class="lineno">   59 </span>  | Transform Matrix Matrix (CSG a)
-<span class="lineno">   60 </span>  | Union (CSG a) (CSG a)
-<span class="lineno">   61 </span>  | Intersect (CSG a) (CSG a)
-<span class="lineno">   62 </span>  | Difference (CSG a) (CSG a)
-<span class="lineno">   63 </span>  | Box Box (CSG a)
-<span class="lineno">   64 </span>  deriving (Show)
-<span class="lineno">   65 </span>
-<span class="lineno">   66 </span>-- the data returned for determining surface texture
-<span class="lineno">   67 </span>-- the Face tells which face of a primitive this is
-<span class="lineno">   68 </span>-- the Point is the point of intersection in object coordinates
-<span class="lineno">   69 </span>-- the a is application-specific texture information
-<span class="lineno">   70 </span>type Texture a = (Face, Point, a)
-<span class="lineno">   71 </span>
-<span class="lineno">   72 </span>union, intersect, difference       :: CSG a -&gt; CSG a -&gt; CSG a
-<span class="lineno">   73 </span>
-<span class="lineno">   74 </span><span class="decl"><span class="istickedoff">union p@(Box b1 _) q@(Box b2 _) = <span class="nottickedoff">Box (mergeBox b1 b2) (Union p q)</span></span>
-<span class="lineno">   75 </span><span class="spaces"></span><span class="istickedoff">union p q = Union p q</span></span>
-<span class="lineno">   76 </span>
-<span class="lineno">   77 </span>-- rather pessimistic
-<span class="lineno">   78 </span><span class="decl"><span class="nottickedoff">intersect p@(Box b1 _) q@(Box b2 _) = Box (mergeBox b1 b2) (Intersect p q)</span>
-<span class="lineno">   79 </span><span class="spaces"></span><span class="nottickedoff">intersect p q = Intersect p q</span></span>
-<span class="lineno">   80 </span>
-<span class="lineno">   81 </span><span class="decl"><span class="nottickedoff">difference (Box b1 p) q = Box b1 (Difference p q)</span>
-<span class="lineno">   82 </span><span class="spaces"></span><span class="nottickedoff">-- no need to box again inside</span>
-<span class="lineno">   83 </span><span class="spaces"></span><span class="nottickedoff">-- difference p@(Box b1 _) q = Box b1 (Difference p q)</span>
-<span class="lineno">   84 </span><span class="spaces"></span><span class="nottickedoff">difference p q = Difference p q</span></span>
-<span class="lineno">   85 </span>
-<span class="lineno">   86 </span><span class="decl"><span class="istickedoff">mkBox b p = Box b p</span></span>
-<span class="lineno">   87 </span>
-<span class="lineno">   88 </span>plane, sphere, cube, cylinder, cone     :: a -&gt; CSG a
-<span class="lineno">   89 </span>
-<span class="lineno">   90 </span><span class="decl"><span class="istickedoff">plane = Plane</span></span>
-<span class="lineno">   91 </span><span class="decl"><span class="nottickedoff">sphere s =</span>
-<span class="lineno">   92 </span><span class="spaces">    </span><span class="nottickedoff">mkBox (B (-1 - epsilon) (1 + epsilon)</span>
-<span class="lineno">   93 </span><span class="spaces">             </span><span class="nottickedoff">(-1 - epsilon) (1 + epsilon)</span>
-<span class="lineno">   94 </span><span class="spaces">             </span><span class="nottickedoff">(-1 - epsilon) (1 + epsilon)) (Sphere s)</span></span>
-<span class="lineno">   95 </span><span class="decl"><span class="nottickedoff">cone s =</span>
-<span class="lineno">   96 </span><span class="spaces">    </span><span class="nottickedoff">mkBox (B (-1 - epsilon) (1 + epsilon)</span>
-<span class="lineno">   97 </span><span class="spaces">             </span><span class="nottickedoff">(   - epsilon) (1 + epsilon)</span>
-<span class="lineno">   98 </span><span class="spaces">             </span><span class="nottickedoff">(-1 - epsilon) (1 + epsilon)) (Cone s)</span></span>
-<span class="lineno">   99 </span><span class="decl"><span class="istickedoff">cube s =</span>
-<span class="lineno">  100 </span><span class="spaces">    </span><span class="istickedoff">mkBox (B (- epsilon) (1 + epsilon)</span>
-<span class="lineno">  101 </span><span class="spaces">             </span><span class="istickedoff">(- epsilon) (1 + epsilon)</span>
-<span class="lineno">  102 </span><span class="spaces">             </span><span class="istickedoff">(- epsilon) (1 + epsilon)) (Cube s)</span></span>
-<span class="lineno">  103 </span><span class="decl"><span class="nottickedoff">cylinder s =</span>
-<span class="lineno">  104 </span><span class="spaces">    </span><span class="nottickedoff">mkBox (B (-1 - epsilon) (1 + epsilon)</span>
-<span class="lineno">  105 </span><span class="spaces">             </span><span class="nottickedoff">(   - epsilon) (1 + epsilon)</span>
-<span class="lineno">  106 </span><span class="spaces">             </span><span class="nottickedoff">(-1 - epsilon) (1 + epsilon)) (Cylinder s)</span></span>
-<span class="lineno">  107 </span>
-<span class="lineno">  108 </span>----------------------------
-<span class="lineno">  109 </span>-- Object transformations
-<span class="lineno">  110 </span>----------------------------
-<span class="lineno">  111 </span>
-<span class="lineno">  112 </span>type Transform = (Matrix, Matrix)
-<span class="lineno">  113 </span>
-<span class="lineno">  114 </span>transform :: Transform -&gt; CSG a -&gt; CSG a
-<span class="lineno">  115 </span>
-<span class="lineno">  116 </span><span class="decl"><span class="istickedoff">transform (m, m')   (Transform mp mp' p) = Transform  (multMM m mp)       (multMM mp' m') p</span>
-<span class="lineno">  117 </span><span class="spaces"></span><span class="istickedoff">transform mm'       (Union p q)          = Union      (transform mm' p)   (transform mm' q)</span>
-<span class="lineno">  118 </span><span class="spaces"></span><span class="istickedoff">transform mm'       (Intersect p q)      = <span class="nottickedoff">Intersect  (transform mm' p)   (transform mm' q)</span></span>
-<span class="lineno">  119 </span><span class="spaces"></span><span class="istickedoff">transform mm'       (Difference p q)     = <span class="nottickedoff">Difference (transform mm' p)   (transform mm' q)</span></span>
-<span class="lineno">  120 </span><span class="spaces"></span><span class="istickedoff">transform mm'@(m,_) (Box box p)          = Box        (transformBox m box) (transform mm' p)</span>
-<span class="lineno">  121 </span><span class="spaces"></span><span class="istickedoff">transform (m, m')   prim                 = Transform  m m' prim</span></span>
-<span class="lineno">  122 </span>
-<span class="lineno">  123 </span>translate                      :: Coords -&gt; CSG a -&gt; CSG a
-<span class="lineno">  124 </span>translateX, translateY, translateZ      :: Double -&gt; CSG a -&gt; CSG a
-<span class="lineno">  125 </span>
-<span class="lineno">  126 </span><span class="decl"><span class="istickedoff">translate xyz = transform $ transM xyz</span></span>
-<span class="lineno">  127 </span><span class="decl"><span class="nottickedoff">translateX x = translate (x, 0, 0)</span></span>
-<span class="lineno">  128 </span><span class="decl"><span class="nottickedoff">translateY y = translate (0, y, 0)</span></span>
-<span class="lineno">  129 </span><span class="decl"><span class="nottickedoff">translateZ z = translate (0, 0, z)</span></span>
-<span class="lineno">  130 </span>
-<span class="lineno">  131 </span>scale                    :: Coords -&gt; CSG a -&gt; CSG a
-<span class="lineno">  132 </span>scaleX, scaleY, scaleZ, uscale   :: Double -&gt; CSG a -&gt; CSG a
-<span class="lineno">  133 </span>
-<span class="lineno">  134 </span><span class="decl"><span class="istickedoff">scale xyz = transform $ scaleM xyz</span></span>
-<span class="lineno">  135 </span><span class="decl"><span class="nottickedoff">scaleX x = scale (x, 1, 1)</span></span>
-<span class="lineno">  136 </span><span class="decl"><span class="nottickedoff">scaleY y = scale (1, y, 1)</span></span>
-<span class="lineno">  137 </span><span class="decl"><span class="nottickedoff">scaleZ z = scale (1, 1, z)</span></span>
-<span class="lineno">  138 </span><span class="decl"><span class="istickedoff">uscale u = scale (u,u,u)</span></span>
-<span class="lineno">  139 </span>
-<span class="lineno">  140 </span>rotateX, rotateY, rotateZ             :: Radian -&gt; CSG a -&gt; CSG a
-<span class="lineno">  141 </span>
-<span class="lineno">  142 </span><span class="decl"><span class="istickedoff">rotateX a = transform $ rotxM a</span></span>
-<span class="lineno">  143 </span><span class="decl"><span class="istickedoff">rotateY a = transform $ rotyM a</span></span>
-<span class="lineno">  144 </span><span class="decl"><span class="nottickedoff">rotateZ a = transform $ rotzM a</span></span>
-<span class="lineno">  145 </span>
-<span class="lineno">  146 </span><span class="decl"><span class="istickedoff">unit = matrix</span>
-<span class="lineno">  147 </span><span class="spaces">      </span><span class="istickedoff">( ( 1.0, 0.0, 0.0, 0.0 ),</span>
-<span class="lineno">  148 </span><span class="spaces">        </span><span class="istickedoff">( 0.0, 1.0, 0.0, 0.0 ),</span>
-<span class="lineno">  149 </span><span class="spaces">        </span><span class="istickedoff">( 0.0, 0.0, 1.0, 0.0 ),</span>
-<span class="lineno">  150 </span><span class="spaces">        </span><span class="istickedoff">( 0.0, 0.0, 0.0, 1.0 ) )</span></span>
-<span class="lineno">  151 </span>
-<span class="lineno">  152 </span><span class="decl"><span class="istickedoff">transM (x, y, z)</span>
-<span class="lineno">  153 </span><span class="spaces">  </span><span class="istickedoff">= ( matrix</span>
-<span class="lineno">  154 </span><span class="spaces">      </span><span class="istickedoff">( ( 1, 0, 0, x ),</span>
-<span class="lineno">  155 </span><span class="spaces">        </span><span class="istickedoff">( 0, 1, 0, y ),</span>
-<span class="lineno">  156 </span><span class="spaces">        </span><span class="istickedoff">( 0, 0, 1, z ),</span>
-<span class="lineno">  157 </span><span class="spaces">        </span><span class="istickedoff">( 0, 0, 0, 1 ) ),</span>
-<span class="lineno">  158 </span><span class="spaces">      </span><span class="istickedoff">matrix</span>
-<span class="lineno">  159 </span><span class="spaces">      </span><span class="istickedoff">( ( 1, 0, 0, -x ),</span>
-<span class="lineno">  160 </span><span class="spaces">        </span><span class="istickedoff">( 0, 1, 0, -y ),</span>
-<span class="lineno">  161 </span><span class="spaces">        </span><span class="istickedoff">( 0, 0, 1, -z ),</span>
-<span class="lineno">  162 </span><span class="spaces">        </span><span class="istickedoff">( 0, 0, 0,  1 ) ) )</span></span>
-<span class="lineno">  163 </span>
-<span class="lineno">  164 </span><span class="decl"><span class="istickedoff">scaleM (x, y, z)</span>
-<span class="lineno">  165 </span><span class="spaces">  </span><span class="istickedoff">= ( matrix</span>
-<span class="lineno">  166 </span><span class="spaces">      </span><span class="istickedoff">( (   x',    0,    0, 0 ),</span>
-<span class="lineno">  167 </span><span class="spaces">        </span><span class="istickedoff">(    0,   y',    0, 0 ),</span>
-<span class="lineno">  168 </span><span class="spaces">        </span><span class="istickedoff">(    0,    0,   z', 0 ),</span>
-<span class="lineno">  169 </span><span class="spaces">        </span><span class="istickedoff">(    0,    0,    0, 1 ) ),</span>
-<span class="lineno">  170 </span><span class="spaces">      </span><span class="istickedoff">matrix</span>
-<span class="lineno">  171 </span><span class="spaces">      </span><span class="istickedoff">( ( 1/x',    0,    0, 0 ),</span>
-<span class="lineno">  172 </span><span class="spaces">        </span><span class="istickedoff">(    0, 1/y',    0, 0 ),</span>
-<span class="lineno">  173 </span><span class="spaces">        </span><span class="istickedoff">(    0,    0, 1/z', 0 ),</span>
-<span class="lineno">  174 </span><span class="spaces">        </span><span class="istickedoff">(    0,    0,    0, 1 ) ) )</span>
-<span class="lineno">  175 </span><span class="spaces">  </span><span class="istickedoff">where x' = nonZero x</span>
-<span class="lineno">  176 </span><span class="spaces">        </span><span class="istickedoff">y' = nonZero y</span>
-<span class="lineno">  177 </span><span class="spaces">        </span><span class="istickedoff">z' = nonZero z</span></span>
-<span class="lineno">  178 </span>
-<span class="lineno">  179 </span><span class="decl"><span class="istickedoff">rotxM t</span>
-<span class="lineno">  180 </span><span class="spaces">  </span><span class="istickedoff">= ( matrix</span>
-<span class="lineno">  181 </span><span class="spaces">      </span><span class="istickedoff">( (      1,      0,      0, 0 ),</span>
-<span class="lineno">  182 </span><span class="spaces">        </span><span class="istickedoff">(      0,  cos t, -sin t, 0 ),</span>
-<span class="lineno">  183 </span><span class="spaces">        </span><span class="istickedoff">(      0,  sin t,  cos t, 0 ),</span>
-<span class="lineno">  184 </span><span class="spaces">        </span><span class="istickedoff">(      0,      0,      0, 1 ) ),</span>
-<span class="lineno">  185 </span><span class="spaces">      </span><span class="istickedoff">matrix</span>
-<span class="lineno">  186 </span><span class="spaces">      </span><span class="istickedoff">( (      1,      0,      0, 0 ),</span>
-<span class="lineno">  187 </span><span class="spaces">        </span><span class="istickedoff">(      0,  cos t,  sin t, 0 ),</span>
-<span class="lineno">  188 </span><span class="spaces">        </span><span class="istickedoff">(      0, -sin t,  cos t, 0 ),</span>
-<span class="lineno">  189 </span><span class="spaces">        </span><span class="istickedoff">(      0,      0,      0, 1 ) ) )</span></span>
-<span class="lineno">  190 </span>
-<span class="lineno">  191 </span><span class="decl"><span class="istickedoff">rotyM t</span>
-<span class="lineno">  192 </span><span class="spaces">  </span><span class="istickedoff">= ( matrix</span>
-<span class="lineno">  193 </span><span class="spaces">      </span><span class="istickedoff">( (  cos t,      0,  sin t, 0 ),</span>
-<span class="lineno">  194 </span><span class="spaces">        </span><span class="istickedoff">(      0,      1,      0, 0 ),</span>
-<span class="lineno">  195 </span><span class="spaces">        </span><span class="istickedoff">( -sin t,      0,  cos t, 0 ),</span>
-<span class="lineno">  196 </span><span class="spaces">        </span><span class="istickedoff">(      0,      0,      0, 1 ) ),</span>
-<span class="lineno">  197 </span><span class="spaces">      </span><span class="istickedoff">matrix</span>
-<span class="lineno">  198 </span><span class="spaces">      </span><span class="istickedoff">( (  cos t,      0, -sin t, 0 ),</span>
-<span class="lineno">  199 </span><span class="spaces">        </span><span class="istickedoff">(      0,      1,      0, 0 ),</span>
-<span class="lineno">  200 </span><span class="spaces">        </span><span class="istickedoff">(  sin t,      0,  cos t, 0 ),</span>
-<span class="lineno">  201 </span><span class="spaces">        </span><span class="istickedoff">(      0,      0,      0, 1 ) ) )</span></span>
-<span class="lineno">  202 </span>
-<span class="lineno">  203 </span><span class="decl"><span class="nottickedoff">rotzM t</span>
-<span class="lineno">  204 </span><span class="spaces">  </span><span class="nottickedoff">= ( matrix</span>
-<span class="lineno">  205 </span><span class="spaces">      </span><span class="nottickedoff">( (  cos t, -sin t,      0, 0 ),</span>
-<span class="lineno">  206 </span><span class="spaces">        </span><span class="nottickedoff">(  sin t,  cos t,      0, 0 ),</span>
-<span class="lineno">  207 </span><span class="spaces">        </span><span class="nottickedoff">(      0,      0,      1, 0 ),</span>
-<span class="lineno">  208 </span><span class="spaces">        </span><span class="nottickedoff">(      0,      0,      0, 1 ) ),</span>
-<span class="lineno">  209 </span><span class="spaces">      </span><span class="nottickedoff">matrix</span>
-<span class="lineno">  210 </span><span class="spaces">      </span><span class="nottickedoff">( (  cos t,  sin t,      0, 0 ),</span>
-<span class="lineno">  211 </span><span class="spaces">        </span><span class="nottickedoff">( -sin t,  cos t,      0, 0 ),</span>
-<span class="lineno">  212 </span><span class="spaces">        </span><span class="nottickedoff">(      0,      0,      1, 0 ),</span>
-<span class="lineno">  213 </span><span class="spaces">        </span><span class="nottickedoff">(      0,      0,      0, 1 ) ) )</span></span>
-<span class="lineno">  214 </span>
-<span class="lineno">  215 </span>-------------------
-<span class="lineno">  216 </span>-- Eye transformations
-<span class="lineno">  217 </span>
-<span class="lineno">  218 </span>-- These are used to specify placement of the eye.
-<span class="lineno">  219 </span>-- `eye' starts out at (0, 0, -1).
-<span class="lineno">  220 </span>-- These are implemented as inverse transforms of the model.
-<span class="lineno">  221 </span>-------------------
-<span class="lineno">  222 </span>
-<span class="lineno">  223 </span>eye                       :: Transform
-<span class="lineno">  224 </span>translateEye          :: Coords -&gt; Transform -&gt; Transform
-<span class="lineno">  225 </span>rotateEyeX, rotateEyeY, rotateEyeZ      :: Radian -&gt; Transform -&gt; Transform
-<span class="lineno">  226 </span>
-<span class="lineno">  227 </span><span class="decl"><span class="istickedoff">eye = (unit, unit)</span></span>
-<span class="lineno">  228 </span><span class="decl"><span class="nottickedoff">translateEye xyz (eye1, eye2)</span>
-<span class="lineno">  229 </span><span class="spaces">  </span><span class="nottickedoff">= (multMM m1 eye1, multMM eye2 m2)</span>
-<span class="lineno">  230 </span><span class="spaces">  </span><span class="nottickedoff">where (m1, m2) = transM xyz</span></span>
-<span class="lineno">  231 </span><span class="decl"><span class="nottickedoff">rotateEyeX t (eye1, eye2)</span>
-<span class="lineno">  232 </span><span class="spaces">  </span><span class="nottickedoff">= (multMM m1 eye1, multMM eye2 m2)</span>
-<span class="lineno">  233 </span><span class="spaces">  </span><span class="nottickedoff">where (m1, m2) = rotxM t</span></span>
-<span class="lineno">  234 </span><span class="decl"><span class="nottickedoff">rotateEyeY t (eye1, eye2)</span>
-<span class="lineno">  235 </span><span class="spaces">  </span><span class="nottickedoff">= (multMM m1 eye1, multMM eye2 m2)</span>
-<span class="lineno">  236 </span><span class="spaces">  </span><span class="nottickedoff">where (m1, m2) = rotyM t</span></span>
-<span class="lineno">  237 </span><span class="decl"><span class="nottickedoff">rotateEyeZ t (eye1, eye2)</span>
-<span class="lineno">  238 </span><span class="spaces">  </span><span class="nottickedoff">= (multMM m1 eye1, multMM eye2 m2)</span>
-<span class="lineno">  239 </span><span class="spaces">  </span><span class="nottickedoff">where (m1, m2) = rotzM t</span></span>
-<span class="lineno">  240 </span>
-<span class="lineno">  241 </span>-------------------
-<span class="lineno">  242 </span>-- Bounding boxes
-<span class="lineno">  243 </span>-------------------
-<span class="lineno">  244 </span>
-<span class="lineno">  245 </span><span class="decl"><span class="nottickedoff">mergeBox (B x11  x12  y11  y12  z11  z12) (B x21  x22  y21  y22  z21  z22) =</span>
-<span class="lineno">  246 </span><span class="spaces">    </span><span class="nottickedoff">B (x11 `min` x21) (x12 `max` x22)</span>
-<span class="lineno">  247 </span><span class="spaces">      </span><span class="nottickedoff">(y11 `min` y21) (y12 `max` y22)</span>
-<span class="lineno">  248 </span><span class="spaces">      </span><span class="nottickedoff">(z11 `min` z21) (z12 `max` z22)</span></span>
-<span class="lineno">  249 </span>
-<span class="lineno">  250 </span><span class="decl"><span class="istickedoff">transformBox t (B x1  x2  y1  y2  z1  z2)</span>
-<span class="lineno">  251 </span><span class="spaces">  </span><span class="istickedoff">= (B (foldr1 min (map xCoord pts'))</span>
-<span class="lineno">  252 </span><span class="spaces">       </span><span class="istickedoff">(foldr1 max (map xCoord pts'))</span>
-<span class="lineno">  253 </span><span class="spaces">       </span><span class="istickedoff">(foldr1 min (map yCoord pts'))</span>
-<span class="lineno">  254 </span><span class="spaces">       </span><span class="istickedoff">(foldr1 max (map yCoord pts'))</span>
-<span class="lineno">  255 </span><span class="spaces">       </span><span class="istickedoff">(foldr1 min (map zCoord pts'))</span>
-<span class="lineno">  256 </span><span class="spaces">       </span><span class="istickedoff">(foldr1 max (map zCoord pts')))</span>
-<span class="lineno">  257 </span><span class="spaces">  </span><span class="istickedoff">where pts' = map (multMP t) pts</span>
-<span class="lineno">  258 </span><span class="spaces">        </span><span class="istickedoff">pts =  [point x1 y1 z1,</span>
-<span class="lineno">  259 </span><span class="spaces">                </span><span class="istickedoff">point x1 y1 z2,</span>
-<span class="lineno">  260 </span><span class="spaces">                </span><span class="istickedoff">point x1 y2 z1,</span>
-<span class="lineno">  261 </span><span class="spaces">                </span><span class="istickedoff">point x1 y2 z2,</span>
-<span class="lineno">  262 </span><span class="spaces">                </span><span class="istickedoff">point x2 y1 z1,</span>
-<span class="lineno">  263 </span><span class="spaces">                </span><span class="istickedoff">point x2 y1 z2,</span>
-<span class="lineno">  264 </span><span class="spaces">                </span><span class="istickedoff">point x2 y2 z1,</span>
-<span class="lineno">  265 </span><span class="spaces">                </span><span class="istickedoff">point x2 y2 z2]</span></span>
-
-</pre>
-</html>
-Writing: Intersections.hs.html
-<html><style type="text/css">
-span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
-span.nottickedoff { background: yellow}
-span.istickedoff { background: white }
-span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
-span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
-span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
-span.decl { font-weight: bold }
-span.spaces    { background: white }
-</style>
-<pre>
-<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
-<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
-<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
-<span class="lineno">    4 </span>-- which is included in the distribution.
-<span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module Intersections 
-<span class="lineno">    7 </span>    ( intersectRayWithObject,
-<span class="lineno">    8 </span>      quadratic
-<span class="lineno">    9 </span>    ) where
-<span class="lineno">   10 </span>
-<span class="lineno">   11 </span>import Maybe(isJust)
-<span class="lineno">   12 </span>
-<span class="lineno">   13 </span>import Construct
-<span class="lineno">   14 </span>import Geometry
-<span class="lineno">   15 </span>import Interval
-<span class="lineno">   16 </span>import Misc
-<span class="lineno">   17 </span>
-<span class="lineno">   18 </span>-- This is factored into two bits.  The main function `intersections'
-<span class="lineno">   19 </span>-- intersects a line with an object.
-<span class="lineno">   20 </span>-- The wrapper call `intersectRayWithObject' coerces this to an intersection
-<span class="lineno">   21 </span>-- with a ray by clamping the result to start at 0.
-<span class="lineno">   22 </span>
-<span class="lineno">   23 </span><span class="decl"><span class="istickedoff">intersectRayWithObject ray p</span>
-<span class="lineno">   24 </span><span class="spaces">  </span><span class="istickedoff">= clampIntervals is</span>
-<span class="lineno">   25 </span><span class="spaces">  </span><span class="istickedoff">where is = intersections ray p</span></span>
-<span class="lineno">   26 </span>
-<span class="lineno">   27 </span><span class="decl"><span class="istickedoff">clampIntervals (True, [], True) = <span class="nottickedoff">(False, [(0, True, undefined)], True)</span></span>
-<span class="lineno">   28 </span><span class="spaces"></span><span class="istickedoff">clampIntervals empty@(False, [], False) = empty</span>
-<span class="lineno">   29 </span><span class="spaces"></span><span class="istickedoff">clampIntervals (True, is@((i, False, p) : is'), isOpen)</span>
-<span class="lineno">   30 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">i `near` 0 || i &lt; 0</span></span>
-<span class="lineno">   31 </span><span class="spaces">  </span><span class="istickedoff">= clampIntervals (False, is', isOpen)</span>
-<span class="lineno">   32 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span></span>
-<span class="lineno">   33 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">(False, (0, True, undefined) : is, isOpen)</span></span>
-<span class="lineno">   34 </span><span class="spaces"></span><span class="istickedoff">clampIntervals ivals@(False, is@((i, True, p) : is'), isOpen)</span>
-<span class="lineno">   35 </span><span class="spaces">  </span><span class="istickedoff">| i `near` 0 || i &lt; 0</span>
-<span class="lineno">   36 </span><span class="spaces">  </span><span class="istickedoff">-- can unify this with first case...</span>
-<span class="lineno">   37 </span><span class="spaces">  </span><span class="istickedoff">= clampIntervals (True, is', isOpen)</span>
-<span class="lineno">   38 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span></span>
-<span class="lineno">   39 </span><span class="spaces">  </span><span class="istickedoff">= ivals</span></span>
-<span class="lineno">   40 </span>
-<span class="lineno">   41 </span><span class="decl"><span class="istickedoff">intersections ray (Union p q)</span>
-<span class="lineno">   42 </span><span class="spaces">  </span><span class="istickedoff">= unionIntervals is js</span>
-<span class="lineno">   43 </span><span class="spaces">  </span><span class="istickedoff">where is = intersections ray p</span>
-<span class="lineno">   44 </span><span class="spaces">        </span><span class="istickedoff">js = intersections ray q</span>
-<span class="lineno">   45 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   46 </span><span class="spaces"></span><span class="istickedoff">intersections ray (Intersect p q)</span>
-<span class="lineno">   47 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">intersectIntervals is js</span></span>
-<span class="lineno">   48 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">is = intersections ray p</span></span>
-<span class="lineno">   49 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">js = intersections ray q</span></span>
-<span class="lineno">   50 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   51 </span><span class="spaces"></span><span class="istickedoff">intersections ray (Difference p q)</span>
-<span class="lineno">   52 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">differenceIntervals is (negateSurfaces js)</span></span>
-<span class="lineno">   53 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">is = intersections ray p</span></span>
-<span class="lineno">   54 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">js = intersections ray q</span></span>
-<span class="lineno">   55 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   56 </span><span class="spaces"></span><span class="istickedoff">intersections ray (Transform m m' p)</span>
-<span class="lineno">   57 </span><span class="spaces">  </span><span class="istickedoff">= mapI (xform m) is</span>
-<span class="lineno">   58 </span><span class="spaces">  </span><span class="istickedoff">where is = intersections (m' `multMR` ray) p</span>
-<span class="lineno">   59 </span><span class="spaces">        </span><span class="istickedoff">xform m (i, b, (s, p0)) = (i, b, (transformSurface m s, p0))</span>
-<span class="lineno">   60 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   61 </span><span class="spaces"></span><span class="istickedoff">intersections ray (Box box p)</span>
-<span class="lineno">   62 </span><span class="spaces">  </span><span class="istickedoff">| intersectWithBox ray box = intersections ray p</span>
-<span class="lineno">   63 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span> = emptyIList</span>
-<span class="lineno">   64 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   65 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Plane s)</span>
-<span class="lineno">   66 </span><span class="spaces">  </span><span class="istickedoff">= intersectPlane ray s</span>
-<span class="lineno">   67 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   68 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Sphere s)</span>
-<span class="lineno">   69 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">intersectSphere ray s</span></span>
-<span class="lineno">   70 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   71 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Cube s)</span>
-<span class="lineno">   72 </span><span class="spaces">  </span><span class="istickedoff">= intersectCube ray s</span>
-<span class="lineno">   73 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   74 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Cylinder s)</span>
-<span class="lineno">   75 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">intersectCylinder ray s</span></span>
-<span class="lineno">   76 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   77 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Cone s)</span>
-<span class="lineno">   78 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">intersectCone ray s</span></span></span>
-<span class="lineno">   79 </span>
-<span class="lineno">   80 </span>negateSurfaces :: IList (Surface, Texture a) -&gt; IList (Surface, Texture a)
-<span class="lineno">   81 </span><span class="decl"><span class="nottickedoff">negateSurfaces = mapI negSurf</span>
-<span class="lineno">   82 </span><span class="spaces">  </span><span class="nottickedoff">where negSurf (i, b, (s,t)) = (i, b, (negateSurface s, t))</span></span>
-<span class="lineno">   83 </span>
-<span class="lineno">   84 </span><span class="decl"><span class="nottickedoff">negateSurface (Planar p0 v0 v1)</span>
-<span class="lineno">   85 </span><span class="spaces">  </span><span class="nottickedoff">= Planar p0 v1 v0</span>
-<span class="lineno">   86 </span><span class="spaces"></span><span class="nottickedoff">negateSurface (Spherical p0 v0 v1)</span>
-<span class="lineno">   87 </span><span class="spaces">  </span><span class="nottickedoff">= Spherical p0 v1 v0</span>
-<span class="lineno">   88 </span><span class="spaces"></span><span class="nottickedoff">negateSurface (Cylindrical p0 v0 v1)</span>
-<span class="lineno">   89 </span><span class="spaces">  </span><span class="nottickedoff">= Cylindrical p0 v1 v0</span>
-<span class="lineno">   90 </span><span class="spaces"></span><span class="nottickedoff">negateSurface (Conic p0 v0 v1)</span>
-<span class="lineno">   91 </span><span class="spaces">  </span><span class="nottickedoff">= Conic p0 v1 v0</span></span>
-<span class="lineno">   92 </span>
-<span class="lineno">   93 </span><span class="decl"><span class="istickedoff">transformSurface m (Planar p0 v0 v1)</span>
-<span class="lineno">   94 </span><span class="spaces">  </span><span class="istickedoff">= Planar <span class="nottickedoff">p0'</span> v0' v1'</span>
-<span class="lineno">   95 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">p0' = multMP m p0</span></span>
-<span class="lineno">   96 </span><span class="spaces">        </span><span class="istickedoff">v0' = multMV m v0</span>
-<span class="lineno">   97 </span><span class="spaces">        </span><span class="istickedoff">v1' = multMV m v1</span>
-<span class="lineno">   98 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   99 </span><span class="spaces"></span><span class="istickedoff">transformSurface m (Spherical p0 v0 v1)</span>
-<span class="lineno">  100 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">Spherical p0' v0' v1'</span></span>
-<span class="lineno">  101 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">p0' = multMP m p0</span></span>
-<span class="lineno">  102 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v0' = multMV m v0</span></span>
-<span class="lineno">  103 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v1' = multMV m v1</span></span>
-<span class="lineno">  104 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  105 </span><span class="spaces"></span><span class="istickedoff">-- ditto as above</span>
-<span class="lineno">  106 </span><span class="spaces"></span><span class="istickedoff">transformSurface m (Cylindrical p0 v0 v1)</span>
-<span class="lineno">  107 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">Cylindrical p0' v0' v1'</span></span>
-<span class="lineno">  108 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">p0' = multMP m p0</span></span>
-<span class="lineno">  109 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v0' = multMV m v0</span></span>
-<span class="lineno">  110 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v1' = multMV m v1</span></span>
-<span class="lineno">  111 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  112 </span><span class="spaces"></span><span class="istickedoff">transformSurface m (Conic p0 v0 v1)</span>
-<span class="lineno">  113 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">Conic p0' v0' v1'</span></span>
-<span class="lineno">  114 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">p0' = multMP m p0</span></span>
-<span class="lineno">  115 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v0' = multMV m v0</span></span>
-<span class="lineno">  116 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v1' = multMV m v1</span></span></span>
-<span class="lineno">  117 </span>
-<span class="lineno">  118 </span>--------------------------------
-<span class="lineno">  119 </span>-- Plane
-<span class="lineno">  120 </span>--------------------------------
-<span class="lineno">  121 </span>
-<span class="lineno">  122 </span>intersectPlane :: Ray -&gt; a -&gt; IList (Surface, Texture a)
-<span class="lineno">  123 </span><span class="decl"><span class="istickedoff">intersectPlane ray texture = intersectXZPlane PlaneFace ray 0.0 texture</span></span>
-<span class="lineno">  124 </span>
-<span class="lineno">  125 </span>intersectXZPlane :: Face -&gt; Ray -&gt; Double -&gt; a -&gt; IList (Surface, Texture a)
-<span class="lineno">  126 </span><span class="decl"><span class="istickedoff">intersectXZPlane n (r,v) yoffset texture</span>
-<span class="lineno">  127 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlyfalse">b `near` 0</span></span>
-<span class="lineno">  128 </span><span class="spaces">  </span><span class="istickedoff">= -- the ray is parallel to the plane - it's either all in, or all out</span>
-<span class="lineno">  129 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">if y `near` yoffset || y &lt; yoffset then openIList else emptyIList</span></span>
+<span class="lineno">   41 </span>data State
+<span class="lineno">   42 </span>        = State { env   :: Env
+<span class="lineno">   43 </span>                , stack :: Stack
+<span class="lineno">   44 </span>                , code  :: Code
+<span class="lineno">   45 </span>                } deriving <span class="nottickedoff"><span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span></span>
+<span class="lineno">   46 </span>
+<span class="lineno">   47 </span>callback :: Env -&gt; Code -&gt; Stack -&gt; Stack
+<span class="lineno">   48 </span><span class="decl"><span class="istickedoff">callback env code stk</span>
+<span class="lineno">   49 </span><span class="spaces">      </span><span class="istickedoff">= case eval (State { env = env, stack = stk, code = code}) of</span>
+<span class="lineno">   50 </span><span class="spaces">             </span><span class="istickedoff">Pure stk -&gt; stk</span></span>
+<span class="lineno">   51 </span>
+<span class="lineno">   52 </span>{-# SPECIALIZE eval ::  State -&gt; Pure Stack #-}
+<span class="lineno">   53 </span>{-# SPECIALIZE eval ::  State -&gt; IO Stack #-}
+<span class="lineno">   54 </span>
+<span class="lineno">   55 </span>eval :: MonadEval m =&gt; State -&gt; m Stack
+<span class="lineno">   56 </span><span class="decl"><span class="istickedoff">eval st =</span>
+<span class="lineno">   57 </span><span class="spaces">  </span><span class="istickedoff">do { () &lt;- return () -- $ unsafePerformIO (print st)   -- Functional debugger</span>
+<span class="lineno">   58 </span><span class="spaces">     </span><span class="istickedoff">; if moreCode st then</span>
+<span class="lineno">   59 </span><span class="spaces">       </span><span class="istickedoff">do { tick             -- tick first, so as to catch loops on new eval.</span>
+<span class="lineno">   60 </span><span class="spaces">            </span><span class="istickedoff">; st' &lt;- step st</span>
+<span class="lineno">   61 </span><span class="spaces">            </span><span class="istickedoff">; eval st'</span>
+<span class="lineno">   62 </span><span class="spaces">            </span><span class="istickedoff">}</span>
+<span class="lineno">   63 </span><span class="spaces">        </span><span class="istickedoff">else return (stack st)</span>
+<span class="lineno">   64 </span><span class="spaces">     </span><span class="istickedoff">}</span></span>
+<span class="lineno">   65 </span>     
+<span class="lineno">   66 </span>moreCode :: State -&gt; Bool
+<span class="lineno">   67 </span><span class="decl"><span class="istickedoff">moreCode (State {code = []}) = False</span>
+<span class="lineno">   68 </span><span class="spaces"></span><span class="istickedoff">moreCode _                   = True</span></span>
+<span class="lineno">   69 </span>
+<span class="lineno">   70 </span>-- Step has a precondition that there *is* code to run
+<span class="lineno">   71 </span>{-# SPECIALIZE step ::  State -&gt; Pure State #-}
+<span class="lineno">   72 </span>{-# SPECIALIZE step ::  State -&gt; IO State #-}
+<span class="lineno">   73 </span>step :: MonadEval m =&gt; State -&gt; m State
+<span class="lineno">   74 </span>
+<span class="lineno">   75 </span>-- Rule 1: Pushing BaseValues
+<span class="lineno">   76 </span><span class="decl"><span class="istickedoff">step st@(State{ stack = stack, code = (TBool b):cs })    </span>
+<span class="lineno">   77 </span><span class="spaces">    </span><span class="istickedoff">= <span class="nottickedoff">return (st { stack = (VBool b):stack,    code = cs })</span></span>
+<span class="lineno">   78 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ stack = stack, code = (TInt i):cs })     </span>
+<span class="lineno">   79 </span><span class="spaces">    </span><span class="istickedoff">= return (st { stack = (VInt i):stack,     code = cs })</span>
+<span class="lineno">   80 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ stack = stack, code = (TReal r):cs })    </span>
+<span class="lineno">   81 </span><span class="spaces">    </span><span class="istickedoff">= return (st { stack = (VReal r):stack,    code = cs })</span>
+<span class="lineno">   82 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ stack = stack, code = (TString s):cs })  </span>
+<span class="lineno">   83 </span><span class="spaces">    </span><span class="istickedoff">= return (st { stack = (VString <span class="nottickedoff">s</span>):stack,  code = cs })</span>
+<span class="lineno">   84 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   85 </span><span class="spaces"></span><span class="istickedoff">-- Rule 2: Name binding</span>
+<span class="lineno">   86 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = (v:stack), code = (TBind id):cs }) =</span>
+<span class="lineno">   87 </span><span class="spaces">  </span><span class="istickedoff">return (State { env = extendEnv env id v, stack = stack,  code = cs })</span>
+<span class="lineno">   88 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = [], code = (TBind id):cs }) =</span>
+<span class="lineno">   89 </span><span class="spaces">  </span><span class="istickedoff"><span class="nottickedoff">err &quot;Attempt to bind the top of an empty stack&quot;</span></span>
+<span class="lineno">   90 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   91 </span><span class="spaces"></span><span class="istickedoff">-- Rule 3: Name lookup</span>
+<span class="lineno">   92 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = stack, code = (TId id):cs }) =</span>
+<span class="lineno">   93 </span><span class="spaces">  </span><span class="istickedoff">case (lookupEnv env id) of</span>
+<span class="lineno">   94 </span><span class="spaces">  </span><span class="istickedoff">Just v -&gt; return (st { stack = v:stack,  code = cs })</span>
+<span class="lineno">   95 </span><span class="spaces">  </span><span class="istickedoff">Nothing -&gt; <span class="nottickedoff">err (&quot;Cannot find value for identifier: &quot; ++ id)</span></span>
+<span class="lineno">   96 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   97 </span><span class="spaces"></span><span class="istickedoff">-- Rule 4: Closure creation</span>
+<span class="lineno">   98 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = stack, code = (TBody body):cs }) =</span>
+<span class="lineno">   99 </span><span class="spaces">  </span><span class="istickedoff">return (st { stack = (VClosure env body):stack, code = cs })</span>
+<span class="lineno">  100 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  101 </span><span class="spaces"></span><span class="istickedoff">-- Rule 5: Application</span>
+<span class="lineno">  102 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = (VClosure env' code'):stack, code = TApply:cs }) =</span>
+<span class="lineno">  103 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- eval (State {env = <span class="nottickedoff">env'</span>, stack = stack, code = code'})</span>
+<span class="lineno">  104 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = stk, code = cs })</span>
+<span class="lineno">  105 </span><span class="spaces">     </span><span class="istickedoff">}</span>
+<span class="lineno">  106 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = [], code = TApply:cs }) =</span>
+<span class="lineno">  107 </span><span class="spaces">  </span><span class="istickedoff"><span class="nottickedoff">err &quot;Application with an empty stack&quot;</span></span>
+<span class="lineno">  108 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = _:_, code = TApply:cs }) =</span>
+<span class="lineno">  109 </span><span class="spaces">  </span><span class="istickedoff"><span class="nottickedoff">err &quot;Application of a non-closure&quot;</span></span>
+<span class="lineno">  110 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  111 </span><span class="spaces"></span><span class="istickedoff">-- Rule 6: Arrays</span>
+<span class="lineno">  112 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = stack, code = TArray code':cs }) =</span>
+<span class="lineno">  113 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- eval (State {env = env, stack = [], code = code'})</span>
+<span class="lineno">  114 </span><span class="spaces">     </span><span class="istickedoff">; let last = length stk-1</span>
+<span class="lineno">  115 </span><span class="spaces">     </span><span class="istickedoff">; let arr = array (0,last) (zip [last,last-1..] stk)</span>
+<span class="lineno">  116 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = (VArray arr):stack, code = cs })</span>
+<span class="lineno">  117 </span><span class="spaces">     </span><span class="istickedoff">}</span>
+<span class="lineno">  118 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  119 </span><span class="spaces"></span><span class="istickedoff">-- Rule 7 &amp; 8: If statement</span>
+<span class="lineno">  120 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = (VClosure e2 c2):(VClosure e1 c1):(VBool True):stack, code = TIf:cs }) =</span>
+<span class="lineno">  121 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- eval (State {env = e1, stack = stack, code = c1})</span>
+<span class="lineno">  122 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = stk, code = cs })</span>
+<span class="lineno">  123 </span><span class="spaces">     </span><span class="istickedoff">}</span>
+<span class="lineno">  124 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = (VClosure e2 c2):(VClosure e1 c1):(VBool False):stack, code = TIf:cs }) =</span>
+<span class="lineno">  125 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- eval (State {env = e2, stack = stack, code = c2})</span>
+<span class="lineno">  126 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = stk, code = cs })</span>
+<span class="lineno">  127 </span><span class="spaces">     </span><span class="istickedoff">}</span>
+<span class="lineno">  128 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = _, code = TIf:cs }) =</span>
+<span class="lineno">  129 </span><span class="spaces">  </span><span class="istickedoff"><span class="nottickedoff">err &quot;Incorrect use of if (bad and/or inappropriate values on the stack)&quot;</span></span>
 <span class="lineno">  130 </span><span class="spaces"></span><span class="istickedoff"></span>
 <span class="lineno">  130 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  131 </span><span class="spaces">    </span><span class="istickedoff">-- The line intersects the plane. Find t such that</span>
-<span class="lineno">  132 </span><span class="spaces">    </span><span class="istickedoff">-- (x + at, y + bt, z + ct) intersects the X-Z plane.</span>
-<span class="lineno">  133 </span><span class="spaces">    </span><span class="istickedoff">-- t may be negative (the ray starts within the halfspace),</span>
-<span class="lineno">  134 </span><span class="spaces">    </span><span class="istickedoff">-- but we'll catch that later when we clamp the intervals</span>
-<span class="lineno">  135 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  136 </span><span class="spaces">  </span><span class="istickedoff">| b &lt; 0       -- the ray is pointing downwards</span>
-<span class="lineno">  137 </span><span class="spaces">  </span><span class="istickedoff">= (False, [mkEntry (t0, (Planar <span class="nottickedoff">p0</span> v0 v1, (n, p0, texture)))], <span class="nottickedoff">True</span>)</span>
-<span class="lineno">  138 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  139 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>   -- the ray is pointing upwards</span>
-<span class="lineno">  140 </span><span class="spaces">  </span><span class="istickedoff">= (True,  [mkExit (t0, (<span class="nottickedoff">Planar p0 v0 v1</span>, <span class="nottickedoff">(n, p0, texture)</span>))],  False)</span>
-<span class="lineno">  141 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  142 </span><span class="spaces">  </span><span class="istickedoff">where t0 = (yoffset-y) / b</span>
-<span class="lineno">  143 </span><span class="spaces">        </span><span class="istickedoff">x0 = x + a * t0</span>
-<span class="lineno">  144 </span><span class="spaces">        </span><span class="istickedoff">z0 = z + c * t0</span>
-<span class="lineno">  145 </span><span class="spaces">        </span><span class="istickedoff">p0 = point x0 0 z0</span>
-<span class="lineno">  146 </span><span class="spaces">        </span><span class="istickedoff">v0 = vector 0 0 1</span>
-<span class="lineno">  147 </span><span class="spaces">        </span><span class="istickedoff">v1 = vector 1 0 0</span>
-<span class="lineno">  148 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  149 </span><span class="spaces">        </span><span class="istickedoff">x = xCoord r</span>
-<span class="lineno">  150 </span><span class="spaces">        </span><span class="istickedoff">y = yCoord r</span>
-<span class="lineno">  151 </span><span class="spaces">        </span><span class="istickedoff">z = zCoord r</span>
-<span class="lineno">  152 </span><span class="spaces">        </span><span class="istickedoff">a = xComponent v</span>
-<span class="lineno">  153 </span><span class="spaces">        </span><span class="istickedoff">b = yComponent v</span>
-<span class="lineno">  154 </span><span class="spaces">        </span><span class="istickedoff">c = zComponent v</span></span>
+<span class="lineno">  131 </span><span class="spaces"></span><span class="istickedoff">-- Rule 9: Operators</span>
+<span class="lineno">  132 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = stack, code = (TOp op):cs }) =</span>
+<span class="lineno">  133 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- doOp (opFnTable ! op) op stack</span>
+<span class="lineno">  134 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = stk, code = cs })</span>
+<span class="lineno">  135 </span><span class="spaces">     </span><span class="istickedoff">}</span>
+<span class="lineno">  136 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  137 </span><span class="spaces"></span><span class="istickedoff">-- Rule Opps</span>
+<span class="lineno">  138 </span><span class="spaces"></span><span class="istickedoff">step _ = <span class="nottickedoff">err &quot;Tripped on sidewalk while stepping.&quot;</span></span></span>
+<span class="lineno">  139 </span>
+<span class="lineno">  140 </span>
+<span class="lineno">  141 </span>--------------------------------------------------------------------------
+<span class="lineno">  142 </span>-- Operator code
+<span class="lineno">  143 </span>
+<span class="lineno">  144 </span>opFnTable :: Array GMLOp PrimOp
+<span class="lineno">  145 </span><span class="decl"><span class="istickedoff">opFnTable = array (minBound,maxBound) </span>
+<span class="lineno">  146 </span><span class="spaces">                  </span><span class="istickedoff">[ (op,prim) | (_,TOp op,prim) &lt;- opcodes ]</span></span>
+<span class="lineno">  147 </span>
+<span class="lineno">  148 </span>
+<span class="lineno">  149 </span>
+<span class="lineno">  150 </span>
+<span class="lineno">  151 </span>doPureOp :: (MonadEval m) =&gt; PrimOp -&gt; GMLOp -&gt; Stack -&gt; m Stack
+<span class="lineno">  152 </span><span class="decl"><span class="istickedoff">doPureOp _ Op_render _ = </span>
+<span class="lineno">  153 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">err (&quot;\nAttempting to call render from inside a purely functional callback.&quot;)</span></span>
+<span class="lineno">  154 </span><span class="spaces"></span><span class="istickedoff">doPureOp primOp op stk = doPrimOp primOp <span class="nottickedoff">op</span> stk</span></span> -- call the purely functional operators
 <span class="lineno">  155 </span>
 <span class="lineno">  155 </span>
-<span class="lineno">  156 </span>
-<span class="lineno">  157 </span>--------------------------------
-<span class="lineno">  158 </span>-- Sphere
-<span class="lineno">  159 </span>--------------------------------
-<span class="lineno">  160 </span>
-<span class="lineno">  161 </span>intersectSphere :: Ray -&gt; a -&gt; IList (Surface, Texture a)
-<span class="lineno">  162 </span><span class="decl"><span class="nottickedoff">intersectSphere ray@(r, v) texture</span>
-<span class="lineno">  163 </span><span class="spaces">  </span><span class="nottickedoff">= -- Find t such that (x + ta, y + tb, z + tc) intersects the</span>
-<span class="lineno">  164 </span><span class="spaces">    </span><span class="nottickedoff">-- unit sphere, that is, such that:</span>
-<span class="lineno">  165 </span><span class="spaces">    </span><span class="nottickedoff">--   (x + ta)^2 + (y + tb)^2 + (z + tc)^2 = 1</span>
-<span class="lineno">  166 </span><span class="spaces">    </span><span class="nottickedoff">-- This is a quadratic equation in t:</span>
-<span class="lineno">  167 </span><span class="spaces">    </span><span class="nottickedoff">--   t^2(a^2 + b^2 + c^2) + 2t(xa + yb + zc) + (x^2 + y^2 + z^2 - 1) = 0</span>
-<span class="lineno">  168 </span><span class="spaces">    </span><span class="nottickedoff">let c1 = sq a + sq b + sq c</span>
-<span class="lineno">  169 </span><span class="spaces">        </span><span class="nottickedoff">c2 = 2 * (x * a + y * b + z * c)</span>
-<span class="lineno">  170 </span><span class="spaces">        </span><span class="nottickedoff">c3 = sq x + sq y + sq z - 1</span>
-<span class="lineno">  171 </span><span class="spaces">    </span><span class="nottickedoff">in</span>
-<span class="lineno">  172 </span><span class="spaces">        </span><span class="nottickedoff">case quadratic c1 c2 c3 of</span>
-<span class="lineno">  173 </span><span class="spaces">        </span><span class="nottickedoff">Nothing -&gt; emptyIList</span>
-<span class="lineno">  174 </span><span class="spaces">        </span><span class="nottickedoff">Just (t1, t2) -&gt; entryexit (g t1) (g t2)</span>
-<span class="lineno">  175 </span><span class="spaces">    </span><span class="nottickedoff">where x = xCoord r</span>
-<span class="lineno">  176 </span><span class="spaces">          </span><span class="nottickedoff">y = yCoord r</span>
-<span class="lineno">  177 </span><span class="spaces">          </span><span class="nottickedoff">z = zCoord r</span>
-<span class="lineno">  178 </span><span class="spaces">          </span><span class="nottickedoff">a = xComponent v</span>
-<span class="lineno">  179 </span><span class="spaces">          </span><span class="nottickedoff">b = yComponent v</span>
-<span class="lineno">  180 </span><span class="spaces">          </span><span class="nottickedoff">c = zComponent v</span>
-<span class="lineno">  181 </span><span class="spaces">          </span><span class="nottickedoff">g t = (t, (Spherical origin v1 v2, (SphereFace, p0, texture)))</span>
-<span class="lineno">  182 </span><span class="spaces">              </span><span class="nottickedoff">where origin = point 0 0 0</span>
-<span class="lineno">  183 </span><span class="spaces">                    </span><span class="nottickedoff">x0 = x + t * a</span>
-<span class="lineno">  184 </span><span class="spaces">                    </span><span class="nottickedoff">y0 = y + t * b</span>
-<span class="lineno">  185 </span><span class="spaces">                    </span><span class="nottickedoff">z0 = z + t * c</span>
-<span class="lineno">  186 </span><span class="spaces">                    </span><span class="nottickedoff">p0 = point  x0 y0 z0</span>
-<span class="lineno">  187 </span><span class="spaces">                    </span><span class="nottickedoff">v0 = vector x0 y0 z0</span>
-<span class="lineno">  188 </span><span class="spaces">                    </span><span class="nottickedoff">(v1, v2) = tangents v0</span></span>
-<span class="lineno">  189 </span>
-<span class="lineno">  190 </span>
-<span class="lineno">  191 </span>--------------------------------
-<span class="lineno">  192 </span>-- Cube
-<span class="lineno">  193 </span>--------------------------------
-<span class="lineno">  194 </span>
-<span class="lineno">  195 </span>intersectCube :: Ray -&gt; a -&gt; IList (Surface, Texture a)
-<span class="lineno">  196 </span><span class="decl"><span class="istickedoff">intersectCube ray@(r, v) texture</span>
-<span class="lineno">  197 </span><span class="spaces">  </span><span class="istickedoff">= -- The set of t such that (x + at, y + bt, z + ct) lies within</span>
-<span class="lineno">  198 </span><span class="spaces">    </span><span class="istickedoff">-- the unit cube satisfies:</span>
-<span class="lineno">  199 </span><span class="spaces">    </span><span class="istickedoff">--    0 &lt;= x + at &lt;= 1,  0 &lt;= y + bt &lt;= 1,  0 &lt;= z + ct &lt;= 1</span>
-<span class="lineno">  200 </span><span class="spaces">    </span><span class="istickedoff">-- The minimum and maximum such values of t give us the two</span>
-<span class="lineno">  201 </span><span class="spaces">    </span><span class="istickedoff">-- intersection points.</span>
-<span class="lineno">  202 </span><span class="spaces">    </span><span class="istickedoff">case intersectSlabIval (intersectCubeSlab face2 face3 x a)</span>
-<span class="lineno">  203 </span><span class="spaces">        </span><span class="istickedoff">(intersectSlabIval (intersectCubeSlab face5 face4 y b)</span>
-<span class="lineno">  204 </span><span class="spaces">                           </span><span class="istickedoff">(intersectCubeSlab face0 <span class="nottickedoff">face1</span> z c)) of</span>
-<span class="lineno">  205 </span><span class="spaces">    </span><span class="istickedoff">Nothing -&gt; emptyIList</span>
-<span class="lineno">  206 </span><span class="spaces">    </span><span class="istickedoff">Just (t1, t2) -&gt; entryexit (g t1) (g t2)</span>
-<span class="lineno">  207 </span><span class="spaces">  </span><span class="istickedoff">where g ((n, v0, v1), t)</span>
-<span class="lineno">  208 </span><span class="spaces">          </span><span class="istickedoff">= (t, (Planar <span class="nottickedoff">p0</span> v0 v1, (n, p0, texture)))</span>
-<span class="lineno">  209 </span><span class="spaces">          </span><span class="istickedoff">where p0 = offsetToPoint ray t</span>
-<span class="lineno">  210 </span><span class="spaces">        </span><span class="istickedoff">face0 = (CubeFront,  vectorY, vectorX)</span>
-<span class="lineno">  211 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">face1 = (CubeBack,   vectorX, vectorY)</span></span>
-<span class="lineno">  212 </span><span class="spaces">        </span><span class="istickedoff">face2 = (CubeLeft,   vectorZ, vectorY)</span>
-<span class="lineno">  213 </span><span class="spaces">        </span><span class="istickedoff">face3 = (<span class="nottickedoff">CubeRight</span>,  <span class="nottickedoff">vectorY</span>, <span class="nottickedoff">vectorZ</span>)</span>
-<span class="lineno">  214 </span><span class="spaces">        </span><span class="istickedoff">face4 = (CubeTop,    vectorZ, vectorX)</span>
-<span class="lineno">  215 </span><span class="spaces">        </span><span class="istickedoff">face5 = (CubeBottom, vectorX, vectorZ)</span>
-<span class="lineno">  216 </span><span class="spaces">        </span><span class="istickedoff">vectorX = vector 1 0 0</span>
-<span class="lineno">  217 </span><span class="spaces">        </span><span class="istickedoff">vectorY = vector 0 1 0</span>
-<span class="lineno">  218 </span><span class="spaces">        </span><span class="istickedoff">vectorZ = vector 0 0 1</span>
-<span class="lineno">  219 </span><span class="spaces">        </span><span class="istickedoff">x = xCoord r</span>
-<span class="lineno">  220 </span><span class="spaces">        </span><span class="istickedoff">y = yCoord r</span>
-<span class="lineno">  221 </span><span class="spaces">        </span><span class="istickedoff">z = zCoord r</span>
-<span class="lineno">  222 </span><span class="spaces">        </span><span class="istickedoff">a = xComponent v</span>
-<span class="lineno">  223 </span><span class="spaces">        </span><span class="istickedoff">b = yComponent v</span>
-<span class="lineno">  224 </span><span class="spaces">        </span><span class="istickedoff">c = zComponent v</span></span>
-<span class="lineno">  225 </span>
-<span class="lineno">  226 </span><span class="decl"><span class="istickedoff">intersectCubeSlab n m w d</span>
-<span class="lineno">  227 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlyfalse">d `near` 0</span> = <span class="nottickedoff">if (0 &lt;= w) &amp;&amp; (w &lt;= 1)</span></span>
-<span class="lineno">  228 </span><span class="spaces">                 </span><span class="istickedoff"><span class="nottickedoff">then Just ((n, -inf), (m, inf)) else Nothing</span></span>
-<span class="lineno">  229 </span><span class="spaces">  </span><span class="istickedoff">| d &gt; 0      = Just ((n,  (-w)/d), (m, (1-w)/d))</span>
-<span class="lineno">  230 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>  = Just ((m, (1-w)/d), (n,  (-w)/d))</span></span>
-<span class="lineno">  231 </span>
-<span class="lineno">  232 </span><span class="decl"><span class="istickedoff">intersectSlabIval Nothing Nothing  = <span class="nottickedoff">Nothing</span></span>
-<span class="lineno">  233 </span><span class="spaces"></span><span class="istickedoff">intersectSlabIval Nothing (Just i) = <span class="nottickedoff">Nothing</span></span>
-<span class="lineno">  234 </span><span class="spaces"></span><span class="istickedoff">intersectSlabIval (Just i) Nothing = Nothing</span>
-<span class="lineno">  235 </span><span class="spaces"></span><span class="istickedoff">intersectSlabIval (Just (nu1@(n1, u1), mv1@(m1, v1)))</span>
-<span class="lineno">  236 </span><span class="spaces">                  </span><span class="istickedoff">(Just (nu2@(n2, u2), mv2@(m2, v2)))</span>
-<span class="lineno">  237 </span><span class="spaces">  </span><span class="istickedoff">= checkInterval (nu, mv)</span>
-<span class="lineno">  238 </span><span class="spaces">  </span><span class="istickedoff">where nu = if u1 &lt; u2 then nu2 else nu1</span>
-<span class="lineno">  239 </span><span class="spaces">        </span><span class="istickedoff">mv = if v1 &lt; v2 then mv1 else mv2</span>
-<span class="lineno">  240 </span><span class="spaces">        </span><span class="istickedoff">checkInterval numv@(nu@(_, u), (m, v))</span>
-<span class="lineno">  241 </span><span class="spaces">          </span><span class="istickedoff">-- rounding error may force us to push v out a bit</span>
-<span class="lineno">  242 </span><span class="spaces">          </span><span class="istickedoff">| <span class="tickonlyfalse">u `near` v</span> = <span class="nottickedoff">Just (nu, (m, u + epsilon))</span></span>
-<span class="lineno">  243 </span><span class="spaces">          </span><span class="istickedoff">| u    &lt;   v = Just numv</span>
-<span class="lineno">  244 </span><span class="spaces">          </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>  = Nothing</span></span>
-<span class="lineno">  245 </span>
-<span class="lineno">  246 </span>
-<span class="lineno">  247 </span>--------------------------------
-<span class="lineno">  248 </span>-- Cylinder
-<span class="lineno">  249 </span>--------------------------------
+<span class="lineno">  156 </span>{-# SPECIALIZE doPrimOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; Pure Stack #-}
+<span class="lineno">  157 </span>{-# SPECIALIZE doPrimOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; IO Stack #-}
+<span class="lineno">  158 </span>{-# SPECIALIZE doPrimOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; Abs Stack #-}
+<span class="lineno">  159 </span>
+<span class="lineno">  160 </span>doPrimOp ::  (MonadEval m) =&gt; PrimOp -&gt; GMLOp -&gt; Stack -&gt; m Stack
+<span class="lineno">  161 </span>
+<span class="lineno">  162 </span>-- 1 argument.
+<span class="lineno">  163 </span>
+<span class="lineno">  164 </span><span class="decl"><span class="istickedoff">doPrimOp (Int_Int fn) _ (VInt i1:stk)</span>
+<span class="lineno">  165 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">return ((VInt (fn i1)) : stk)</span></span>
+<span class="lineno">  166 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Real fn) _ (VReal r1:stk)</span>
+<span class="lineno">  167 </span><span class="spaces">  </span><span class="istickedoff">= return ((VReal (fn r1)) : stk)</span>
+<span class="lineno">  168 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Point_Real fn) _ (VPoint x y z:stk)</span>
+<span class="lineno">  169 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">return ((VReal (fn x y z)) : stk)</span></span>
+<span class="lineno">  170 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  171 </span><span class="spaces"></span><span class="istickedoff">-- This is where the callbacks happen from...</span>
+<span class="lineno">  172 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Surface_Obj fn) _ (VClosure env code:stk)</span>
+<span class="lineno">  173 </span><span class="spaces">  </span><span class="istickedoff">= case absapply env code [<span class="nottickedoff">VAbsObj AbsFACE</span>,<span class="nottickedoff">VAbsObj AbsU</span>,<span class="nottickedoff">VAbsObj AbsV</span>] of</span>
+<span class="lineno">  174 </span><span class="spaces">      </span><span class="istickedoff">Just [VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3] -&gt; </span>
+<span class="lineno">  175 </span><span class="spaces">           </span><span class="istickedoff"><span class="nottickedoff">let</span></span>
+<span class="lineno">  176 </span><span class="spaces">               </span><span class="istickedoff"><span class="nottickedoff">res = prop (color c1 c2 c3) r1 r2 r3</span></span>
+<span class="lineno">  177 </span><span class="spaces">           </span><span class="istickedoff"><span class="nottickedoff">in</span></span>
+<span class="lineno">  178 </span><span class="spaces">               </span><span class="istickedoff"><span class="nottickedoff">return ((VObject (fn (SConst res))) : stk)</span></span>
+<span class="lineno">  179 </span><span class="spaces">      </span><span class="istickedoff">_ -&gt; return ((VObject (fn (SFun call))) : stk)</span>
+<span class="lineno">  180 </span><span class="spaces">  </span><span class="istickedoff">where </span>
+<span class="lineno">  181 </span><span class="spaces">        </span><span class="istickedoff">-- The most general case</span>
+<span class="lineno">  182 </span><span class="spaces">        </span><span class="istickedoff">call i r1 r2 =</span>
+<span class="lineno">  183 </span><span class="spaces">          </span><span class="istickedoff">case callback env code [VReal r2,VReal r1,<span class="nottickedoff">VInt i</span>] of</span>
+<span class="lineno">  184 </span><span class="spaces">             </span><span class="istickedoff">[VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3] </span>
+<span class="lineno">  185 </span><span class="spaces">                 </span><span class="istickedoff">-&gt; prop (color c1 c2 c3) r1 r2 r3</span>
+<span class="lineno">  186 </span><span class="spaces">             </span><span class="istickedoff">stk -&gt; <span class="nottickedoff">error (&quot;callback failed: incorrectly typed return arguments&quot;</span></span>
+<span class="lineno">  187 </span><span class="spaces">                         </span><span class="istickedoff"><span class="nottickedoff">++ show stk)</span></span>
+<span class="lineno">  188 </span><span class="spaces">       </span><span class="istickedoff"></span>
+<span class="lineno">  189 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Int fn) _ (VReal r1:stk)</span>
+<span class="lineno">  190 </span><span class="spaces">  </span><span class="istickedoff">= return ((VInt (fn r1)) : stk)</span>
+<span class="lineno">  191 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Int_Real fn) _ (VInt r1:stk)</span>
+<span class="lineno">  192 </span><span class="spaces">  </span><span class="istickedoff">= return ((VReal (fn r1)) : stk)</span>
+<span class="lineno">  193 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Arr_Int fn) _ (VArray arr:stk)</span>
+<span class="lineno">  194 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">return ((VInt (fn arr)) : stk)</span></span>
+<span class="lineno">  195 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  196 </span><span class="spaces"></span><span class="istickedoff">-- 2 arguments.</span>
+<span class="lineno">  197 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  198 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Int_Int_Int fn) _ (VInt i2:VInt i1:stk)</span>
+<span class="lineno">  199 </span><span class="spaces">  </span><span class="istickedoff">= return ((VInt (fn i1 i2)) : stk)</span>
+<span class="lineno">  200 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Int_Int_Bool fn) _ (VInt i2:VInt i1:stk)</span>
+<span class="lineno">  201 </span><span class="spaces">  </span><span class="istickedoff">= return ((VBool (fn i1 i2)) : stk)</span>
+<span class="lineno">  202 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Real_Real fn) _ (VReal r2:VReal r1:stk)</span>
+<span class="lineno">  203 </span><span class="spaces">  </span><span class="istickedoff">= return ((VReal (fn r1 r2)) : stk)</span>
+<span class="lineno">  204 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Real_Bool fn) _ (VReal r2:VReal r1:stk)</span>
+<span class="lineno">  205 </span><span class="spaces">  </span><span class="istickedoff">= return ((VBool (fn r1 r2)) : stk)</span>
+<span class="lineno">  206 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Arr_Int_Value fn) _ (VInt i:VArray arr:stk)</span>
+<span class="lineno">  207 </span><span class="spaces">  </span><span class="istickedoff">= return ((fn arr i) : stk)</span>
+<span class="lineno">  208 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  209 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  210 </span><span class="spaces">    </span><span class="istickedoff">-- Many arguments, typically image mangling</span>
+<span class="lineno">  211 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  212 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Obj_Obj_Obj fn) _ (VObject o2:VObject o1:stk)</span>
+<span class="lineno">  213 </span><span class="spaces">  </span><span class="istickedoff">= return ((VObject (fn o1 o2)) : <span class="nottickedoff">stk</span>)</span>
+<span class="lineno">  214 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Point_Color_Light fn) _ (VPoint r g b:VPoint x y z : stk)</span>
+<span class="lineno">  215 </span><span class="spaces">  </span><span class="istickedoff">= return (VLight (fn (x,y,z) (color r g b)) : <span class="nottickedoff">stk</span>)</span>
+<span class="lineno">  216 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Point_Point_Color_Real_Real_Light fn) _ </span>
+<span class="lineno">  217 </span><span class="spaces">         </span><span class="istickedoff">(VReal r2:VReal r1:VPoint r g b:VPoint x2 y2 z2:VPoint x1 y1 z1 : stk)</span>
+<span class="lineno">  218 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">return (VLight (fn (x1,y1,z1) (x2,y2,z2) (color r g b) r1 r2) : stk)</span></span>
+<span class="lineno">  219 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Real_Real_Point fn) _ (VReal r3:VReal r2:VReal r1:stk)</span>
+<span class="lineno">  220 </span><span class="spaces">  </span><span class="istickedoff">= return ((fn r1 r2 r3) : stk)</span>
+<span class="lineno">  221 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Obj_Real_Obj fn) _ (VReal r:VObject o:stk)</span>
+<span class="lineno">  222 </span><span class="spaces">  </span><span class="istickedoff">= return (VObject (fn o r) : <span class="nottickedoff">stk</span>)</span>
+<span class="lineno">  223 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Obj_Real_Real_Real_Obj fn) _ (VReal r3:VReal r2:VReal r1:VObject o:stk)</span>
+<span class="lineno">  224 </span><span class="spaces">  </span><span class="istickedoff">= return (VObject (fn o r1 r2 r3) : stk)</span>
+<span class="lineno">  225 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  226 </span><span class="spaces"></span><span class="istickedoff">-- This one is our testing harness</span>
+<span class="lineno">  227 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Value_String_Value fn) _ (VString s:o:stk)</span>
+<span class="lineno">  228 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">res `seq` return (res : stk)</span></span>
+<span class="lineno">  229 </span><span class="spaces">  </span><span class="istickedoff">where</span>
+<span class="lineno">  230 </span><span class="spaces">     </span><span class="istickedoff"><span class="nottickedoff">res = fn o s</span></span>
+<span class="lineno">  231 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  232 </span><span class="spaces"></span><span class="istickedoff">doPrimOp primOp op args </span>
+<span class="lineno">  233 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">err (&quot;\n\ntype error when attempting to execute builtin primitive \&quot;&quot; ++</span></span>
+<span class="lineno">  234 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">show op ++ &quot;\&quot;\n\n| &quot; ++</span></span>
+<span class="lineno">  235 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">show op ++ &quot; takes &quot; ++ show (length types) ++ &quot; argument&quot; ++ s</span></span>
+<span class="lineno">  236 </span><span class="spaces">                   </span><span class="istickedoff"><span class="nottickedoff">++ &quot; with&quot; ++ the ++ &quot; type&quot; ++ s ++ &quot;\n|\n|&quot; ++</span></span>
+<span class="lineno">  237 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">&quot;      &quot; ++ unwords [ show ty | ty &lt;- types ]  ++ &quot;\n|\n|&quot; ++ </span></span>
+<span class="lineno">  238 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">&quot; currently, the relevent argument&quot; ++ s ++ &quot; on the stack &quot; ++ </span></span>
+<span class="lineno">  239 </span><span class="spaces">                  </span><span class="istickedoff"><span class="nottickedoff">are ++ &quot;\n|\n| &quot; ++ </span></span>
+<span class="lineno">  240 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">unwords [ &quot;(&quot; ++ show arg ++ &quot;)&quot; </span></span>
+<span class="lineno">  241 </span><span class="spaces">                  </span><span class="istickedoff"><span class="nottickedoff">| arg &lt;-  reverse (take (length types) args) ]  ++ &quot;\n|\n| &quot;</span></span>
+<span class="lineno">  242 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">++ &quot;    (top of stack is on the right hand side)\n\n&quot;)</span></span>
+<span class="lineno">  243 </span><span class="spaces">  </span><span class="istickedoff">where</span>
+<span class="lineno">  244 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">len   = length types</span></span>
+<span class="lineno">  245 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">s =  (if len /= 1 then &quot;s&quot; else &quot;&quot;)</span></span>
+<span class="lineno">  246 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">are =  (if len /= 1 then &quot;are&quot; else &quot;is&quot;)</span></span>
+<span class="lineno">  247 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">the =  (if len /= 1 then &quot;&quot; else &quot; the&quot;)</span></span>
+<span class="lineno">  248 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">types = getPrimOpType primOp</span></span></span>
+<span class="lineno">  249 </span>
 <span class="lineno">  250 </span>
 <span class="lineno">  250 </span>
-<span class="lineno">  251 </span>intersectCylinder :: Ray -&gt; a -&gt; IList (Surface, Texture a)
-<span class="lineno">  252 </span><span class="decl"><span class="nottickedoff">intersectCylinder ray texture</span>
-<span class="lineno">  253 </span><span class="spaces">  </span><span class="nottickedoff">= isectSide `intersectIntervals` isectTop `intersectIntervals` isectBottom</span>
-<span class="lineno">  254 </span><span class="spaces">  </span><span class="nottickedoff">where isectSide   = intersectCylSide ray texture</span>
-<span class="lineno">  255 </span><span class="spaces">        </span><span class="nottickedoff">isectTop    = intersectXZPlane CylinderTop ray 1.0 texture</span>
-<span class="lineno">  256 </span><span class="spaces">        </span><span class="nottickedoff">isectBottom = complementIntervals $ negateSurfaces $</span>
-<span class="lineno">  257 </span><span class="spaces">                      </span><span class="nottickedoff">intersectXZPlane CylinderBottom ray 0.0 texture</span></span>
-<span class="lineno">  258 </span>
-<span class="lineno">  259 </span><span class="decl"><span class="nottickedoff">intersectCylSide (r, v) texture</span>
-<span class="lineno">  260 </span><span class="spaces">  </span><span class="nottickedoff">= -- The ray (x + ta, y + tb, z + tc) intersects the sides of the</span>
-<span class="lineno">  261 </span><span class="spaces">    </span><span class="nottickedoff">-- cylinder if:</span>
-<span class="lineno">  262 </span><span class="spaces">    </span><span class="nottickedoff">--    (x + ta)^2 + (z + tc)^2 = 1  and 0 &lt;= y + tb &lt;= 1.</span>
-<span class="lineno">  263 </span><span class="spaces">    </span><span class="nottickedoff">if (sq a + sq c) `near` 0</span>
-<span class="lineno">  264 </span><span class="spaces">    </span><span class="nottickedoff">then -- The ray is parallel to the Y-axis, and does not intersect</span>
-<span class="lineno">  265 </span><span class="spaces">         </span><span class="nottickedoff">-- the cylinder sides.  It's either all in, or all out</span>
-<span class="lineno">  266 </span><span class="spaces">        </span><span class="nottickedoff">if (sqxy `near` 1.0 || sqxy &lt; 1.0) then openIList else emptyIList</span>
-<span class="lineno">  267 </span><span class="spaces">   </span><span class="nottickedoff">else -- Find values of t that solve the quadratic equation</span>
-<span class="lineno">  268 </span><span class="spaces">        </span><span class="nottickedoff">--   (a^2 + c^2)t^2 + 2(ax + cz)t + x^2 + z^2 - 1 = 0</span>
-<span class="lineno">  269 </span><span class="spaces">        </span><span class="nottickedoff">let c1 = sq a + sq c</span>
-<span class="lineno">  270 </span><span class="spaces">            </span><span class="nottickedoff">c2 = 2 * (x * a + z * c)</span>
-<span class="lineno">  271 </span><span class="spaces">            </span><span class="nottickedoff">c3 = sq x + sq z - 1</span>
-<span class="lineno">  272 </span><span class="spaces">        </span><span class="nottickedoff">in</span>
-<span class="lineno">  273 </span><span class="spaces">        </span><span class="nottickedoff">case quadratic c1 c2 c3 of</span>
-<span class="lineno">  274 </span><span class="spaces">        </span><span class="nottickedoff">Nothing -&gt; emptyIList</span>
-<span class="lineno">  275 </span><span class="spaces">        </span><span class="nottickedoff">Just (t1, t2) -&gt; entryexit (g t1) (g t2)</span>
-<span class="lineno">  276 </span><span class="spaces"></span><span class="nottickedoff"></span>
-<span class="lineno">  277 </span><span class="spaces">  </span><span class="nottickedoff">where sqxy = sq x + sq y</span>
-<span class="lineno">  278 </span><span class="spaces">        </span><span class="nottickedoff">g t = (t, (Cylindrical origin v1 v2, (CylinderSide, p0, texture)))</span>
-<span class="lineno">  279 </span><span class="spaces">            </span><span class="nottickedoff">where origin = point 0 0 0</span>
-<span class="lineno">  280 </span><span class="spaces">                  </span><span class="nottickedoff">x0 = x + t * a</span>
-<span class="lineno">  281 </span><span class="spaces">                  </span><span class="nottickedoff">y0 = y + t * b</span>
-<span class="lineno">  282 </span><span class="spaces">                  </span><span class="nottickedoff">z0 = z + t * c</span>
-<span class="lineno">  283 </span><span class="spaces">                  </span><span class="nottickedoff">p0 = point  x0 y0 z0</span>
-<span class="lineno">  284 </span><span class="spaces">                  </span><span class="nottickedoff">v0 = vector x0 0 z0</span>
-<span class="lineno">  285 </span><span class="spaces">                  </span><span class="nottickedoff">(v1, v2) = tangents v0</span>
-<span class="lineno">  286 </span><span class="spaces"></span><span class="nottickedoff"></span>
-<span class="lineno">  287 </span><span class="spaces">        </span><span class="nottickedoff">x = xCoord r</span>
-<span class="lineno">  288 </span><span class="spaces">        </span><span class="nottickedoff">y = yCoord r</span>
-<span class="lineno">  289 </span><span class="spaces">        </span><span class="nottickedoff">z = zCoord r</span>
-<span class="lineno">  290 </span><span class="spaces">        </span><span class="nottickedoff">a = xComponent v</span>
-<span class="lineno">  291 </span><span class="spaces">        </span><span class="nottickedoff">b = yComponent v</span>
-<span class="lineno">  292 </span><span class="spaces">        </span><span class="nottickedoff">c = zComponent v</span></span>
-<span class="lineno">  293 </span>
-<span class="lineno">  294 </span>
-<span class="lineno">  295 </span>-------------------
-<span class="lineno">  296 </span>-- Cone
-<span class="lineno">  297 </span>-------------------
-<span class="lineno">  298 </span>
-<span class="lineno">  299 </span>intersectCone :: Ray -&gt; a -&gt; IList (Surface, Texture a)
-<span class="lineno">  300 </span><span class="decl"><span class="nottickedoff">intersectCone ray texture</span>
-<span class="lineno">  301 </span><span class="spaces">  </span><span class="nottickedoff">= isectSide `intersectIntervals` isectTop `intersectIntervals` isectBottom</span>
-<span class="lineno">  302 </span><span class="spaces">  </span><span class="nottickedoff">where isectSide   = intersectConeSide ray texture</span>
-<span class="lineno">  303 </span><span class="spaces">        </span><span class="nottickedoff">isectTop    = intersectXZPlane ConeBase ray 1.0 texture</span>
-<span class="lineno">  304 </span><span class="spaces">        </span><span class="nottickedoff">isectBottom = complementIntervals $ negateSurfaces $</span>
-<span class="lineno">  305 </span><span class="spaces">                      </span><span class="nottickedoff">intersectXZPlane ConeBase ray 0.0 texture</span></span>
-<span class="lineno">  306 </span>
-<span class="lineno">  307 </span><span class="decl"><span class="nottickedoff">intersectConeSide (r, v) texture</span>
-<span class="lineno">  308 </span><span class="spaces">  </span><span class="nottickedoff">= -- Find the points where the ray intersects the cond side.  At any points of</span>
-<span class="lineno">  309 </span><span class="spaces">    </span><span class="nottickedoff">-- intersection, we must have:</span>
-<span class="lineno">  310 </span><span class="spaces">    </span><span class="nottickedoff">--    (x + ta)^2 + (z + tc)^2 = (y + tb)^2</span>
-<span class="lineno">  311 </span><span class="spaces">    </span><span class="nottickedoff">-- which is the following quadratic equation:</span>
-<span class="lineno">  312 </span><span class="spaces">    </span><span class="nottickedoff">--    t^2(a^2-b^2+c^2) + 2t(xa-yb+cz) + (x^2-y^2+z^2) = 0</span>
-<span class="lineno">  313 </span><span class="spaces">    </span><span class="nottickedoff">let c1 = sq a - sq b + sq c</span>
-<span class="lineno">  314 </span><span class="spaces">        </span><span class="nottickedoff">c2 = 2 * (x * a - y * b + c * z)</span>
-<span class="lineno">  315 </span><span class="spaces">        </span><span class="nottickedoff">c3 = sq x - sq y + sq z</span>
-<span class="lineno">  316 </span><span class="spaces">    </span><span class="nottickedoff">in  case quadratic c1 c2 c3 of</span>
-<span class="lineno">  317 </span><span class="spaces">        </span><span class="nottickedoff">Nothing -&gt; emptyIList</span>
-<span class="lineno">  318 </span><span class="spaces">        </span><span class="nottickedoff">Just (t1, t2) -&gt;</span>
-<span class="lineno">  319 </span><span class="spaces">            </span><span class="nottickedoff">-- If either intersection strikes the middle, then the other</span>
-<span class="lineno">  320 </span><span class="spaces">            </span><span class="nottickedoff">-- can only be off by rounding error, so we make a tangent</span>
-<span class="lineno">  321 </span><span class="spaces">            </span><span class="nottickedoff">-- strike using the &quot;good&quot; value.</span>
-<span class="lineno">  322 </span><span class="spaces">            </span><span class="nottickedoff">-- If the intersections straddle the origin, then it's</span>
-<span class="lineno">  323 </span><span class="spaces">            </span><span class="nottickedoff">-- an exit/entry pair, otherwise it's an entry/exit pair.</span>
-<span class="lineno">  324 </span><span class="spaces">            </span><span class="nottickedoff">let y1 = y + t1 * b</span>
-<span class="lineno">  325 </span><span class="spaces">                </span><span class="nottickedoff">y2 = y + t2 * b</span>
-<span class="lineno">  326 </span><span class="spaces">            </span><span class="nottickedoff">in  if y1 `near` 0                  then entryexit (g t1) (g t1)</span>
-<span class="lineno">  327 </span><span class="spaces">                </span><span class="nottickedoff">else if y2 `near` 0             then entryexit (g t2) (g t2)</span>
-<span class="lineno">  328 </span><span class="spaces">                </span><span class="nottickedoff">else if (y1 &lt; 0) `xor` (y2 &lt; 0) then exitentry (g t1) (g t2)</span>
-<span class="lineno">  329 </span><span class="spaces">                </span><span class="nottickedoff">else                                 entryexit (g t1) (g t2)</span>
-<span class="lineno">  330 </span><span class="spaces"></span><span class="nottickedoff"></span>
-<span class="lineno">  331 </span><span class="spaces">  </span><span class="nottickedoff">where g t = (t, (Conic origin v1 v2, (ConeSide, p0, texture)))</span>
-<span class="lineno">  332 </span><span class="spaces">            </span><span class="nottickedoff">where origin = point 0 0 0</span>
-<span class="lineno">  333 </span><span class="spaces">                  </span><span class="nottickedoff">x0 = x + t * a</span>
-<span class="lineno">  334 </span><span class="spaces">                  </span><span class="nottickedoff">y0 = y + t * b</span>
-<span class="lineno">  335 </span><span class="spaces">                  </span><span class="nottickedoff">z0 = z + t * c</span>
-<span class="lineno">  336 </span><span class="spaces">                  </span><span class="nottickedoff">p0 = point  x0 y0 z0</span>
-<span class="lineno">  337 </span><span class="spaces">                  </span><span class="nottickedoff">v0 = normalize $ vector x0 (-y0) z0</span>
-<span class="lineno">  338 </span><span class="spaces">                  </span><span class="nottickedoff">(v1, v2) = tangents v0</span>
-<span class="lineno">  339 </span><span class="spaces"></span><span class="nottickedoff"></span>
-<span class="lineno">  340 </span><span class="spaces">        </span><span class="nottickedoff">x = xCoord r</span>
-<span class="lineno">  341 </span><span class="spaces">        </span><span class="nottickedoff">y = yCoord r</span>
-<span class="lineno">  342 </span><span class="spaces">        </span><span class="nottickedoff">z = zCoord r</span>
-<span class="lineno">  343 </span><span class="spaces">        </span><span class="nottickedoff">a = xComponent v</span>
-<span class="lineno">  344 </span><span class="spaces">        </span><span class="nottickedoff">b = yComponent v</span>
-<span class="lineno">  345 </span><span class="spaces">        </span><span class="nottickedoff">c = zComponent v</span>
-<span class="lineno">  346 </span><span class="spaces"></span><span class="nottickedoff"></span>
-<span class="lineno">  347 </span><span class="spaces">        </span><span class="nottickedoff">-- beyond me why this isn't defined in the prelude...</span>
-<span class="lineno">  348 </span><span class="spaces">        </span><span class="nottickedoff">xor False b = b</span>
-<span class="lineno">  349 </span><span class="spaces">        </span><span class="nottickedoff">xor True  b = not b</span></span>
-<span class="lineno">  350 </span>
+<span class="lineno">  251 </span>-- Render is somewhat funny, becauase it can only get called at top level.
+<span class="lineno">  252 </span>-- All other operations are purely functional.
+<span class="lineno">  253 </span>
+<span class="lineno">  254 </span>doAllOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; IO Stack
+<span class="lineno">  255 </span><span class="decl"><span class="istickedoff">doAllOp (Render render) Op_render</span>
+<span class="lineno">  256 </span><span class="spaces">                           </span><span class="istickedoff">(VString str:VInt ht:VInt wid:VReal fov</span>
+<span class="lineno">  257 </span><span class="spaces">                           </span><span class="istickedoff">:VInt dep:VObject obj:VArray arr</span>
+<span class="lineno">  258 </span><span class="spaces">                           </span><span class="istickedoff">:VPoint r g b : stk)</span>
+<span class="lineno">  259 </span><span class="spaces">  </span><span class="istickedoff">= do { render (color r g b) lights obj dep (fov * (pi / 180.0)) wid ht <span class="nottickedoff">str</span></span>
+<span class="lineno">  260 </span><span class="spaces">       </span><span class="istickedoff">; return <span class="nottickedoff">stk</span></span>
+<span class="lineno">  261 </span><span class="spaces">       </span><span class="istickedoff">}</span>
+<span class="lineno">  262 </span><span class="spaces">  </span><span class="istickedoff">where</span>
+<span class="lineno">  263 </span><span class="spaces">      </span><span class="istickedoff">lights = [ light | (VLight light) &lt;- elems arr ]</span>
+<span class="lineno">  264 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  265 </span><span class="spaces"></span><span class="istickedoff">doAllOp primOp op stk = doPrimOp primOp <span class="nottickedoff">op</span> stk</span></span> -- call the purely functional operators
+<span class="lineno">  266 </span>
+<span class="lineno">  267 </span>------------------------------------------------------------------------------
+<span class="lineno">  268 </span>{-
+<span class="lineno">  269 </span> - Abstract evaluation.
+<span class="lineno">  270 </span> -
+<span class="lineno">  271 </span> - The idea is you check for constant code that 
+<span class="lineno">  272 </span> - (1) does not look at its arguments
+<span class="lineno">  273 </span> - (2) gives a fixed result
+<span class="lineno">  274 </span> -
+<span class="lineno">  275 </span> - We run for 100 steps.
+<span class="lineno">  276 </span> -
+<span class="lineno">  277 </span> -}
+<span class="lineno">  278 </span>
+<span class="lineno">  279 </span>absapply :: Env -&gt; Code -&gt; Stack -&gt; Maybe Stack
+<span class="lineno">  280 </span><span class="decl"><span class="istickedoff">absapply env code stk = </span>
+<span class="lineno">  281 </span><span class="spaces">     </span><span class="istickedoff">case runAbs (eval (State env stk code)) 100 of</span>
+<span class="lineno">  282 </span><span class="spaces">       </span><span class="istickedoff">AbsState stk _ -&gt; <span class="nottickedoff">Just stk</span></span>
+<span class="lineno">  283 </span><span class="spaces">       </span><span class="istickedoff">AbsFail m      -&gt; Nothing</span></span>
+<span class="lineno">  284 </span>
+<span class="lineno">  285 </span>newtype Abs a   = Abs { runAbs :: Int -&gt; AbsState a }
+<span class="lineno">  286 </span>data AbsState a = AbsState a !Int
+<span class="lineno">  287 </span>                | AbsFail String
+<span class="lineno">  288 </span>
+<span class="lineno">  289 </span>instance Monad Abs where
+<span class="lineno">  290 </span>    <span class="decl"><span class="istickedoff">(Abs fn) &gt;&gt;= k = Abs (\ s -&gt; case fn s of</span>
+<span class="lineno">  291 </span><span class="spaces">                                   </span><span class="istickedoff">AbsState r s' -&gt; runAbs (k r) s'</span>
+<span class="lineno">  292 </span><span class="spaces">                                   </span><span class="istickedoff">AbsFail m     -&gt; AbsFail <span class="nottickedoff">m</span>)</span></span>
+<span class="lineno">  293 </span>    <span class="decl"><span class="istickedoff">return x     = Abs (\ n -&gt; AbsState x n)</span></span>
+<span class="lineno">  294 </span>    <span class="decl"><span class="istickedoff">fail s       = Abs (\ n -&gt; AbsFail <span class="nottickedoff">s</span>)</span></span>
+<span class="lineno">  295 </span>
+<span class="lineno">  296 </span>instance MonadEval Abs where
+<span class="lineno">  297 </span>  <span class="decl"><span class="istickedoff">doOp = doAbsOp</span></span>
+<span class="lineno">  298 </span>  <span class="decl"><span class="istickedoff">err  = fail</span></span>
+<span class="lineno">  299 </span>  <span class="decl"><span class="istickedoff">tick = Abs (\ n -&gt; if <span class="tickonlyfalse">n &lt;= 0</span></span>
+<span class="lineno">  300 </span><span class="spaces">                     </span><span class="istickedoff">then <span class="nottickedoff">AbsFail &quot;run out of time&quot;</span></span>
+<span class="lineno">  301 </span><span class="spaces">                     </span><span class="istickedoff">else AbsState <span class="nottickedoff">()</span> (n-1))</span></span>
+<span class="lineno">  302 </span>
+<span class="lineno">  303 </span>doAbsOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; Abs Stack
+<span class="lineno">  304 </span><span class="decl"><span class="istickedoff">doAbsOp _ Op_point (VReal r3:VReal r2:VReal r1:stk) </span>
+<span class="lineno">  305 </span><span class="spaces">               </span><span class="istickedoff">= <span class="nottickedoff">return ((VPoint r1 r2 r3) : stk)</span></span>
+<span class="lineno">  306 </span><span class="spaces"> </span><span class="istickedoff">-- here, you could have an (AbsPoint :: AbsObj) which you put on the</span>
+<span class="lineno">  307 </span><span class="spaces"> </span><span class="istickedoff">-- stack, with any object in the three fields.</span>
+<span class="lineno">  308 </span><span class="spaces"></span><span class="istickedoff">doAbsOp _ op _ = err <span class="nottickedoff">(&quot;operator not understood (&quot; ++ show op ++ &quot;)&quot;)</span></span></span>
+<span class="lineno">  309 </span>
+<span class="lineno">  310 </span>------------------------------------------------------------------------------
+<span class="lineno">  311 </span>-- Driver
+<span class="lineno">  312 </span>
+<span class="lineno">  313 </span>mainEval :: Code -&gt; IO ()
+<span class="lineno">  314 </span><span class="decl"><span class="istickedoff">mainEval prog = do { stk &lt;- eval (State <span class="nottickedoff">emptyEnv</span> [] prog) </span>
+<span class="lineno">  315 </span><span class="spaces">                   </span><span class="istickedoff">; return <span class="nottickedoff">()</span></span>
+<span class="lineno">  316 </span><span class="spaces">                   </span><span class="istickedoff">}</span></span>
+<span class="lineno">  317 </span>{- 
+<span class="lineno">  318 </span>  * Oops, one of the example actually has something
+<span class="lineno">  319 </span>  * on the stack at the end. 
+<span class="lineno">  320 </span>  * Oh well...
+<span class="lineno">  321 </span>                  ; if null stk
+<span class="lineno">  322 </span>                     then return ()
+<span class="lineno">  323 </span>                    else do { putStrLn done
+<span class="lineno">  324 </span>                             ; print stk
+<span class="lineno">  325 </span>                             }
+<span class="lineno">  326 </span>-}
+<span class="lineno">  327 </span>
+<span class="lineno">  328 </span><span class="decl"><span class="nottickedoff">done = &quot;Items still on stack at (successfull) termination of program&quot;</span></span>
+<span class="lineno">  329 </span>
+<span class="lineno">  330 </span>------------------------------------------------------------------------------
+<span class="lineno">  331 </span>-- testing
+<span class="lineno">  332 </span>
+<span class="lineno">  333 </span>test :: String -&gt; Pure Stack
+<span class="lineno">  334 </span><span class="decl"><span class="nottickedoff">test is = eval (State emptyEnv [] (rayParse is))</span></span>
+<span class="lineno">  335 </span>
+<span class="lineno">  336 </span>testF :: String -&gt; IO Stack
+<span class="lineno">  337 </span><span class="decl"><span class="nottickedoff">testF is = do prog &lt;- rayParseF is</span>
+<span class="lineno">  338 </span><span class="spaces">              </span><span class="nottickedoff">eval (State emptyEnv [] prog)</span></span>
+<span class="lineno">  339 </span>
+<span class="lineno">  340 </span>testA :: String -&gt; Either String (Stack,Int)
+<span class="lineno">  341 </span><span class="decl"><span class="nottickedoff">testA is = case runAbs (eval (State emptyEnv </span>
+<span class="lineno">  342 </span><span class="spaces">                                    </span><span class="nottickedoff">[VAbsObj AbsFACE,VAbsObj AbsU,VAbsObj AbsV]</span>
+<span class="lineno">  343 </span><span class="spaces">                                    </span><span class="nottickedoff">(rayParse is))) 100 of</span>
+<span class="lineno">  344 </span><span class="spaces">             </span><span class="nottickedoff">AbsState a n -&gt; Right (a,n)</span>
+<span class="lineno">  345 </span><span class="spaces">             </span><span class="nottickedoff">AbsFail m -&gt; Left m</span></span>
+<span class="lineno">  346 </span>
+<span class="lineno">  347 </span><span class="decl"><span class="nottickedoff">abstest1 = &quot;1.0 0.0 0.0 point /red { /v /u /face red 1.0 0.0 1.0 } apply&quot;</span></span> 
+<span class="lineno">  348 </span>
+<span class="lineno">  349 </span>-- should be [3:: Int]
+<span class="lineno">  350 </span><span class="decl"><span class="nottickedoff">et1 = test &quot;1 /x { x } /f 2 /x f apply x addi&quot;</span></span>
 <span class="lineno">  351 </span>
 <span class="lineno">  351 </span>
-<span class="lineno">  352 </span>-------------------
-<span class="lineno">  353 </span>-- Solving quadratics
-<span class="lineno">  354 </span>-------------------
+<span class="lineno">  352 </span>
+<span class="lineno">  353 </span>
+<span class="lineno">  354 </span>
 <span class="lineno">  355 </span>
 <span class="lineno">  355 </span>
-<span class="lineno">  356 </span>quadratic :: Double -&gt; Double -&gt; Double -&gt; Maybe (Double, Double)
-<span class="lineno">  357 </span><span class="decl"><span class="nottickedoff">quadratic a b c =</span>
-<span class="lineno">  358 </span><span class="spaces">  </span><span class="nottickedoff">-- Solve the equation ax^2 + bx + c = 0 by using the quadratic formula.</span>
-<span class="lineno">  359 </span><span class="spaces">  </span><span class="nottickedoff">let d = sq b - 4 * a * c</span>
-<span class="lineno">  360 </span><span class="spaces">      </span><span class="nottickedoff">d' = if d `near` 0 then 0 else d</span>
-<span class="lineno">  361 </span><span class="spaces">  </span><span class="nottickedoff">in if d' &lt; 0</span>
-<span class="lineno">  362 </span><span class="spaces">     </span><span class="nottickedoff">then Nothing -- There are no real roots.</span>
-<span class="lineno">  363 </span><span class="spaces">     </span><span class="nottickedoff">else</span>
-<span class="lineno">  364 </span><span class="spaces">        </span><span class="nottickedoff">if a &gt; 0 then Just (((-b) - sqrt d') / (2 * a),</span>
-<span class="lineno">  365 </span><span class="spaces">                            </span><span class="nottickedoff">((-b) + sqrt d') / (2 * a))</span>
-<span class="lineno">  366 </span><span class="spaces">                 </span><span class="nottickedoff">else Just (((-b) + sqrt d') / (2 * a),</span>
-<span class="lineno">  367 </span><span class="spaces">                            </span><span class="nottickedoff">((-b) - sqrt d') / (2 * a))</span></span>
-<span class="lineno">  368 </span>
-<span class="lineno">  369 </span>-------------------
-<span class="lineno">  370 </span>-- Bounding boxes
-<span class="lineno">  371 </span>-------------------
-<span class="lineno">  372 </span>
-<span class="lineno">  373 </span>data MaybeInterval = Interval !Double !Double 
-<span class="lineno">  374 </span>                  | NoInterval
+
+</pre>
+</html>
+Writing: Data.hs.html
+<html><style type="text/css">
+span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
+span.nottickedoff { background: yellow}
+span.istickedoff { background: white }
+span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
+span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
+span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
+span.decl { font-weight: bold }
+span.spaces    { background: white }
+</style>
+<pre>
+<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
+<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
+<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
+<span class="lineno">    4 </span>-- which is included in the distribution.
+<span class="lineno">    5 </span>
+<span class="lineno">    6 </span>module Data where
+<span class="lineno">    7 </span>
+<span class="lineno">    8 </span>import Array
+<span class="lineno">    9 </span>
+<span class="lineno">   10 </span>import CSG      
+<span class="lineno">   11 </span>import Geometry
+<span class="lineno">   12 </span>import Illumination
+<span class="lineno">   13 </span>import Primitives
+<span class="lineno">   14 </span>import Surface
+<span class="lineno">   15 </span>
+<span class="lineno">   16 </span>import Debug.Trace
+<span class="lineno">   17 </span>
+<span class="lineno">   18 </span>-- Now the parsed (expresssion) language
+<span class="lineno">   19 </span>
+<span class="lineno">   20 </span>type Name = String
+<span class="lineno">   21 </span>
+<span class="lineno">   22 </span>type Code = [GMLToken]
+<span class="lineno">   23 </span>
+<span class="lineno">   24 </span>data GMLToken
+<span class="lineno">   25 </span>    -- All these can occur in parsed code
+<span class="lineno">   26 </span>        = TOp     GMLOp
+<span class="lineno">   27 </span>        | TId     Name
+<span class="lineno">   28 </span>        | TBind   Name
+<span class="lineno">   29 </span>        | TBool   Bool
+<span class="lineno">   30 </span>        | TInt    Int
+<span class="lineno">   31 </span>        | TReal   Double
+<span class="lineno">   32 </span>        | TString String
+<span class="lineno">   33 </span>        | TBody   Code
+<span class="lineno">   34 </span>        | TArray  Code
+<span class="lineno">   35 </span>        | TApply
+<span class="lineno">   36 </span>        | TIf
+<span class="lineno">   37 </span>         -- These can occur in optimized/transformed code
+<span class="lineno">   38 </span>         -- NONE (yet!)
+<span class="lineno">   39 </span>
+<span class="lineno">   40 </span>
+<span class="lineno">   41 </span>instance <span class="nottickedoff">Show GMLToken</span> where
+<span class="lineno">   42 </span>   <span class="decl"><span class="nottickedoff">showsPrec p (TOp op)     = shows op</span>
+<span class="lineno">   43 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TId id)     = showString id</span>
+<span class="lineno">   44 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TBind id)   = showString ('/' : id)</span>
+<span class="lineno">   45 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TBool bool) = shows bool</span>
+<span class="lineno">   46 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TInt i)     = shows i</span>
+<span class="lineno">   47 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TReal d)    = shows d</span>
+<span class="lineno">   48 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TString s)  = shows s</span>
+<span class="lineno">   49 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TBody code) = shows code</span>
+<span class="lineno">   50 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TArray code) = showString &quot;[ &quot; </span>
+<span class="lineno">   51 </span><span class="spaces">                            </span><span class="nottickedoff">. foldr (\ a b -&gt; a . showChar ' ' . b) id (map shows code) </span>
+<span class="lineno">   52 </span><span class="spaces">                            </span><span class="nottickedoff">. showString &quot;]&quot;</span>
+<span class="lineno">   53 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TApply)     = showString &quot;apply&quot; </span>
+<span class="lineno">   54 </span><span class="spaces">   </span><span class="nottickedoff">showsPrec p (TIf)        = showString &quot;if&quot;</span></span> 
+<span class="lineno">   55 </span>
+<span class="lineno">   56 </span>   <span class="decl"><span class="nottickedoff">showList  code = showString &quot;{ &quot; </span>
+<span class="lineno">   57 </span><span class="spaces">                  </span><span class="nottickedoff">. foldr (\ a b -&gt; a . showChar ' ' . b) id (map shows code) </span>
+<span class="lineno">   58 </span><span class="spaces">                  </span><span class="nottickedoff">. showString &quot;}&quot;</span></span>
+<span class="lineno">   59 </span>
+<span class="lineno">   60 </span>
+<span class="lineno">   61 </span>-- Now the value language, used inside the interpreter
+<span class="lineno">   62 </span>
+<span class="lineno">   63 </span>type Stack = [GMLValue]
+<span class="lineno">   64 </span>
+<span class="lineno">   65 </span>data GMLValue
+<span class="lineno">   66 </span>        = VBool    !Bool
+<span class="lineno">   67 </span>        | VInt     !Int
+<span class="lineno">   68 </span>        | VReal    !Double
+<span class="lineno">   69 </span>        | VString  String
+<span class="lineno">   70 </span>        | VClosure Env Code
+<span class="lineno">   71 </span>        | VArray   (Array Int GMLValue)               -- FIXME: Haskell array
+<span class="lineno">   72 </span>        -- uses the interpreter version of point
+<span class="lineno">   73 </span>        | VPoint   { xPoint :: !Double
+<span class="lineno">   74 </span>                   , yPoint :: !Double 
+<span class="lineno">   75 </span>                   , zPoint :: !Double 
+<span class="lineno">   76 </span>                   } 
+<span class="lineno">   77 </span>        -- these are abstract to the interpreter
+<span class="lineno">   78 </span>        | VObject  Object
+<span class="lineno">   79 </span>        | VLight   Light 
+<span class="lineno">   80 </span>        -- This is an abstract object, used by the abstract interpreter
+<span class="lineno">   81 </span>        | VAbsObj  AbsObj
+<span class="lineno">   82 </span>
+<span class="lineno">   83 </span>
+<span class="lineno">   84 </span>-- There are only *3* basic abstract values,
+<span class="lineno">   85 </span>-- and the combinators also.
+<span class="lineno">   86 </span>
+<span class="lineno">   87 </span>data AbsObj 
+<span class="lineno">   88 </span>    = AbsFACE 
+<span class="lineno">   89 </span>    | AbsU 
+<span class="lineno">   90 </span>    | AbsV
+<span class="lineno">   91 </span>      deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>)
+<span class="lineno">   92 </span>
+<span class="lineno">   93 </span>instance Show GMLValue where
+<span class="lineno">   94 </span>   <span class="decl"><span class="nottickedoff">showsPrec p value = showString (showStkEle value)</span></span>
+<span class="lineno">   95 </span>
+<span class="lineno">   96 </span>showStkEle :: GMLValue -&gt; String
+<span class="lineno">   97 </span><span class="decl"><span class="nottickedoff">showStkEle (VBool b)      = show b ++ &quot; :: Bool&quot;</span>
+<span class="lineno">   98 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VInt i)       = show i ++ &quot; :: Int&quot;</span>
+<span class="lineno">   99 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VReal r)      = show r ++ &quot; :: Real&quot;</span>
+<span class="lineno">  100 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VString s)    = show s ++ &quot; :: String&quot;</span>
+<span class="lineno">  101 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VClosure {})  = &quot;&lt;closure&gt; :: Closure&quot;</span>
+<span class="lineno">  102 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VArray arr)   </span>
+<span class="lineno">  103 </span><span class="spaces">     </span><span class="nottickedoff">= &quot;&lt;array (&quot; ++  show (succ (snd (bounds arr))) ++ &quot; elements)&gt; :: Array&quot;</span>
+<span class="lineno">  104 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VPoint x y z) = &quot;(&quot; ++ show x </span>
+<span class="lineno">  105 </span><span class="spaces">                         </span><span class="nottickedoff">++ &quot;,&quot; ++ show y</span>
+<span class="lineno">  106 </span><span class="spaces">                         </span><span class="nottickedoff">++ &quot;,&quot; ++ show z</span>
+<span class="lineno">  107 </span><span class="spaces">                         </span><span class="nottickedoff">++ &quot;) :: Point&quot;</span>
+<span class="lineno">  108 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VObject {})   = &quot;&lt;Object&gt; :: Object&quot;</span>
+<span class="lineno">  109 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VLight {})    = &quot;&lt;Light&gt; :: Object&quot;</span>
+<span class="lineno">  110 </span><span class="spaces"></span><span class="nottickedoff">showStkEle (VAbsObj vobs) = &quot;{{ &quot; ++ show vobs ++ &quot;}} :: AbsObj&quot;</span></span>
+<span class="lineno">  111 </span>
+<span class="lineno">  112 </span>-- An abstract environment
+<span class="lineno">  113 </span>
+<span class="lineno">  114 </span>newtype Env = Env [(Name, GMLValue)] deriving <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>
+<span class="lineno">  115 </span>
+<span class="lineno">  116 </span>emptyEnv :: Env
+<span class="lineno">  117 </span><span class="decl"><span class="nottickedoff">emptyEnv = Env []</span></span>
+<span class="lineno">  118 </span>
+<span class="lineno">  119 </span>extendEnv :: Env -&gt; Name -&gt; GMLValue -&gt; Env
+<span class="lineno">  120 </span><span class="decl"><span class="istickedoff">extendEnv (Env e) n v = Env ((n, v):e)</span></span>
+<span class="lineno">  121 </span>
+<span class="lineno">  122 </span>lookupEnv :: Env -&gt; Name -&gt; Maybe GMLValue
+<span class="lineno">  123 </span><span class="decl"><span class="istickedoff">lookupEnv (Env e) n = lookup n e</span></span>
+<span class="lineno">  124 </span>
+<span class="lineno">  125 </span>-- All primitive operators
+<span class="lineno">  126 </span>-- 
+<span class="lineno">  127 </span>-- There is no Op_apply, Op_false, Op_true and Op_if
+<span class="lineno">  128 </span>-- (because they appear explcitly in the rules).
+<span class="lineno">  129 </span>
+<span class="lineno">  130 </span>data GMLOp
+<span class="lineno">  131 </span>   = Op_acos
+<span class="lineno">  132 </span>   | Op_addi
+<span class="lineno">  133 </span>   | Op_addf
+<span class="lineno">  134 </span>   | Op_asin
+<span class="lineno">  135 </span>   | Op_clampf
+<span class="lineno">  136 </span>   | Op_cone
+<span class="lineno">  137 </span>   | Op_cos
+<span class="lineno">  138 </span>   | Op_cube
+<span class="lineno">  139 </span>   | Op_cylinder
+<span class="lineno">  140 </span>   | Op_difference
+<span class="lineno">  141 </span>   | Op_divi
+<span class="lineno">  142 </span>   | Op_divf
+<span class="lineno">  143 </span>   | Op_eqi
+<span class="lineno">  144 </span>   | Op_eqf
+<span class="lineno">  145 </span>   | Op_floor
+<span class="lineno">  146 </span>   | Op_frac
+<span class="lineno">  147 </span>   | Op_get
+<span class="lineno">  148 </span>   | Op_getx
+<span class="lineno">  149 </span>   | Op_gety
+<span class="lineno">  150 </span>   | Op_getz
+<span class="lineno">  151 </span>   | Op_intersect
+<span class="lineno">  152 </span>   | Op_length
+<span class="lineno">  153 </span>   | Op_lessi
+<span class="lineno">  154 </span>   | Op_lessf
+<span class="lineno">  155 </span>   | Op_light
+<span class="lineno">  156 </span>   | Op_modi
+<span class="lineno">  157 </span>   | Op_muli
+<span class="lineno">  158 </span>   | Op_mulf
+<span class="lineno">  159 </span>   | Op_negi
+<span class="lineno">  160 </span>   | Op_negf
+<span class="lineno">  161 </span>   | Op_plane
+<span class="lineno">  162 </span>   | Op_point
+<span class="lineno">  163 </span>   | Op_pointlight
+<span class="lineno">  164 </span>   | Op_real
+<span class="lineno">  165 </span>   | Op_render
+<span class="lineno">  166 </span>   | Op_rotatex
+<span class="lineno">  167 </span>   | Op_rotatey
+<span class="lineno">  168 </span>   | Op_rotatez
+<span class="lineno">  169 </span>   | Op_scale
+<span class="lineno">  170 </span>   | Op_sin
+<span class="lineno">  171 </span>   | Op_sphere
+<span class="lineno">  172 </span>   | Op_spotlight
+<span class="lineno">  173 </span>   | Op_sqrt
+<span class="lineno">  174 </span>   | Op_subi
+<span class="lineno">  175 </span>   | Op_subf
+<span class="lineno">  176 </span>   | Op_trace       -- non standard, for debugging GML programs
+<span class="lineno">  177 </span>   | Op_translate
+<span class="lineno">  178 </span>   | Op_union
+<span class="lineno">  179 </span>   | Op_uscale
+<span class="lineno">  180 </span>    deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Eq</span></span></span></span>,<span class="nottickedoff"><span class="decl"><span class="nottickedoff">Ord</span></span></span>,<span class="decl"><span class="nottickedoff"><span class="decl"><span class="istickedoff"><span class="decl"><span class="istickedoff">Ix</span></span></span></span></span></span>,<span class="decl"><span class="istickedoff"><span class="decl"><span class="istickedoff">Bounded</span></span></span></span>)
+<span class="lineno">  181 </span>
+<span class="lineno">  182 </span>instance Show GMLOp where
+<span class="lineno">  183 </span>   <span class="decl"><span class="nottickedoff">showsPrec _ op = showString (opNameTable ! op)</span></span>
+<span class="lineno">  184 </span>
+<span class="lineno">  185 </span>
+<span class="lineno">  186 </span>------------------------------------------------------------------------------
+<span class="lineno">  187 </span>
+<span class="lineno">  188 </span>-- And how we use the op codes (there names, there interface)
+<span class="lineno">  189 </span>
+<span class="lineno">  190 </span>-- These keywords include, &quot;apply&quot;, &quot;if&quot;, &quot;true&quot; and &quot;false&quot;,
+<span class="lineno">  191 </span>-- they are not parsed as operators, but are
+<span class="lineno">  192 </span>-- captured by the parser as a special case.
+<span class="lineno">  193 </span>
+<span class="lineno">  194 </span>keyWords :: [String]
+<span class="lineno">  195 </span><span class="decl"><span class="nottickedoff">keyWords = [ kwd | (kwd,_,_) &lt;- opcodes ]</span></span>
+<span class="lineno">  196 </span>
+<span class="lineno">  197 </span>-- Lookup has to look from the start (or else...)
+<span class="lineno">  198 </span>opTable :: [(Name,GMLToken)]
+<span class="lineno">  199 </span><span class="decl"><span class="istickedoff">opTable = [ (kwd,op) | (kwd,op,_) &lt;- opcodes ]</span></span>
+<span class="lineno">  200 </span>
+<span class="lineno">  201 </span>opNameTable :: Array GMLOp Name
+<span class="lineno">  202 </span><span class="decl"><span class="nottickedoff">opNameTable = array (minBound,maxBound) </span>
+<span class="lineno">  203 </span><span class="spaces">                  </span><span class="nottickedoff">[ (op,name) | (name,TOp op,_) &lt;- opcodes ]</span></span>
+<span class="lineno">  204 </span>
+<span class="lineno">  205 </span><span class="decl"><span class="nottickedoff">undef = error &quot;undefined function&quot;</span></span>
+<span class="lineno">  206 </span><span class="decl"><span class="nottickedoff">image = error &quot;undefined function: talk to image group&quot;</span></span>
+<span class="lineno">  207 </span>
+<span class="lineno">  208 </span>-- typically, its best to have *one* opcode table,
+<span class="lineno">  209 </span>-- so that mis-alignments do not happen.
+<span class="lineno">  210 </span>
+<span class="lineno">  211 </span>opcodes :: [(String,GMLToken,PrimOp)]
+<span class="lineno">  212 </span><span class="decl"><span class="istickedoff">opcodes =</span>
+<span class="lineno">  213 </span><span class="spaces"> </span><span class="istickedoff">[ (&quot;apply&quot;,      TApply,           <span class="nottickedoff">error &quot;incorrect use of apply&quot;</span>)</span>
+<span class="lineno">  214 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;if&quot;,         TIf,                   <span class="nottickedoff">error &quot;incorrect use of if&quot;</span>)</span>
+<span class="lineno">  215 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;false&quot;,      TBool <span class="nottickedoff">False</span>,        <span class="nottickedoff">error &quot;incorrect use of false&quot;</span>)</span>
+<span class="lineno">  216 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;true&quot;,       TBool <span class="nottickedoff">True</span>,            <span class="nottickedoff">error &quot;incorrect use of true&quot;</span>)</span>
+<span class="lineno">  217 </span><span class="spaces"> </span><span class="istickedoff">] ++ map (\ (a,b,c) -&gt; (a,TOp b,c))</span>
+<span class="lineno">  218 </span><span class="spaces">   </span><span class="istickedoff">-- These are just invocation, any coersions need to occur between here</span>
+<span class="lineno">  219 </span><span class="spaces">   </span><span class="istickedoff">-- and before arriving at the application code (like deg -&gt; rad).</span>
+<span class="lineno">  220 </span><span class="spaces"> </span><span class="istickedoff">[ (&quot;acos&quot;,       Op_acos,   <span class="nottickedoff">Real_Real (rad2deg . acos)</span>)</span>
+<span class="lineno">  221 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;addi&quot;,       Op_addi,   <span class="nottickedoff">Int_Int_Int (+)</span>)</span>
+<span class="lineno">  222 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;addf&quot;,       Op_addf,   Real_Real_Real (+))</span>
+<span class="lineno">  223 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;asin&quot;,       Op_asin,   <span class="nottickedoff">Real_Real (rad2deg . asin)</span>)</span>
+<span class="lineno">  224 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;clampf&quot;,     Op_clampf,       <span class="nottickedoff">Real_Real clampf</span>)</span>
+<span class="lineno">  225 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;cone&quot;,       Op_cone,   <span class="nottickedoff">Surface_Obj cone</span>)</span>
+<span class="lineno">  226 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;cos&quot;,        Op_cos,     <span class="nottickedoff">Real_Real (cos . deg2rad)</span>)</span>
+<span class="lineno">  227 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;cube&quot;,       Op_cube,   Surface_Obj cube)</span>
+<span class="lineno">  228 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;cylinder&quot;,   Op_cylinder,   <span class="nottickedoff">Surface_Obj cylinder</span>)</span>
+<span class="lineno">  229 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;difference&quot;, Op_difference, <span class="nottickedoff">Obj_Obj_Obj difference</span>)</span>
+<span class="lineno">  230 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;divi&quot;,       Op_divi,   <span class="nottickedoff">Int_Int_Int (ourQuot)</span>)</span>
+<span class="lineno">  231 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;divf&quot;,       Op_divf,   Real_Real_Real (/))</span>
+<span class="lineno">  232 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;eqi&quot;,        Op_eqi,     Int_Int_Bool (==))</span>
+<span class="lineno">  233 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;eqf&quot;,        Op_eqf,     <span class="nottickedoff">Real_Real_Bool (==)</span>)</span>
+<span class="lineno">  234 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;floor&quot;,      Op_floor,         Real_Int floor)</span>
+<span class="lineno">  235 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;frac&quot;,       Op_frac,   Real_Real (snd . properFraction))</span>
+<span class="lineno">  236 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;get&quot;,        Op_get,     Arr_Int_Value ixGet)</span>
+<span class="lineno">  237 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;getx&quot;,       Op_getx,   <span class="nottickedoff">Point_Real (\ x y z -&gt; x)</span>)</span>
+<span class="lineno">  238 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;gety&quot;,       Op_gety,   <span class="nottickedoff">Point_Real (\ x y z -&gt; y)</span>)</span>
+<span class="lineno">  239 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;getz&quot;,       Op_getz,   <span class="nottickedoff">Point_Real (\ x y z -&gt; z)</span>)</span>
+<span class="lineno">  240 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;intersect&quot;,  Op_intersect,  <span class="nottickedoff">Obj_Obj_Obj intersect</span>)</span>
+<span class="lineno">  241 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;length&quot;,     Op_length,       <span class="nottickedoff">Arr_Int (succ . snd . bounds)</span>)</span>
+<span class="lineno">  242 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;lessi&quot;,      Op_lessi,         <span class="nottickedoff">Int_Int_Bool (&lt;)</span>)</span>
+<span class="lineno">  243 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;lessf&quot;,      Op_lessf,         Real_Real_Bool (&lt;))</span>
+<span class="lineno">  244 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;light&quot;,      Op_light,         Point_Color_Light light)</span>
+<span class="lineno">  245 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;modi&quot;,       Op_modi,   Int_Int_Int (ourRem))</span>
+<span class="lineno">  246 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;muli&quot;,       Op_muli,   <span class="nottickedoff">Int_Int_Int (*)</span>)</span>
+<span class="lineno">  247 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;mulf&quot;,       Op_mulf,   Real_Real_Real (*))</span>
+<span class="lineno">  248 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;negi&quot;,       Op_negi,   <span class="nottickedoff">Int_Int negate</span>)</span>
+<span class="lineno">  249 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;negf&quot;,       Op_negf,   <span class="nottickedoff">Real_Real negate</span>)</span>
+<span class="lineno">  250 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;plane&quot;,      Op_plane,         Surface_Obj plane)</span>
+<span class="lineno">  251 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;point&quot;,      Op_point,         Real_Real_Real_Point VPoint)</span>
+<span class="lineno">  252 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;pointlight&quot;, Op_pointlight, <span class="nottickedoff">Point_Color_Light pointlight</span>)</span>
+<span class="lineno">  253 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;real&quot;,       Op_real,   Int_Real fromIntegral)</span>
+<span class="lineno">  254 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;render&quot;,     Op_render,       Render $ render eye)</span>
+<span class="lineno">  255 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;rotatex&quot;,    Op_rotatex,     Obj_Real_Obj (\ o d -&gt; rotateX (deg2rad d) o))</span>
+<span class="lineno">  256 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;rotatey&quot;,    Op_rotatey,     Obj_Real_Obj (\ o d -&gt; rotateY (deg2rad d) o)) </span>
+<span class="lineno">  257 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;rotatez&quot;,    Op_rotatez,     <span class="nottickedoff">Obj_Real_Obj (\ o d -&gt; rotateZ (deg2rad d) o)</span>)</span>
+<span class="lineno">  258 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;scale&quot;,      Op_scale,         <span class="nottickedoff">Obj_Real_Real_Real_Obj (\ o x y z -&gt; scale (x,y,z) o)</span>)</span>
+<span class="lineno">  259 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;sin&quot;,        Op_sin,     <span class="nottickedoff">Real_Real (sin . deg2rad)</span>)</span>
+<span class="lineno">  260 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;sphere&quot;,     Op_sphere,       <span class="nottickedoff">Surface_Obj sphere'</span>) -- see comment at end of file</span>
+<span class="lineno">  261 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;spotlight&quot;,  Op_spotlight,  <span class="nottickedoff">Point_Point_Color_Real_Real_Light mySpotlight</span>)</span>
+<span class="lineno">  262 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;sqrt&quot;,       Op_sqrt,   <span class="nottickedoff">Real_Real ourSqrt</span>)</span>
+<span class="lineno">  263 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;subi&quot;,       Op_subi,   <span class="nottickedoff">Int_Int_Int (-)</span>)</span>
+<span class="lineno">  264 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;subf&quot;,       Op_subf,   <span class="nottickedoff">Real_Real_Real (-)</span>)</span>
+<span class="lineno">  265 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;trace&quot;,      Op_trace,      <span class="nottickedoff">Value_String_Value mytrace</span>)</span>
+<span class="lineno">  266 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;translate&quot;,  Op_translate,  Obj_Real_Real_Real_Obj (\ o x y z -&gt; translate (x,y,z) o))</span>
+<span class="lineno">  267 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;union&quot;,      Op_union,         Obj_Obj_Obj union)</span>
+<span class="lineno">  268 </span><span class="spaces"> </span><span class="istickedoff">, (&quot;uscale&quot;,     Op_uscale,       Obj_Real_Obj (\ o r -&gt; uscale r o))</span>
+<span class="lineno">  269 </span><span class="spaces"> </span><span class="istickedoff">]</span></span>
+<span class="lineno">  270 </span>
+<span class="lineno">  271 </span>-- This enumerate all possible ways of calling the fixed primitives
+<span class="lineno">  272 </span>
+<span class="lineno">  273 </span>-- The datatype captures the type at the *interp* level,
+<span class="lineno">  274 </span>-- the type of the functional is mirrored on this (using Haskell types).
+<span class="lineno">  275 </span>
+<span class="lineno">  276 </span>data PrimOp
+<span class="lineno">  277 </span>
+<span class="lineno">  278 </span>    -- 1 argument 
+<span class="lineno">  279 </span>    = Int_Int         (Int -&gt; Int)
+<span class="lineno">  280 </span>    | Real_Real       (Double -&gt; Double)
+<span class="lineno">  281 </span>    | Point_Real      (Double -&gt; Double -&gt; Double -&gt; Double)
+<span class="lineno">  282 </span>    | Surface_Obj     (SurfaceFn Color Double -&gt; Object)
+<span class="lineno">  283 </span>    | Real_Int        (Double -&gt; Int)
+<span class="lineno">  284 </span>    | Int_Real        (Int -&gt; Double)
+<span class="lineno">  285 </span>    | Arr_Int         (Array Int GMLValue -&gt; Int)
+<span class="lineno">  286 </span>
+<span class="lineno">  287 </span>    -- 2 arguments 
+<span class="lineno">  288 </span>    | Int_Int_Int     (Int -&gt; Int -&gt; Int)
+<span class="lineno">  289 </span>    | Int_Int_Bool    (Int -&gt; Int -&gt; Bool)
+<span class="lineno">  290 </span>    | Real_Real_Real  (Double -&gt; Double -&gt; Double)
+<span class="lineno">  291 </span>    | Real_Real_Bool  (Double -&gt; Double -&gt; Bool)
+<span class="lineno">  292 </span>    | Arr_Int_Value   (Array Int GMLValue -&gt; Int -&gt; GMLValue)
+<span class="lineno">  293 </span>
+<span class="lineno">  294 </span>    -- Many arguments, typically image mangling
+<span class="lineno">  295 </span>
+<span class="lineno">  296 </span>    | Obj_Obj_Obj            (Object -&gt; Object -&gt; Object)
+<span class="lineno">  297 </span>    | Point_Color_Light      (Coords -&gt; Color -&gt; Light)
+<span class="lineno">  298 </span>    | Real_Real_Real_Point   (Double -&gt; Double -&gt; Double -&gt; GMLValue)
+<span class="lineno">  299 </span>    | Obj_Real_Obj           (Object -&gt; Double -&gt; Object)
+<span class="lineno">  300 </span>    | Obj_Real_Real_Real_Obj (Object -&gt; Double -&gt; Double -&gt; Double -&gt; Object)
+<span class="lineno">  301 </span>    | Value_String_Value     (GMLValue -&gt; String -&gt; GMLValue)
+<span class="lineno">  302 </span>
+<span class="lineno">  303 </span>    | Point_Point_Color_Real_Real_Light 
+<span class="lineno">  304 </span>                             (Coords -&gt; Coords -&gt; Color -&gt; Radian -&gt; Radian -&gt; Light)
+<span class="lineno">  305 </span>    -- And finally render
+<span class="lineno">  306 </span>    | Render                 (Color -&gt; [Light] -&gt; Object -&gt; Int -&gt; Double -&gt; Int -&gt; Int -&gt; String -&gt; IO ())
+<span class="lineno">  307 </span>
+<span class="lineno">  308 </span>data Type 
+<span class="lineno">  309 </span>    = TyBool 
+<span class="lineno">  310 </span>    | TyInt 
+<span class="lineno">  311 </span>    | TyReal 
+<span class="lineno">  312 </span>    | TyString 
+<span class="lineno">  313 </span>    | TyCode 
+<span class="lineno">  314 </span>    | TyArray 
+<span class="lineno">  315 </span>    | TyPoint 
+<span class="lineno">  316 </span>    | TyObject 
+<span class="lineno">  317 </span>    | TyLight
+<span class="lineno">  318 </span>    | TyAlpha
+<span class="lineno">  319 </span>    | TyAbsObj
+<span class="lineno">  320 </span>      deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Eq</span></span></span></span>,<span class="nottickedoff"><span class="decl"><span class="nottickedoff">Ord</span></span></span>,<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Ix</span></span></span></span></span></span>,<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Bounded</span></span></span></span>)
+<span class="lineno">  321 </span>
+<span class="lineno">  322 </span><span class="decl"><span class="nottickedoff">typeTable = </span>
+<span class="lineno">  323 </span><span class="spaces">  </span><span class="nottickedoff">[ ( TyBool,   &quot;Bool&quot;)</span>
+<span class="lineno">  324 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyInt,    &quot;Int&quot;)</span>
+<span class="lineno">  325 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyReal,   &quot;Real&quot;)</span>
+<span class="lineno">  326 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyString, &quot;String&quot;)</span>
+<span class="lineno">  327 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyCode,   &quot;Code&quot;)</span>
+<span class="lineno">  328 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyArray,  &quot;Array&quot;)</span>
+<span class="lineno">  329 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyPoint,  &quot;Point&quot;)</span>
+<span class="lineno">  330 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyObject, &quot;Object&quot;)</span>
+<span class="lineno">  331 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyLight,  &quot;Light&quot;)</span>
+<span class="lineno">  332 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyAlpha,  &quot;&lt;anything&gt;&quot;)</span>
+<span class="lineno">  333 </span><span class="spaces">  </span><span class="nottickedoff">, ( TyAbsObj, &quot;&lt;abs&gt;&quot;)</span>
+<span class="lineno">  334 </span><span class="spaces">  </span><span class="nottickedoff">]</span></span>
+<span class="lineno">  335 </span>
+<span class="lineno">  336 </span><span class="decl"><span class="nottickedoff">typeNames = array (minBound,maxBound) typeTable</span></span>
+<span class="lineno">  337 </span>
+<span class="lineno">  338 </span>instance Show Type where
+<span class="lineno">  339 </span>   <span class="decl"><span class="nottickedoff">showsPrec _ op = showString (typeNames ! op)</span></span>
+<span class="lineno">  340 </span>
+<span class="lineno">  341 </span>getPrimOpType :: PrimOp -&gt; [Type]
+<span class="lineno">  342 </span><span class="decl"><span class="nottickedoff">getPrimOpType (Int_Int         _) = [TyInt]</span>
+<span class="lineno">  343 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Real       _) = [TyReal]</span>
+<span class="lineno">  344 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Point_Real      _) = [TyPoint]</span>
+<span class="lineno">  345 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Surface_Obj     _) = [TyCode]</span>
+<span class="lineno">  346 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Int        _) = [TyReal]</span>
+<span class="lineno">  347 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Int_Real        _) = [TyInt]</span>
+<span class="lineno">  348 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Arr_Int         _) = [TyArray]</span>
+<span class="lineno">  349 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Int_Int_Int     _) = [TyInt,TyInt]</span>
+<span class="lineno">  350 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Int_Int_Bool    _) = [TyInt,TyInt]</span>
+<span class="lineno">  351 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Real_Real  _) = [TyReal,TyReal]</span>
+<span class="lineno">  352 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Real_Bool  _) = [TyReal,TyReal]</span>
+<span class="lineno">  353 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Arr_Int_Value   _) = [TyArray,TyInt]</span>
+<span class="lineno">  354 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Obj_Obj_Obj            _) = [TyObject,TyObject]</span>
+<span class="lineno">  355 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Point_Color_Light      _) = [TyPoint,TyPoint]</span>
+<span class="lineno">  356 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Real_Real_Real_Point   _) = [TyReal,TyReal,TyReal]</span>
+<span class="lineno">  357 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Obj_Real_Obj           _) = [TyObject,TyReal]</span>
+<span class="lineno">  358 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Obj_Real_Real_Real_Obj _) = [TyObject,TyReal,TyReal,TyReal]</span>
+<span class="lineno">  359 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Value_String_Value     _) = [TyAlpha,TyString]</span>
+<span class="lineno">  360 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Point_Point_Color_Real_Real_Light _) </span>
+<span class="lineno">  361 </span><span class="spaces">                                         </span><span class="nottickedoff">= [TyPoint,TyPoint,TyPoint,TyReal,TyReal]</span>
+<span class="lineno">  362 </span><span class="spaces"></span><span class="nottickedoff">getPrimOpType (Render                 _) = [TyPoint,</span>
+<span class="lineno">  363 </span><span class="spaces">                                            </span><span class="nottickedoff">TyLight,</span>
+<span class="lineno">  364 </span><span class="spaces">                                            </span><span class="nottickedoff">TyObject,</span>
+<span class="lineno">  365 </span><span class="spaces">                                            </span><span class="nottickedoff">TyInt,</span>
+<span class="lineno">  366 </span><span class="spaces">                                            </span><span class="nottickedoff">TyReal,</span>
+<span class="lineno">  367 </span><span class="spaces">                                            </span><span class="nottickedoff">TyReal,</span>
+<span class="lineno">  368 </span><span class="spaces">                                            </span><span class="nottickedoff">TyReal,</span>
+<span class="lineno">  369 </span><span class="spaces">                                            </span><span class="nottickedoff">TyString]</span></span>
+<span class="lineno">  370 </span>
+<span class="lineno">  371 </span>
+<span class="lineno">  372 </span>-- Some primitives with better error message
+<span class="lineno">  373 </span>
+<span class="lineno">  374 </span><span class="decl"><span class="nottickedoff">mytrace v s = trace (s ++&quot; : &quot;++ show v ++ &quot;\n&quot;) v</span></span>
 <span class="lineno">  375 </span>
 <span class="lineno">  375 </span>
-<span class="lineno">  376 </span><span class="decl"><span class="istickedoff">isInterval (Interval _ _) = True</span>
-<span class="lineno">  377 </span><span class="spaces"></span><span class="istickedoff">isInterval _              = False</span></span>
-<span class="lineno">  378 </span>
-<span class="lineno">  379 </span>intersectWithBox :: Ray -&gt; Box -&gt; Bool
-<span class="lineno">  380 </span><span class="decl"><span class="istickedoff">intersectWithBox (r, v) (B x1 x2 y1 y2 z1 z2)</span>
-<span class="lineno">  381 </span><span class="spaces">  </span><span class="istickedoff">= isInterval interval</span>
-<span class="lineno">  382 </span><span class="spaces">  </span><span class="istickedoff">where x_interval = intersectRayWithSlab (xCoord r) (xComponent v) (x1, x2)</span>
-<span class="lineno">  383 </span><span class="spaces">        </span><span class="istickedoff">y_interval = intersectRayWithSlab (yCoord r) (yComponent v) (y1, y2)</span>
-<span class="lineno">  384 </span><span class="spaces">        </span><span class="istickedoff">z_interval = intersectRayWithSlab (zCoord r) (zComponent v) (z1, z2)</span>
-<span class="lineno">  385 </span><span class="spaces">        </span><span class="istickedoff">interval = intersectInterval x_interval</span>
-<span class="lineno">  386 </span><span class="spaces">                   </span><span class="istickedoff">(intersectInterval y_interval z_interval)</span></span>
-<span class="lineno">  387 </span>
-<span class="lineno">  388 </span>intersectInterval :: MaybeInterval -&gt; MaybeInterval -&gt; MaybeInterval
-<span class="lineno">  389 </span><span class="decl"><span class="istickedoff">intersectInterval NoInterval _ = <span class="nottickedoff">NoInterval</span></span>
-<span class="lineno">  390 </span><span class="spaces"></span><span class="istickedoff">intersectInterval _ NoInterval = NoInterval</span>
-<span class="lineno">  391 </span><span class="spaces"></span><span class="istickedoff">intersectInterval (Interval a b) (Interval c d)</span>
-<span class="lineno">  392 </span><span class="spaces">  </span><span class="istickedoff">| b &lt; c || d &lt; a = NoInterval</span>
-<span class="lineno">  393 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span> = Interval (a `max` c) (b `min` d)</span></span>
-<span class="lineno">  394 </span>
-<span class="lineno">  395 </span>{-# INLINE intersectRayWithSlab #-}
-<span class="lineno">  396 </span>intersectRayWithSlab :: Double -&gt; Double -&gt; (Double,Double) -&gt; MaybeInterval
-<span class="lineno">  397 </span><span class="decl"><span class="istickedoff">intersectRayWithSlab xCoord alpha (x1, x2)</span>
-<span class="lineno">  398 </span><span class="spaces">  </span><span class="istickedoff">| alpha == 0 = if xCoord &lt; x1 || xCoord &gt; x2 then NoInterval else infInterval</span>
-<span class="lineno">  399 </span><span class="spaces">  </span><span class="istickedoff">| alpha &gt;  0 = Interval a b</span>
-<span class="lineno">  400 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>  = Interval b a </span>
-<span class="lineno">  401 </span><span class="spaces">  </span><span class="istickedoff">where a = (x1 - xCoord) / alpha</span>
-<span class="lineno">  402 </span><span class="spaces">        </span><span class="istickedoff">b = (x2 - xCoord) / alpha</span></span>
-<span class="lineno">  403 </span>
-<span class="lineno">  404 </span><span class="decl"><span class="istickedoff">infInterval = Interval (-inf) inf</span></span>
+<span class="lineno">  376 </span>
+<span class="lineno">  377 </span>ixGet :: Array Int GMLValue -&gt; Int -&gt; GMLValue
+<span class="lineno">  378 </span><span class="decl"><span class="istickedoff">ixGet arr i</span>
+<span class="lineno">  379 </span><span class="spaces">   </span><span class="istickedoff">| <span class="tickonlytrue">inRange (bounds arr) i</span> = arr ! i</span>
+<span class="lineno">  380 </span><span class="spaces">   </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">error (&quot;failed access with index value &quot; </span></span>
+<span class="lineno">  381 </span><span class="spaces">                     </span><span class="istickedoff"><span class="nottickedoff">++ show i </span></span>
+<span class="lineno">  382 </span><span class="spaces">                     </span><span class="istickedoff"><span class="nottickedoff">++ &quot; (should be between 0 and &quot; </span></span>
+<span class="lineno">  383 </span><span class="spaces">                     </span><span class="istickedoff"><span class="nottickedoff">++ show (snd (bounds arr)) ++ &quot;)&quot;)</span></span></span>
+<span class="lineno">  384 </span>
+<span class="lineno">  385 </span>ourQuot :: Int -&gt; Int -&gt; Int
+<span class="lineno">  386 </span><span class="decl"><span class="nottickedoff">ourQuot _ 0 = error &quot;attempt to use divi to divide by 0&quot;</span>
+<span class="lineno">  387 </span><span class="spaces"></span><span class="nottickedoff">ourQuot a b = a `quot` b</span></span>
+<span class="lineno">  388 </span>
+<span class="lineno">  389 </span>ourRem :: Int -&gt; Int -&gt; Int
+<span class="lineno">  390 </span><span class="decl"><span class="istickedoff">ourRem _ 0 = <span class="nottickedoff">error &quot;attempt to use remi to divide by 0&quot;</span></span>
+<span class="lineno">  391 </span><span class="spaces"></span><span class="istickedoff">ourRem a b = a `rem` b</span></span>
+<span class="lineno">  392 </span>
+<span class="lineno">  393 </span>ourSqrt :: Double -&gt; Double
+<span class="lineno">  394 </span><span class="decl"><span class="nottickedoff">ourSqrt n | n &lt; 0     = error &quot;attempt to use sqrt on a negative number&quot;</span>
+<span class="lineno">  395 </span><span class="spaces">          </span><span class="nottickedoff">| otherwise = sqrt n</span></span>
+<span class="lineno">  396 </span>
+<span class="lineno">  397 </span>
+<span class="lineno">  398 </span><span class="decl"><span class="nottickedoff">mySpotlight p1 p2 col cutoff exp = spotlight p1 p2 col (deg2rad cutoff) exp</span></span>
+<span class="lineno">  399 </span>
+<span class="lineno">  400 </span>-- The problem specification gets the mapping for spheres backwards
+<span class="lineno">  401 </span>-- (it maps the image from right to left).
+<span class="lineno">  402 </span>-- We've fixed that in the raytracing library so that it goes from left
+<span class="lineno">  403 </span>-- to right, but to keep the GML front compatible with the problem
+<span class="lineno">  404 </span>-- statement, we reverse it here.
+<span class="lineno">  405 </span>
+<span class="lineno">  406 </span>sphere' :: SurfaceFn Color Double -&gt; CSG (SurfaceFn Color Double)
+<span class="lineno">  407 </span><span class="decl"><span class="nottickedoff">sphere' (SFun f) = sphere (SFun (\i u v -&gt; f i (1 - u) v))</span>
+<span class="lineno">  408 </span><span class="spaces"></span><span class="nottickedoff">sphere' s = sphere s</span></span>
 
 </pre>
 </html>
 
 </pre>
 </html>
-Writing: Interval.hs.html
+Writing: Primitives.hs.html
 <html><style type="text/css">
 span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
 span.nottickedoff { background: yellow}
 <html><style type="text/css">
 span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
 span.nottickedoff { background: yellow}
@@ -2059,122 +972,271 @@ span.spaces    { background: white }
 <span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
 <span class="lineno">    4 </span>-- which is included in the distribution.
 <span class="lineno">    5 </span>
 <span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
 <span class="lineno">    4 </span>-- which is included in the distribution.
 <span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module Interval
-<span class="lineno">    7 </span>    ( IList
-<span class="lineno">    8 </span>    , Intersection
-<span class="lineno">    9 </span>    , emptyIList, openIList
-<span class="lineno">   10 </span>    , mkEntry, mkExit
-<span class="lineno">   11 </span>    , entryexit, exitentry
-<span class="lineno">   12 </span>    , mapI
-<span class="lineno">   13 </span>    , unionIntervals, intersectIntervals, differenceIntervals
-<span class="lineno">   14 </span>    , complementIntervals
-<span class="lineno">   15 </span>    ) where
+<span class="lineno">    6 </span>module Primitives where
+<span class="lineno">    7 </span>
+<span class="lineno">    8 </span>rad2deg :: Double -&gt; Double
+<span class="lineno">    9 </span><span class="decl"><span class="nottickedoff">rad2deg r = r * 180 / pi</span></span>
+<span class="lineno">   10 </span>
+<span class="lineno">   11 </span>deg2rad :: Double -&gt; Double
+<span class="lineno">   12 </span><span class="decl"><span class="istickedoff">deg2rad d = d * pi / 180</span></span>
+<span class="lineno">   13 </span>
+<span class="lineno">   14 </span>addi :: Int -&gt; Int -&gt; Int
+<span class="lineno">   15 </span><span class="decl"><span class="nottickedoff">addi = (+)</span></span>
 <span class="lineno">   16 </span>
 <span class="lineno">   16 </span>
-<span class="lineno">   17 </span>import Geometry
+<span class="lineno">   17 </span>addf :: Double -&gt; Double -&gt; Double
+<span class="lineno">   18 </span><span class="decl"><span class="nottickedoff">addf = (+)</span></span>
+<span class="lineno">   19 </span>
+<span class="lineno">   20 </span>acosD :: Double -&gt; Double
+<span class="lineno">   21 </span><span class="decl"><span class="nottickedoff">acosD x = acos x * 180 / pi</span></span>
+<span class="lineno">   22 </span>
+<span class="lineno">   23 </span>asinD :: Double -&gt; Double
+<span class="lineno">   24 </span><span class="decl"><span class="nottickedoff">asinD x = asin x * 180 / pi</span></span>
+
+</pre>
+</html>
+Writing: Illumination.hs.html
+<html><style type="text/css">
+span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
+span.nottickedoff { background: yellow}
+span.istickedoff { background: white }
+span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
+span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
+span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
+span.decl { font-weight: bold }
+span.spaces    { background: white }
+</style>
+<pre>
+<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
+<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
+<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
+<span class="lineno">    4 </span>-- which is included in the distribution.
+<span class="lineno">    5 </span>
+<span class="lineno">    6 </span>-- Modified to use stdout (for testing)
+<span class="lineno">    7 </span>
+<span class="lineno">    8 </span>module Illumination
+<span class="lineno">    9 </span>    ( Object
+<span class="lineno">   10 </span>    , Light (..)
+<span class="lineno">   11 </span>    , light, pointlight, spotlight
+<span class="lineno">   12 </span>    , render
+<span class="lineno">   13 </span>    ) where
+<span class="lineno">   14 </span>
+<span class="lineno">   15 </span>import Array
+<span class="lineno">   16 </span>import Char(chr)
+<span class="lineno">   17 </span>import Maybe
 <span class="lineno">   18 </span>
 <span class="lineno">   18 </span>
-<span class="lineno">   19 </span>-- The result of a ray trace is represented as a list of surface
-<span class="lineno">   20 </span>-- intersections.  Each intersection is a point along the ray with
-<span class="lineno">   21 </span>-- a flag indicating whether this intersection is an entry or an
-<span class="lineno">   22 </span>-- exit from the solid.  Each intersection also carries unspecified
-<span class="lineno">   23 </span>-- surface data for use by the illumination model.
-<span class="lineno">   24 </span>
-<span class="lineno">   25 </span>-- Just the list of intersections isn't enough, however.  An empty
-<span class="lineno">   26 </span>-- list can denote either a trace that is always within the solid
-<span class="lineno">   27 </span>-- or never in the solid.  To dissambiguate, an extra flag is kept
-<span class="lineno">   28 </span>-- that indicates whether we are starting inside or outside of the
-<span class="lineno">   29 </span>-- solid.  As a convenience, we also keep an additional flag that
-<span class="lineno">   30 </span>-- indicates whether the last intersection ends inside or outside.
-<span class="lineno">   31 </span>
-<span class="lineno">   32 </span>type IList a       = (Bool, [Intersection a], Bool)
-<span class="lineno">   33 </span>type Intersection a     = (Double, Bool, a)
-<span class="lineno">   34 </span>
-<span class="lineno">   35 </span><span class="decl"><span class="istickedoff">emptyIList = (False, [], False)</span></span>
-<span class="lineno">   36 </span><span class="decl"><span class="nottickedoff">openIList = (True, [], True)</span></span>
-<span class="lineno">   37 </span>
-<span class="lineno">   38 </span><span class="decl"><span class="istickedoff">mapI f (b1, is, b2) = (b1, map f is, b2)</span></span>
-<span class="lineno">   39 </span>
-<span class="lineno">   40 </span><span class="decl"><span class="istickedoff">isEntry (_, entry, _) = entry</span></span>
-<span class="lineno">   41 </span><span class="decl"><span class="nottickedoff">isExit  (_, entry, _) = not entry</span></span>
-<span class="lineno">   42 </span>
-<span class="lineno">   43 </span><span class="decl"><span class="istickedoff">mkEntry (t, a) = (t, True,  a)</span></span>
-<span class="lineno">   44 </span><span class="decl"><span class="istickedoff">mkExit  (t, a) = (t, False, a)</span></span>
-<span class="lineno">   45 </span>
-<span class="lineno">   46 </span><span class="decl"><span class="istickedoff">entryexit w1 w2 = (False, [mkEntry w1, mkExit w2], False)</span></span>
-<span class="lineno">   47 </span><span class="decl"><span class="nottickedoff">exitentry w1 w2 = (True, [mkExit w1, mkEntry w2], True)</span></span>
-<span class="lineno">   48 </span><span class="decl"><span class="nottickedoff">arrange   w1@(t1, _) w2@(t2, _) | t1 &lt; t2   = entryexit w1 w2</span>
-<span class="lineno">   49 </span><span class="spaces">                                </span><span class="nottickedoff">| otherwise = entryexit w2 w1</span></span>
-<span class="lineno">   50 </span>
-<span class="lineno">   51 </span>
-<span class="lineno">   52 </span>cmpI :: Intersection a -&gt; Intersection a -&gt; Ordering
-<span class="lineno">   53 </span><span class="decl"><span class="istickedoff">cmpI (i, _, _) (j, _, _)</span>
-<span class="lineno">   54 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlyfalse">i `near` j</span> = <span class="nottickedoff">EQ</span></span>
-<span class="lineno">   55 </span><span class="spaces">  </span><span class="istickedoff">| i   &lt;    j = LT</span>
-<span class="lineno">   56 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>  = GT</span></span>
-<span class="lineno">   57 </span>
-<span class="lineno">   58 </span><span class="decl"><span class="nottickedoff">bad (b1, [], b2) = b1 /= b2</span>
-<span class="lineno">   59 </span><span class="spaces"></span><span class="nottickedoff">bad (b1, is, b2) = bad' b1 is || b2 /= b3</span>
-<span class="lineno">   60 </span><span class="spaces">  </span><span class="nottickedoff">where (_, b3, _) = last is</span></span>
-<span class="lineno">   61 </span>
-<span class="lineno">   62 </span><span class="decl"><span class="nottickedoff">bad' b [] = False</span>
-<span class="lineno">   63 </span><span class="spaces"></span><span class="nottickedoff">bad' b ((_, c, _) : is) = b == c || bad' c is</span></span>
-<span class="lineno">   64 </span>
-<span class="lineno">   65 </span>unionIntervals :: IList a -&gt; IList a -&gt; IList a
-<span class="lineno">   66 </span><span class="decl"><span class="istickedoff">unionIntervals (isStartOpen, is, isEndOpen) (jsStartOpen, js, jsEndOpen)</span>
-<span class="lineno">   67 </span><span class="spaces">  </span><span class="istickedoff">= (isStartOpen || jsStartOpen, uniIntervals is js, isEndOpen || jsEndOpen)</span>
-<span class="lineno">   68 </span><span class="spaces">  </span><span class="istickedoff">where uniIntervals is [] | <span class="tickonlyfalse">jsEndOpen</span> = <span class="nottickedoff">[]</span></span>
-<span class="lineno">   69 </span><span class="spaces">                           </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span> = is</span>
-<span class="lineno">   70 </span><span class="spaces">        </span><span class="istickedoff">uniIntervals [] js | <span class="tickonlyfalse">isEndOpen</span> = <span class="nottickedoff">[]</span></span>
-<span class="lineno">   71 </span><span class="spaces">                           </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span> = js</span>
-<span class="lineno">   72 </span><span class="spaces">        </span><span class="istickedoff">uniIntervals is@(i : is') js@(j : js')</span>
-<span class="lineno">   73 </span><span class="spaces">          </span><span class="istickedoff">= case cmpI i j of</span>
-<span class="lineno">   74 </span><span class="spaces">            </span><span class="istickedoff">EQ -&gt; <span class="nottickedoff">if isEntry i == isEntry j then i : uniIntervals is' js'</span></span>
-<span class="lineno">   75 </span><span class="spaces">                                            </span><span class="istickedoff"><span class="nottickedoff">else uniIntervals is' js'</span></span>
-<span class="lineno">   76 </span><span class="spaces">            </span><span class="istickedoff">LT -&gt; if <span class="tickonlytrue">isEntry j</span> then i : <span class="nottickedoff">uniIntervals is' js</span></span>
-<span class="lineno">   77 </span><span class="spaces">                               </span><span class="istickedoff">else     <span class="nottickedoff">uniIntervals is' js</span></span>
-<span class="lineno">   78 </span><span class="spaces">            </span><span class="istickedoff">GT -&gt; if <span class="tickonlytrue">isEntry i</span> then j : uniIntervals is js'</span>
-<span class="lineno">   79 </span><span class="spaces">                               </span><span class="istickedoff">else     <span class="nottickedoff">uniIntervals is js'</span></span></span>
+<span class="lineno">   19 </span>import Geometry
+<span class="lineno">   20 </span>import CSG
+<span class="lineno">   21 </span>import Surface
+<span class="lineno">   22 </span>import Misc
+<span class="lineno">   23 </span>
+<span class="lineno">   24 </span>type Object = CSG (SurfaceFn Color Double)
+<span class="lineno">   25 </span>
+<span class="lineno">   26 </span>data Cxt = Cxt {ambient::Color, lights::[Light], object::Object, depth::Int}
+<span class="lineno">   27 </span>        deriving <span class="nottickedoff"><span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span></span>
+<span class="lineno">   28 </span>
+<span class="lineno">   29 </span>render :: (Matrix,Matrix) -&gt; Color -&gt; [Light] -&gt; Object -&gt; Int -&gt;
+<span class="lineno">   30 </span>          Radian -&gt; Int -&gt; Int -&gt; String -&gt; IO ()
+<span class="lineno">   31 </span><span class="decl"><span class="istickedoff">render (m,m') amb ls obj dep fov wid ht file</span>
+<span class="lineno">   32 </span><span class="spaces">  </span><span class="istickedoff">= do { debugging</span>
+<span class="lineno">   33 </span><span class="spaces">       </span><span class="istickedoff">; txt &lt;- readFile &quot;galois.sample&quot;</span>
+<span class="lineno">   34 </span><span class="spaces">       </span><span class="istickedoff">; let vals = read txt</span>
+<span class="lineno">   35 </span><span class="spaces">       </span><span class="istickedoff">; let rt_vals = showBitmap' <span class="nottickedoff">wid</span> <span class="nottickedoff">ht</span> pixels</span>
+<span class="lineno">   36 </span><span class="spaces">       </span><span class="istickedoff">; if <span class="tickonlyfalse">length vals /= length rt_vals</span></span>
+<span class="lineno">   37 </span><span class="spaces">           </span><span class="istickedoff">then <span class="nottickedoff">print (&quot;BAD LENGTH&quot;,length vals,length rt_vals)</span></span>
+<span class="lineno">   38 </span><span class="spaces">           </span><span class="istickedoff">else do {</span>
+<span class="lineno">   39 </span><span class="spaces">                   </span><span class="istickedoff">; let cmp = sum(zipWith (\ a b -&gt; abs (a - b) * abs (a - b)) vals rt_vals)</span>
+<span class="lineno">   40 </span><span class="spaces">                   </span><span class="istickedoff">; print $ if <span class="tickonlytrue">cmp &lt;= (length vals * 16)</span> then (&quot;GOOD MATCH&quot;) else <span class="nottickedoff">(&quot;BAD MATCH:&quot; ++ show cmp)</span></span>
+<span class="lineno">   41 </span><span class="spaces">                   </span><span class="istickedoff">}}</span>
+<span class="lineno">   42 </span><span class="spaces">                   </span><span class="istickedoff"></span>
+<span class="lineno">   43 </span><span class="spaces">  </span><span class="istickedoff">where</span>
+<span class="lineno">   44 </span><span class="spaces">    </span><span class="istickedoff">debugging = return <span class="nottickedoff">()</span></span>
+<span class="lineno">   45 </span><span class="spaces"></span><span class="istickedoff">{-</span>
+<span class="lineno">   46 </span><span class="spaces">                </span><span class="istickedoff">do { putStrLn (show cxt)</span>
+<span class="lineno">   47 </span><span class="spaces">                   </span><span class="istickedoff">; putStrLn (show (width, delta, aspect, left, top))</span>
+<span class="lineno">   48 </span><span class="spaces">                   </span><span class="istickedoff">}</span>
+<span class="lineno">   49 </span><span class="spaces"></span><span class="istickedoff">-}</span>
+<span class="lineno">   50 </span><span class="spaces">    </span><span class="istickedoff">obj' = transform (m',m) obj</span>
+<span class="lineno">   51 </span><span class="spaces">    </span><span class="istickedoff">ls'  = [ transformLight m' l | l &lt;- ls ]</span>
+<span class="lineno">   52 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">pixelA = listArray ((1,1), (ht,wid))</span></span>
+<span class="lineno">   53 </span><span class="spaces">                       </span><span class="istickedoff"><span class="nottickedoff">[ illumination cxt (start,pixel i j)</span></span>
+<span class="lineno">   54 </span><span class="spaces">                       </span><span class="istickedoff"><span class="nottickedoff">| j &lt;- take ht  [0.5..]</span></span>
+<span class="lineno">   55 </span><span class="spaces">                       </span><span class="istickedoff"><span class="nottickedoff">, i &lt;- take wid [0.5..] ]</span></span>
+<span class="lineno">   56 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">antiA  = pixelA //</span></span>
+<span class="lineno">   57 </span><span class="spaces">             </span><span class="istickedoff"><span class="nottickedoff">[ (ix, superSample ix (pixelA ! ix))</span></span>
+<span class="lineno">   58 </span><span class="spaces">             </span><span class="istickedoff"><span class="nottickedoff">| j &lt;- [2 .. ht - 1], i &lt;- [2 .. wid - 1]</span></span>
+<span class="lineno">   59 </span><span class="spaces">             </span><span class="istickedoff"><span class="nottickedoff">, let ix = (j, i)</span></span>
+<span class="lineno">   60 </span><span class="spaces">             </span><span class="istickedoff"><span class="nottickedoff">, contrast ix pixelA ]</span></span>
+<span class="lineno">   61 </span><span class="spaces">    </span><span class="istickedoff">pixels = [ [ illumination cxt (start,pixel i j) | i&lt;- take wid [0.5..] ]</span>
+<span class="lineno">   62 </span><span class="spaces">             </span><span class="istickedoff">| j &lt;- take ht [0.5..]</span>
+<span class="lineno">   63 </span><span class="spaces">             </span><span class="istickedoff">]</span>
+<span class="lineno">   64 </span><span class="spaces">    </span><span class="istickedoff">cxt    = Cxt {ambient=amb, lights=ls',  object=obj', depth=dep}</span>
+<span class="lineno">   65 </span><span class="spaces">    </span><span class="istickedoff">start  = point  0 0 (-1)</span>
+<span class="lineno">   66 </span><span class="spaces">    </span><span class="istickedoff">width  = 2 * tan (fov/2)</span>
+<span class="lineno">   67 </span><span class="spaces">    </span><span class="istickedoff">delta  = width / fromIntegral wid</span>
+<span class="lineno">   68 </span><span class="spaces">    </span><span class="istickedoff">aspect = fromIntegral ht / fromIntegral wid</span>
+<span class="lineno">   69 </span><span class="spaces">    </span><span class="istickedoff">left   = - width / 2</span>
+<span class="lineno">   70 </span><span class="spaces">    </span><span class="istickedoff">top    = - left * aspect</span>
+<span class="lineno">   71 </span><span class="spaces">    </span><span class="istickedoff">pixel i j = vector (left + i*delta) (top - j*delta) 1</span>
+<span class="lineno">   72 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   73 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">superSample (y, x) col = avg $ col:</span></span>
+<span class="lineno">   74 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">[ illumination cxt (start, pixel (fromIntegral x - 0.5 + xd) (fromIntegral y - 0.5 + yd))</span></span>
+<span class="lineno">   75 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">| (xd, yd) &lt;- [(-0.333, 0.0), (0.333, 0.0), (0.0, -0.333), (0.0, 0.333)]</span></span>
+<span class="lineno">   76 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">]</span></span></span> 
+<span class="lineno">   77 </span>
+<span class="lineno">   78 </span><span class="decl"><span class="nottickedoff">avg cs = divN (fromIntegral (length cs)) (uncolor (sumCC cs))</span>
+<span class="lineno">   79 </span><span class="spaces">  </span><span class="nottickedoff">where divN n (r,g,b) = color (r / n) (g / n) (b / n)</span></span>
 <span class="lineno">   80 </span>
 <span class="lineno">   80 </span>
-<span class="lineno">   81 </span>intersectIntervals :: IList a -&gt; IList a -&gt; IList a
-<span class="lineno">   82 </span><span class="decl"><span class="nottickedoff">intersectIntervals is js</span>
-<span class="lineno">   83 </span><span class="spaces">  </span><span class="nottickedoff">= complementIntervals (unionIntervals is' js')</span>
-<span class="lineno">   84 </span><span class="spaces">  </span><span class="nottickedoff">where is' = complementIntervals is</span>
-<span class="lineno">   85 </span><span class="spaces">        </span><span class="nottickedoff">js' = complementIntervals js</span></span>
-<span class="lineno">   86 </span>
-<span class="lineno">   87 </span>differenceIntervals :: IList a -&gt; IList a -&gt; IList a
-<span class="lineno">   88 </span><span class="decl"><span class="nottickedoff">differenceIntervals is js</span>
-<span class="lineno">   89 </span><span class="spaces">  </span><span class="nottickedoff">= complementIntervals (unionIntervals is' js)</span>
-<span class="lineno">   90 </span><span class="spaces">  </span><span class="nottickedoff">where is' = complementIntervals is</span></span>
-<span class="lineno">   91 </span>
-<span class="lineno">   92 </span>complementIntervals :: IList a -&gt; IList a
-<span class="lineno">   93 </span><span class="decl"><span class="nottickedoff">complementIntervals (o1, is, o2)</span>
-<span class="lineno">   94 </span><span class="spaces">  </span><span class="nottickedoff">= (not o1, [ (i, not isentry, a) | (i, isentry, a) &lt;- is ], not o2)</span></span>
-<span class="lineno">   95 </span>
-<span class="lineno">   96 </span>-- tests...
+<span class="lineno">   81 </span>contrast :: (Int, Int) -&gt; Array (Int, Int) Color -&gt; Bool
+<span class="lineno">   82 </span><span class="decl"><span class="nottickedoff">contrast (x, y) arr = any diffMax [ subCC cur (arr ! (x + xd, y + yd))</span>
+<span class="lineno">   83 </span><span class="spaces">                                  </span><span class="nottickedoff">| xd &lt;- [-1, 1], yd &lt;- [-1, 1]</span>
+<span class="lineno">   84 </span><span class="spaces">                                  </span><span class="nottickedoff">]</span>
+<span class="lineno">   85 </span><span class="spaces">  </span><span class="nottickedoff">where cur = arr ! (x, y)</span>
+<span class="lineno">   86 </span><span class="spaces">        </span><span class="nottickedoff">diffMax col = (abs r) &gt; 0.25 || (abs g) &gt;  0.2 || (abs b) &gt; 0.4</span>
+<span class="lineno">   87 </span><span class="spaces">           </span><span class="nottickedoff">where</span>
+<span class="lineno">   88 </span><span class="spaces">                 </span><span class="nottickedoff">(r,g,b) = uncolor col</span></span>
+<span class="lineno">   89 </span>
+<span class="lineno">   90 </span>
+<span class="lineno">   91 </span>illumination :: Cxt -&gt; Ray -&gt; Color
+<span class="lineno">   92 </span><span class="decl"><span class="istickedoff">illumination cxt (r,v)</span>
+<span class="lineno">   93 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlyfalse">depth cxt &lt;= 0</span> = <span class="nottickedoff">black</span></span>
+<span class="lineno">   94 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>     = case castRay (r,v) (object cxt) of</span>
+<span class="lineno">   95 </span><span class="spaces">                      </span><span class="istickedoff">Nothing -&gt; black</span>
+<span class="lineno">   96 </span><span class="spaces">                      </span><span class="istickedoff">Just info -&gt; illum (cxt{depth=(depth cxt)-1}) info v</span></span>
 <span class="lineno">   97 </span>
 <span class="lineno">   97 </span>
-<span class="lineno">   98 </span>{-
-<span class="lineno">   99 </span>mkIn, mkOut :: Double -&gt; Intersection a
-<span class="lineno">  100 </span>mkIn x = (x, True, undefined)
-<span class="lineno">  101 </span>mkOut x = (x, False, undefined)
-<span class="lineno">  102 </span>
-<span class="lineno">  103 </span>i1 =  (False, [ mkIn 2, mkOut 7 ], False)
-<span class="lineno">  104 </span>i1' = (True, [ mkOut 2, mkIn 7 ], True)
-<span class="lineno">  105 </span>i2 =  (False, [ mkIn 1, mkOut 3, mkIn 4, mkOut 5, mkIn 6, mkOut 8 ], False)
-<span class="lineno">  106 </span>
-<span class="lineno">  107 </span>t1 = unionIntervals i1 i2
-<span class="lineno">  108 </span>t2 = intersectIntervals i1 i2
-<span class="lineno">  109 </span>t3 = intersectIntervals i2 i1
-<span class="lineno">  110 </span>t4 = complementIntervals i1
-<span class="lineno">  111 </span>t5 = intersectIntervals i2 i1'
-<span class="lineno">  112 </span>t6 = differenceIntervals i2 i1
-<span class="lineno">  113 </span>t7 = differenceIntervals i2 i2
-<span class="lineno">  114 </span>
-<span class="lineno">  115 </span>sh (o1,is,o2) =
-<span class="lineno">  116 </span>    do  if o1 then putStr &quot;...&quot; else return ()
-<span class="lineno">  117 </span>        putStr $ foldr1 (++) (map si is)
-<span class="lineno">  118 </span>        if o2 then putStr &quot;...&quot; else return ()
-<span class="lineno">  119 </span>si (i, True, _, _) = &quot;&lt;&quot; ++ show i
-<span class="lineno">  120 </span>si (i, False, _, _) = &quot; &quot; ++ show i ++ &quot;&gt;&quot;
-<span class="lineno">  121 </span>-}
+<span class="lineno">   98 </span>illum :: Cxt -&gt; (Point,Vector,Properties Color Double) -&gt; Vector -&gt; Color
+<span class="lineno">   99 </span><span class="decl"><span class="istickedoff">illum cxt (pos,normV,(col,kd,ks,n)) v</span>
+<span class="lineno">  100 </span><span class="spaces">  </span><span class="istickedoff">= ambTerm `addCC` difTerm `addCC` spcTerm `addCC` recTerm</span>
+<span class="lineno">  101 </span><span class="spaces">  </span><span class="istickedoff">where</span>
+<span class="lineno">  102 </span><span class="spaces">    </span><span class="istickedoff">visibleLights = unobscured pos (object cxt) (lights cxt) normV</span>
+<span class="lineno">  103 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">d = depth cxt</span></span>
+<span class="lineno">  104 </span><span class="spaces">    </span><span class="istickedoff">amb = ambient cxt</span>
+<span class="lineno">  105 </span><span class="spaces">    </span><span class="istickedoff">newV = subVV v (multSV (2 * dot normV v) normV)</span>
+<span class="lineno">  106 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  107 </span><span class="spaces">    </span><span class="istickedoff">ambTerm = multSC kd (multCC amb col)</span>
+<span class="lineno">  108 </span><span class="spaces">    </span><span class="istickedoff">difTerm = multSC kd (sumCC [multSC (dot normV lj) (multCC intensity col)</span>
+<span class="lineno">  109 </span><span class="spaces">               </span><span class="istickedoff">|(loc,intensity) &lt;- visibleLights,</span>
+<span class="lineno">  110 </span><span class="spaces">               </span><span class="istickedoff">let lj = normalize ({- pos `subVV` -} loc)])</span>
+<span class="lineno">  111 </span><span class="spaces">    </span><span class="istickedoff">-- ZZ might want to avoid the phong, when you can...</span>
+<span class="lineno">  112 </span><span class="spaces">    </span><span class="istickedoff">spcTerm = multSC ks (sumCC [multSC ((dot normV hj) ** n ) (multCC intensity col)</span>
+<span class="lineno">  113 </span><span class="spaces">               </span><span class="istickedoff">|(loc,intensity) &lt;- visibleLights,</span>
+<span class="lineno">  114 </span><span class="spaces">               </span><span class="istickedoff">-- ZZ note this is specific to the light at infinity</span>
+<span class="lineno">  115 </span><span class="spaces">               </span><span class="istickedoff">let lj = {- pos `subVV` -} normalize loc,</span>
+<span class="lineno">  116 </span><span class="spaces">               </span><span class="istickedoff">let hj = normalize (lj `subVV` normalize v)])</span>
+<span class="lineno">  117 </span><span class="spaces">    </span><span class="istickedoff">recTerm  = if recCoeff `nearC` black then black else multCC recCoeff recRay</span>
+<span class="lineno">  118 </span><span class="spaces">    </span><span class="istickedoff">recCoeff = multSC ks col</span>
+<span class="lineno">  119 </span><span class="spaces">    </span><span class="istickedoff">recRay   = illumination cxt (pos,newV)</span></span>
+<span class="lineno">  120 </span>
+<span class="lineno">  121 </span>showBitmapA :: Int -&gt; Int -&gt; Array (Int, Int) Color -&gt; String
+<span class="lineno">  122 </span><span class="decl"><span class="nottickedoff">showBitmapA wid ht arr</span>
+<span class="lineno">  123 </span><span class="spaces">  </span><span class="nottickedoff">= header ++ concatMap scaleColor (elems arr)</span>
+<span class="lineno">  124 </span><span class="spaces">  </span><span class="nottickedoff">where</span>
+<span class="lineno">  125 </span><span class="spaces">    </span><span class="nottickedoff">scaleColor col = [scalePixel r, scalePixel g, scalePixel b]</span>
+<span class="lineno">  126 </span><span class="spaces">           </span><span class="nottickedoff">where (r,g,b) = uncolor col</span>
+<span class="lineno">  127 </span><span class="spaces">    </span><span class="nottickedoff">header = &quot;P6\n#Galois\n&quot; ++ show wid ++ &quot; &quot; ++ show ht ++ &quot;\n255\n&quot;</span></span>
+<span class="lineno">  128 </span>
+<span class="lineno">  129 </span>showBitmap :: Int -&gt; Int -&gt;[[Color]] -&gt; String
+<span class="lineno">  130 </span><span class="decl"><span class="nottickedoff">showBitmap wid ht pss</span>
+<span class="lineno">  131 </span><span class="spaces"></span><span class="nottickedoff">-- type of assert  | length pss == ht &amp;&amp; all (\ ps -&gt; length ps == wid) pss</span>
+<span class="lineno">  132 </span><span class="spaces">  </span><span class="nottickedoff">= header ++ concat [[scalePixel r,scalePixel g,scalePixel b] </span>
+<span class="lineno">  133 </span><span class="spaces">                      </span><span class="nottickedoff">| ps &lt;- pss, (r,g,b) &lt;- map uncolor ps]</span>
+<span class="lineno">  134 </span><span class="spaces">  </span><span class="nottickedoff">where</span>
+<span class="lineno">  135 </span><span class="spaces">    </span><span class="nottickedoff">header = &quot;P6\n#Galois\n&quot; ++ show wid ++ &quot; &quot; ++ show ht ++ &quot;\n255\n&quot;</span>
+<span class="lineno">  136 </span><span class="spaces"></span><span class="nottickedoff">showBitmap _ _ _ = error &quot;incorrect length of bitmap string&quot;</span></span>
+<span class="lineno">  137 </span>
+<span class="lineno">  138 </span>scalePixel :: Double -&gt; Char
+<span class="lineno">  139 </span><span class="decl"><span class="nottickedoff">scalePixel p = chr (floor (clampf p * 255))</span></span>
+<span class="lineno">  140 </span>
+<span class="lineno">  141 </span>showBitmap' :: Int -&gt; Int -&gt;[[Color]] -&gt; [Int]
+<span class="lineno">  142 </span><span class="decl"><span class="istickedoff">showBitmap' wid ht pss</span>
+<span class="lineno">  143 </span><span class="spaces"></span><span class="istickedoff">-- type of assert  | length pss == ht &amp;&amp; all (\ ps -&gt; length ps == wid) pss</span>
+<span class="lineno">  144 </span><span class="spaces">  </span><span class="istickedoff">= concat [ concat [  [scalePixel' r,scalePixel' g,scalePixel' b]</span>
+<span class="lineno">  145 </span><span class="spaces">                    </span><span class="istickedoff">| (r,g,b) &lt;- map uncolor ps]</span>
+<span class="lineno">  146 </span><span class="spaces">           </span><span class="istickedoff">| ps &lt;- pss ]</span>
+<span class="lineno">  147 </span><span class="spaces">  </span><span class="istickedoff">where</span>
+<span class="lineno">  148 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">header = &quot;P3\n#Galois\n&quot; ++ show wid ++ &quot; &quot; ++ show ht ++ &quot;\n255\n&quot;</span></span>
+<span class="lineno">  149 </span><span class="spaces"></span><span class="istickedoff">showBitmap' _ _ _ = <span class="nottickedoff">error &quot;incorrect length of bitmap string&quot;</span></span></span>
+<span class="lineno">  150 </span>
+<span class="lineno">  151 </span>scalePixel' :: Double -&gt; Int
+<span class="lineno">  152 </span><span class="decl"><span class="istickedoff">scalePixel' p = floor (clampf p * 255)</span></span>
+<span class="lineno">  153 </span>
+<span class="lineno">  154 </span>-- Lights
+<span class="lineno">  155 </span>
+<span class="lineno">  156 </span>data Light = Light Vector Color
+<span class="lineno">  157 </span>           | PointLight Point Color 
+<span class="lineno">  158 </span>           | SpotLight Point Point Color Radian Double
+<span class="lineno">  159 </span>   deriving <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>
+<span class="lineno">  160 </span>
+<span class="lineno">  161 </span>light :: Coords -&gt; Color -&gt; Light
+<span class="lineno">  162 </span><span class="decl"><span class="istickedoff">light (x,y,z) color =</span>
+<span class="lineno">  163 </span><span class="spaces">  </span><span class="istickedoff">Light (normalize (vector (-x) (-y) (-z))) color</span></span>
+<span class="lineno">  164 </span><span class="decl"><span class="nottickedoff">pointlight (x,y,z) color =</span>
+<span class="lineno">  165 </span><span class="spaces">  </span><span class="nottickedoff">PointLight (point x y z) color</span></span>
+<span class="lineno">  166 </span><span class="decl"><span class="nottickedoff">spotlight (x,y,z) (p,q,r) col cutoff exp =</span>
+<span class="lineno">  167 </span><span class="spaces">  </span><span class="nottickedoff">SpotLight (point x y z) (point p q r) col cutoff exp</span></span>
+<span class="lineno">  168 </span>
+<span class="lineno">  169 </span><span class="decl"><span class="istickedoff">transformLight m (Light v c) = Light (multMV m v) c</span>
+<span class="lineno">  170 </span><span class="spaces"></span><span class="istickedoff">transformLight m (PointLight p c) = <span class="nottickedoff">PointLight (multMP m p) c</span></span>
+<span class="lineno">  171 </span><span class="spaces"></span><span class="istickedoff">transformLight m (SpotLight p q c r d) = <span class="nottickedoff">SpotLight (multMP m p) (multMP m q) c r d</span></span></span>
+<span class="lineno">  172 </span>
+<span class="lineno">  173 </span>unobscured :: Point -&gt; Object -&gt; [Light] -&gt;  Vector -&gt; [(Vector,Color)]
+<span class="lineno">  174 </span><span class="decl"><span class="istickedoff">unobscured pos obj lights normV = catMaybes (map (unobscure pos obj normV) lights)</span></span>
+<span class="lineno">  175 </span>
+<span class="lineno">  176 </span>unobscure :: Point -&gt; Object -&gt; Vector -&gt;  Light -&gt; Maybe (Vector,Color)
+<span class="lineno">  177 </span><span class="decl"><span class="istickedoff">unobscure pos obj normV (Light vec color)</span>
+<span class="lineno">  178 </span><span class="spaces">  </span><span class="istickedoff">-- ZZ probably want to make this faster</span>
+<span class="lineno">  179 </span><span class="spaces">  </span><span class="istickedoff">| vec `dot` normV &lt; 0 = Nothing</span>
+<span class="lineno">  180 </span><span class="spaces">  </span><span class="istickedoff">| intersects (pos `addPV` (0.0001 `multSV` vec),vec) obj = Nothing</span>
+<span class="lineno">  181 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>               = Just (vec,color)</span>
+<span class="lineno">  182 </span><span class="spaces"></span><span class="istickedoff">unobscure pos obj normV (PointLight pp color)</span>
+<span class="lineno">  183 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">vec `dot` normV &lt; 0</span>     = <span class="nottickedoff">Nothing</span></span>
+<span class="lineno">  184 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">intersectWithin (pos `addPV` (0.0001 `multSV` (normalize vec)), vec) obj</span> = <span class="nottickedoff">Nothing</span></span>
+<span class="lineno">  185 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span>               = <span class="nottickedoff">Just (vec,is)</span></span>
+<span class="lineno">  186 </span><span class="spaces">      </span><span class="istickedoff">where <span class="nottickedoff">vec = pp `subPP` pos</span></span>
+<span class="lineno">  187 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">is  = attenuate vec color</span></span>
+<span class="lineno">  188 </span><span class="spaces"></span><span class="istickedoff">unobscure org obj normV (SpotLight pos at color cutoff exp)</span>
+<span class="lineno">  189 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">vec `dot` normV &lt; 0</span>                                                 = <span class="nottickedoff">Nothing</span></span>
+<span class="lineno">  190 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">intersectWithin (org `addPV` (0.0001 `multSV` (normalize vec)), vec) obj</span> = <span class="nottickedoff">Nothing</span></span>
+<span class="lineno">  191 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">angle &gt; cutoff</span>                                                      = <span class="nottickedoff">Nothing</span></span>
+<span class="lineno">  192 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span>                                                           = <span class="nottickedoff">Just (vec, is)</span></span>
+<span class="lineno">  193 </span><span class="spaces">      </span><span class="istickedoff">where <span class="nottickedoff">vec   = pos `subPP` org</span></span>
+<span class="lineno">  194 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">vec'  = pos `subPP` at</span></span>
+<span class="lineno">  195 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">angle = acos (normalize vec `dot` (normalize vec'))</span></span>
+<span class="lineno">  196 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  197 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">asp   = normalize (at `subPP` pos)</span>            </span>
+<span class="lineno">  198 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">qsp   = normalize (org `subPP` pos)</span></span>
+<span class="lineno">  199 </span><span class="spaces">            </span><span class="istickedoff"><span class="nottickedoff">is    = attenuate vec (((asp `dot` qsp) ** exp) `multSC` color)</span></span></span>
+<span class="lineno">  200 </span>
+<span class="lineno">  201 </span>attenuate :: Vector -&gt; Color -&gt; Color
+<span class="lineno">  202 </span><span class="decl"><span class="nottickedoff">attenuate vec color = (100 / (99 + sq (norm vec))) `multSC` color</span></span>
+<span class="lineno">  203 </span>
+<span class="lineno">  204 </span>--
+<span class="lineno">  205 </span>
+<span class="lineno">  206 </span><span class="decl"><span class="istickedoff">castRay ray p</span>
+<span class="lineno">  207 </span><span class="spaces">  </span><span class="istickedoff">= case intersectRayWithObject ray p of</span>
+<span class="lineno">  208 </span><span class="spaces">    </span><span class="istickedoff">(True, _, _)                     -&gt; <span class="nottickedoff">Nothing</span> -- eye is inside</span>
+<span class="lineno">  209 </span><span class="spaces">    </span><span class="istickedoff">(False, [], _)                   -&gt; Nothing -- eye is inside</span>
+<span class="lineno">  210 </span><span class="spaces">    </span><span class="istickedoff">(False, (0, b, _) : _, _)        -&gt; <span class="nottickedoff">Nothing</span> -- eye is inside</span>
+<span class="lineno">  211 </span><span class="spaces">    </span><span class="istickedoff">(False, (i, False, _) : _, _)    -&gt; <span class="nottickedoff">Nothing</span> -- eye is inside</span>
+<span class="lineno">  212 </span><span class="spaces">    </span><span class="istickedoff">(False, (t, b, (s, p0)) : _, _)     -&gt;</span>
+<span class="lineno">  213 </span><span class="spaces">        </span><span class="istickedoff">let (v, prop) = surface s p0 in</span>
+<span class="lineno">  214 </span><span class="spaces">            </span><span class="istickedoff">Just (offsetToPoint ray t, v, prop)</span></span>
+<span class="lineno">  215 </span>
+<span class="lineno">  216 </span><span class="decl"><span class="istickedoff">intersects ray p</span>
+<span class="lineno">  217 </span><span class="spaces">  </span><span class="istickedoff">= case intersectRayWithObject ray p of</span>
+<span class="lineno">  218 </span><span class="spaces">    </span><span class="istickedoff">(True, _, _)                  -&gt; <span class="nottickedoff">False</span></span>
+<span class="lineno">  219 </span><span class="spaces">    </span><span class="istickedoff">(False, [], _)                -&gt; False</span>
+<span class="lineno">  220 </span><span class="spaces">    </span><span class="istickedoff">(False, (0, b, _) : _, _)     -&gt; <span class="nottickedoff">False</span></span>
+<span class="lineno">  221 </span><span class="spaces">    </span><span class="istickedoff">(False, (i, False, _) : _, _) -&gt; <span class="nottickedoff">False</span></span>
+<span class="lineno">  222 </span><span class="spaces">    </span><span class="istickedoff">(False, (i, b, _) : _, _)     -&gt; True</span></span>
+<span class="lineno">  223 </span>
+<span class="lineno">  224 </span>intersectWithin :: Ray -&gt; Object -&gt; Bool
+<span class="lineno">  225 </span><span class="decl"><span class="nottickedoff">intersectWithin ray p</span>
+<span class="lineno">  226 </span><span class="spaces">  </span><span class="nottickedoff">= case intersectRayWithObject ray p of</span>
+<span class="lineno">  227 </span><span class="spaces">    </span><span class="nottickedoff">(True, _, _)                  -&gt; False -- eye is inside</span>
+<span class="lineno">  228 </span><span class="spaces">    </span><span class="nottickedoff">(False, [], _)                -&gt; False -- eye is inside</span>
+<span class="lineno">  229 </span><span class="spaces">    </span><span class="nottickedoff">(False, (0, b, _) : _, _)     -&gt; False -- eye is inside</span>
+<span class="lineno">  230 </span><span class="spaces">    </span><span class="nottickedoff">(False, (i, False, _) : _, _) -&gt; False -- eye is inside</span>
+<span class="lineno">  231 </span><span class="spaces">    </span><span class="nottickedoff">(False, (t, b, _) : _, _)     -&gt; t &lt; 1.0</span></span>
 
 </pre>
 </html>
 
 </pre>
 </html>
@@ -2329,12 +1391,508 @@ span.spaces    { background: white }
 <span class="lineno">  111 </span>
 <span class="lineno">  112 </span>-- misc
 <span class="lineno">  113 </span>
 <span class="lineno">  111 </span>
 <span class="lineno">  112 </span>-- misc
 <span class="lineno">  113 </span>
-<span class="lineno">  114 </span>adjustRadian :: Radian -&gt; Radian
-<span class="lineno">  115 </span><span class="decl"><span class="nottickedoff">adjustRadian r = if r &gt; 0 then r else r + 2 * pi</span></span>
+<span class="lineno">  114 </span>adjustRadian :: Radian -&gt; Radian
+<span class="lineno">  115 </span><span class="decl"><span class="nottickedoff">adjustRadian r = if r &gt; 0 then r else r + 2 * pi</span></span>
+
+</pre>
+</html>
+Writing: CSG.hs.html
+<html><style type="text/css">
+span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
+span.nottickedoff { background: yellow}
+span.istickedoff { background: white }
+span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
+span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
+span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
+span.decl { font-weight: bold }
+span.spaces    { background: white }
+</style>
+<pre>
+<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
+<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
+<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
+<span class="lineno">    4 </span>-- which is included in the distribution.
+<span class="lineno">    5 </span>
+<span class="lineno">    6 </span>module CSG(module Construct,
+<span class="lineno">    7 </span>           module Geometry,
+<span class="lineno">    8 </span>           module Intersections,
+<span class="lineno">    9 </span>           module Interval,
+<span class="lineno">   10 </span>           module Misc) where
+<span class="lineno">   11 </span>
+<span class="lineno">   12 </span>import Construct
+<span class="lineno">   13 </span>import Geometry
+<span class="lineno">   14 </span>import Intersections
+<span class="lineno">   15 </span>import Interval
+<span class="lineno">   16 </span>import Misc
+
+</pre>
+</html>
+Writing: Interval.hs.html
+<html><style type="text/css">
+span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
+span.nottickedoff { background: yellow}
+span.istickedoff { background: white }
+span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
+span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
+span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
+span.decl { font-weight: bold }
+span.spaces    { background: white }
+</style>
+<pre>
+<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
+<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
+<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
+<span class="lineno">    4 </span>-- which is included in the distribution.
+<span class="lineno">    5 </span>
+<span class="lineno">    6 </span>module Interval
+<span class="lineno">    7 </span>    ( IList
+<span class="lineno">    8 </span>    , Intersection
+<span class="lineno">    9 </span>    , emptyIList, openIList
+<span class="lineno">   10 </span>    , mkEntry, mkExit
+<span class="lineno">   11 </span>    , entryexit, exitentry
+<span class="lineno">   12 </span>    , mapI
+<span class="lineno">   13 </span>    , unionIntervals, intersectIntervals, differenceIntervals
+<span class="lineno">   14 </span>    , complementIntervals
+<span class="lineno">   15 </span>    ) where
+<span class="lineno">   16 </span>
+<span class="lineno">   17 </span>import Geometry
+<span class="lineno">   18 </span>
+<span class="lineno">   19 </span>-- The result of a ray trace is represented as a list of surface
+<span class="lineno">   20 </span>-- intersections.  Each intersection is a point along the ray with
+<span class="lineno">   21 </span>-- a flag indicating whether this intersection is an entry or an
+<span class="lineno">   22 </span>-- exit from the solid.  Each intersection also carries unspecified
+<span class="lineno">   23 </span>-- surface data for use by the illumination model.
+<span class="lineno">   24 </span>
+<span class="lineno">   25 </span>-- Just the list of intersections isn't enough, however.  An empty
+<span class="lineno">   26 </span>-- list can denote either a trace that is always within the solid
+<span class="lineno">   27 </span>-- or never in the solid.  To dissambiguate, an extra flag is kept
+<span class="lineno">   28 </span>-- that indicates whether we are starting inside or outside of the
+<span class="lineno">   29 </span>-- solid.  As a convenience, we also keep an additional flag that
+<span class="lineno">   30 </span>-- indicates whether the last intersection ends inside or outside.
+<span class="lineno">   31 </span>
+<span class="lineno">   32 </span>type IList a       = (Bool, [Intersection a], Bool)
+<span class="lineno">   33 </span>type Intersection a     = (Double, Bool, a)
+<span class="lineno">   34 </span>
+<span class="lineno">   35 </span><span class="decl"><span class="istickedoff">emptyIList = (False, [], False)</span></span>
+<span class="lineno">   36 </span><span class="decl"><span class="nottickedoff">openIList = (True, [], True)</span></span>
+<span class="lineno">   37 </span>
+<span class="lineno">   38 </span><span class="decl"><span class="istickedoff">mapI f (b1, is, b2) = (b1, map f is, b2)</span></span>
+<span class="lineno">   39 </span>
+<span class="lineno">   40 </span><span class="decl"><span class="istickedoff">isEntry (_, entry, _) = entry</span></span>
+<span class="lineno">   41 </span><span class="decl"><span class="nottickedoff">isExit  (_, entry, _) = not entry</span></span>
+<span class="lineno">   42 </span>
+<span class="lineno">   43 </span><span class="decl"><span class="istickedoff">mkEntry (t, a) = (t, True,  a)</span></span>
+<span class="lineno">   44 </span><span class="decl"><span class="istickedoff">mkExit  (t, a) = (t, False, a)</span></span>
+<span class="lineno">   45 </span>
+<span class="lineno">   46 </span><span class="decl"><span class="istickedoff">entryexit w1 w2 = (False, [mkEntry w1, mkExit w2], False)</span></span>
+<span class="lineno">   47 </span><span class="decl"><span class="nottickedoff">exitentry w1 w2 = (True, [mkExit w1, mkEntry w2], True)</span></span>
+<span class="lineno">   48 </span><span class="decl"><span class="nottickedoff">arrange   w1@(t1, _) w2@(t2, _) | t1 &lt; t2   = entryexit w1 w2</span>
+<span class="lineno">   49 </span><span class="spaces">                                </span><span class="nottickedoff">| otherwise = entryexit w2 w1</span></span>
+<span class="lineno">   50 </span>
+<span class="lineno">   51 </span>
+<span class="lineno">   52 </span>cmpI :: Intersection a -&gt; Intersection a -&gt; Ordering
+<span class="lineno">   53 </span><span class="decl"><span class="istickedoff">cmpI (i, _, _) (j, _, _)</span>
+<span class="lineno">   54 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlyfalse">i `near` j</span> = <span class="nottickedoff">EQ</span></span>
+<span class="lineno">   55 </span><span class="spaces">  </span><span class="istickedoff">| i   &lt;    j = LT</span>
+<span class="lineno">   56 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>  = GT</span></span>
+<span class="lineno">   57 </span>
+<span class="lineno">   58 </span><span class="decl"><span class="nottickedoff">bad (b1, [], b2) = b1 /= b2</span>
+<span class="lineno">   59 </span><span class="spaces"></span><span class="nottickedoff">bad (b1, is, b2) = bad' b1 is || b2 /= b3</span>
+<span class="lineno">   60 </span><span class="spaces">  </span><span class="nottickedoff">where (_, b3, _) = last is</span></span>
+<span class="lineno">   61 </span>
+<span class="lineno">   62 </span><span class="decl"><span class="nottickedoff">bad' b [] = False</span>
+<span class="lineno">   63 </span><span class="spaces"></span><span class="nottickedoff">bad' b ((_, c, _) : is) = b == c || bad' c is</span></span>
+<span class="lineno">   64 </span>
+<span class="lineno">   65 </span>unionIntervals :: IList a -&gt; IList a -&gt; IList a
+<span class="lineno">   66 </span><span class="decl"><span class="istickedoff">unionIntervals (isStartOpen, is, isEndOpen) (jsStartOpen, js, jsEndOpen)</span>
+<span class="lineno">   67 </span><span class="spaces">  </span><span class="istickedoff">= (isStartOpen || jsStartOpen, uniIntervals is js, isEndOpen || jsEndOpen)</span>
+<span class="lineno">   68 </span><span class="spaces">  </span><span class="istickedoff">where uniIntervals is [] | <span class="tickonlyfalse">jsEndOpen</span> = <span class="nottickedoff">[]</span></span>
+<span class="lineno">   69 </span><span class="spaces">                           </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span> = is</span>
+<span class="lineno">   70 </span><span class="spaces">        </span><span class="istickedoff">uniIntervals [] js | <span class="tickonlyfalse">isEndOpen</span> = <span class="nottickedoff">[]</span></span>
+<span class="lineno">   71 </span><span class="spaces">                           </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span> = js</span>
+<span class="lineno">   72 </span><span class="spaces">        </span><span class="istickedoff">uniIntervals is@(i : is') js@(j : js')</span>
+<span class="lineno">   73 </span><span class="spaces">          </span><span class="istickedoff">= case cmpI i j of</span>
+<span class="lineno">   74 </span><span class="spaces">            </span><span class="istickedoff">EQ -&gt; <span class="nottickedoff">if isEntry i == isEntry j then i : uniIntervals is' js'</span></span>
+<span class="lineno">   75 </span><span class="spaces">                                            </span><span class="istickedoff"><span class="nottickedoff">else uniIntervals is' js'</span></span>
+<span class="lineno">   76 </span><span class="spaces">            </span><span class="istickedoff">LT -&gt; if <span class="tickonlytrue">isEntry j</span> then i : <span class="nottickedoff">uniIntervals is' js</span></span>
+<span class="lineno">   77 </span><span class="spaces">                               </span><span class="istickedoff">else     <span class="nottickedoff">uniIntervals is' js</span></span>
+<span class="lineno">   78 </span><span class="spaces">            </span><span class="istickedoff">GT -&gt; if <span class="tickonlytrue">isEntry i</span> then j : uniIntervals is js'</span>
+<span class="lineno">   79 </span><span class="spaces">                               </span><span class="istickedoff">else     <span class="nottickedoff">uniIntervals is js'</span></span></span>
+<span class="lineno">   80 </span>
+<span class="lineno">   81 </span>intersectIntervals :: IList a -&gt; IList a -&gt; IList a
+<span class="lineno">   82 </span><span class="decl"><span class="nottickedoff">intersectIntervals is js</span>
+<span class="lineno">   83 </span><span class="spaces">  </span><span class="nottickedoff">= complementIntervals (unionIntervals is' js')</span>
+<span class="lineno">   84 </span><span class="spaces">  </span><span class="nottickedoff">where is' = complementIntervals is</span>
+<span class="lineno">   85 </span><span class="spaces">        </span><span class="nottickedoff">js' = complementIntervals js</span></span>
+<span class="lineno">   86 </span>
+<span class="lineno">   87 </span>differenceIntervals :: IList a -&gt; IList a -&gt; IList a
+<span class="lineno">   88 </span><span class="decl"><span class="nottickedoff">differenceIntervals is js</span>
+<span class="lineno">   89 </span><span class="spaces">  </span><span class="nottickedoff">= complementIntervals (unionIntervals is' js)</span>
+<span class="lineno">   90 </span><span class="spaces">  </span><span class="nottickedoff">where is' = complementIntervals is</span></span>
+<span class="lineno">   91 </span>
+<span class="lineno">   92 </span>complementIntervals :: IList a -&gt; IList a
+<span class="lineno">   93 </span><span class="decl"><span class="nottickedoff">complementIntervals (o1, is, o2)</span>
+<span class="lineno">   94 </span><span class="spaces">  </span><span class="nottickedoff">= (not o1, [ (i, not isentry, a) | (i, isentry, a) &lt;- is ], not o2)</span></span>
+<span class="lineno">   95 </span>
+<span class="lineno">   96 </span>-- tests...
+<span class="lineno">   97 </span>
+<span class="lineno">   98 </span>{-
+<span class="lineno">   99 </span>mkIn, mkOut :: Double -&gt; Intersection a
+<span class="lineno">  100 </span>mkIn x = (x, True, undefined)
+<span class="lineno">  101 </span>mkOut x = (x, False, undefined)
+<span class="lineno">  102 </span>
+<span class="lineno">  103 </span>i1 =  (False, [ mkIn 2, mkOut 7 ], False)
+<span class="lineno">  104 </span>i1' = (True, [ mkOut 2, mkIn 7 ], True)
+<span class="lineno">  105 </span>i2 =  (False, [ mkIn 1, mkOut 3, mkIn 4, mkOut 5, mkIn 6, mkOut 8 ], False)
+<span class="lineno">  106 </span>
+<span class="lineno">  107 </span>t1 = unionIntervals i1 i2
+<span class="lineno">  108 </span>t2 = intersectIntervals i1 i2
+<span class="lineno">  109 </span>t3 = intersectIntervals i2 i1
+<span class="lineno">  110 </span>t4 = complementIntervals i1
+<span class="lineno">  111 </span>t5 = intersectIntervals i2 i1'
+<span class="lineno">  112 </span>t6 = differenceIntervals i2 i1
+<span class="lineno">  113 </span>t7 = differenceIntervals i2 i2
+<span class="lineno">  114 </span>
+<span class="lineno">  115 </span>sh (o1,is,o2) =
+<span class="lineno">  116 </span>    do  if o1 then putStr &quot;...&quot; else return ()
+<span class="lineno">  117 </span>        putStr $ foldr1 (++) (map si is)
+<span class="lineno">  118 </span>        if o2 then putStr &quot;...&quot; else return ()
+<span class="lineno">  119 </span>si (i, True, _, _) = &quot;&lt;&quot; ++ show i
+<span class="lineno">  120 </span>si (i, False, _, _) = &quot; &quot; ++ show i ++ &quot;&gt;&quot;
+<span class="lineno">  121 </span>-}
+
+</pre>
+</html>
+Writing: Geometry.hs.html
+<html><style type="text/css">
+span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
+span.nottickedoff { background: yellow}
+span.istickedoff { background: white }
+span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
+span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
+span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
+span.decl { font-weight: bold }
+span.spaces    { background: white }
+</style>
+<pre>
+<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
+<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
+<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
+<span class="lineno">    4 </span>-- which is included in the distribution.
+<span class="lineno">    5 </span>
+<span class="lineno">    6 </span>module Geometry
+<span class="lineno">    7 </span>    ( Coords
+<span class="lineno">    8 </span>    , Ray
+<span class="lineno">    9 </span>    , Point  -- abstract
+<span class="lineno">   10 </span>    , Vector -- abstract
+<span class="lineno">   11 </span>    , Matrix -- abstract
+<span class="lineno">   12 </span>    , Color  -- abstract
+<span class="lineno">   13 </span>    , Box(..)
+<span class="lineno">   14 </span>    , Radian
+<span class="lineno">   15 </span>    , matrix
+<span class="lineno">   16 </span>    , coord
+<span class="lineno">   17 </span>    , color
+<span class="lineno">   18 </span>    , uncolor
+<span class="lineno">   19 </span>    , xCoord , yCoord , zCoord
+<span class="lineno">   20 </span>    , xComponent , yComponent , zComponent
+<span class="lineno">   21 </span>    , point
+<span class="lineno">   22 </span>    , vector
+<span class="lineno">   23 </span>    , nearV
+<span class="lineno">   24 </span>    , point_to_vector
+<span class="lineno">   25 </span>    , vector_to_point
+<span class="lineno">   26 </span>    , dot
+<span class="lineno">   27 </span>    , cross
+<span class="lineno">   28 </span>    , tangents
+<span class="lineno">   29 </span>    , addVV
+<span class="lineno">   30 </span>    , addPV
+<span class="lineno">   31 </span>    , subVV
+<span class="lineno">   32 </span>    , negV
+<span class="lineno">   33 </span>    , subPP
+<span class="lineno">   34 </span>    , norm
+<span class="lineno">   35 </span>    , normalize
+<span class="lineno">   36 </span>    , dist2
+<span class="lineno">   37 </span>    , sq
+<span class="lineno">   38 </span>    , distFrom0Sq
+<span class="lineno">   39 </span>    , distFrom0
+<span class="lineno">   40 </span>    , multSV
+<span class="lineno">   41 </span>    , multMM
+<span class="lineno">   42 </span>    , transposeM
+<span class="lineno">   43 </span>    , multMV
+<span class="lineno">   44 </span>    , multMP
+<span class="lineno">   45 </span>    , multMQ
+<span class="lineno">   46 </span>    , multMR
+<span class="lineno">   47 </span>    , white
+<span class="lineno">   48 </span>    , black
+<span class="lineno">   49 </span>    , addCC
+<span class="lineno">   50 </span>    , subCC
+<span class="lineno">   51 </span>    , sumCC
+<span class="lineno">   52 </span>    , multCC
+<span class="lineno">   53 </span>    , multSC
+<span class="lineno">   54 </span>    , nearC
+<span class="lineno">   55 </span>    , offsetToPoint
+<span class="lineno">   56 </span>    , epsilon
+<span class="lineno">   57 </span>    , inf
+<span class="lineno">   58 </span>    , nonZero
+<span class="lineno">   59 </span>    , eqEps
+<span class="lineno">   60 </span>    , near
+<span class="lineno">   61 </span>    , clampf
+<span class="lineno">   62 </span>    ) where
+<span class="lineno">   63 </span>
+<span class="lineno">   64 </span>import List 
+<span class="lineno">   65 </span>
+<span class="lineno">   66 </span>type Coords = (Double,Double,Double)
+<span class="lineno">   67 </span>
+<span class="lineno">   68 </span>type Ray = (Point,Vector)    -- origin of ray, and unit vector giving direction
+<span class="lineno">   69 </span>
+<span class="lineno">   70 </span>data Point  = P !Double !Double !Double -- implicit extra arg of 1
+<span class="lineno">   71 </span>    deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>)
+<span class="lineno">   72 </span>data Vector = V !Double !Double !Double -- implicit extra arg of 0
+<span class="lineno">   73 </span>    deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Eq</span></span></span></span>)
+<span class="lineno">   74 </span>data Matrix = M !Quad   !Quad   !Quad   !Quad
+<span class="lineno">   75 </span>    deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>)
+<span class="lineno">   76 </span>
+<span class="lineno">   77 </span>data Color  = C !Double !Double !Double
+<span class="lineno">   78 </span>    deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>, <span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Eq</span></span></span></span>)
+<span class="lineno">   79 </span>
+<span class="lineno">   80 </span>data Box = B !Double !Double !Double !Double !Double !Double
+<span class="lineno">   81 </span>    deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>)
+<span class="lineno">   82 </span>
+<span class="lineno">   83 </span>data Quad   = Q !Double !Double !Double !Double
+<span class="lineno">   84 </span>    deriving (<span class="decl"><span class="nottickedoff"><span class="decl"><span class="nottickedoff">Show</span></span></span></span>)
+<span class="lineno">   85 </span>
+<span class="lineno">   86 </span>type Radian = Double
+<span class="lineno">   87 </span>
+<span class="lineno">   88 </span>type Tup4 a = (a,a,a,a)
+<span class="lineno">   89 </span>
+<span class="lineno">   90 </span>--{-# INLINE matrix #-}
+<span class="lineno">   91 </span>matrix :: Tup4 (Tup4 Double) -&gt; Matrix
+<span class="lineno">   92 </span><span class="decl"><span class="istickedoff">matrix ((m11, m12, m13, m14),</span>
+<span class="lineno">   93 </span><span class="spaces">          </span><span class="istickedoff">(m21, m22, m23, m24),</span>
+<span class="lineno">   94 </span><span class="spaces">          </span><span class="istickedoff">(m31, m32, m33, m34),</span>
+<span class="lineno">   95 </span><span class="spaces">          </span><span class="istickedoff">(m41, m42, m43, m44))</span>
+<span class="lineno">   96 </span><span class="spaces">  </span><span class="istickedoff">= M (Q m11 m12 m13 m14)</span>
+<span class="lineno">   97 </span><span class="spaces">      </span><span class="istickedoff">(Q m21 m22 m23 m24)</span>
+<span class="lineno">   98 </span><span class="spaces">      </span><span class="istickedoff">(Q m31 m32 m33 m34)</span>
+<span class="lineno">   99 </span><span class="spaces">      </span><span class="istickedoff">(Q m41 m42 m43 m44)</span></span>
+<span class="lineno">  100 </span>
+<span class="lineno">  101 </span><span class="decl"><span class="nottickedoff">coord x y z = (x, y, z)</span></span>
+<span class="lineno">  102 </span>
+<span class="lineno">  103 </span><span class="decl"><span class="istickedoff">color r g b = C r g b</span></span>
+<span class="lineno">  104 </span>
+<span class="lineno">  105 </span><span class="decl"><span class="istickedoff">uncolor (C r g b) = (r,g,b)</span></span>
+<span class="lineno">  106 </span>
+<span class="lineno">  107 </span>{-# INLINE xCoord #-}
+<span class="lineno">  108 </span><span class="decl"><span class="istickedoff">xCoord (P x y z) = x</span></span>
+<span class="lineno">  109 </span>{-# INLINE yCoord #-}
+<span class="lineno">  110 </span><span class="decl"><span class="istickedoff">yCoord (P x y z) = y</span></span>
+<span class="lineno">  111 </span>{-# INLINE zCoord #-}
+<span class="lineno">  112 </span><span class="decl"><span class="istickedoff">zCoord (P x y z) = z</span></span>
+<span class="lineno">  113 </span>
+<span class="lineno">  114 </span>{-# INLINE xComponent #-}
+<span class="lineno">  115 </span><span class="decl"><span class="istickedoff">xComponent (V x y z) = x</span></span>
+<span class="lineno">  116 </span>{-# INLINE yComponent #-}
+<span class="lineno">  117 </span><span class="decl"><span class="istickedoff">yComponent (V x y z) = y</span></span>
+<span class="lineno">  118 </span>{-# INLINE zComponent #-}
+<span class="lineno">  119 </span><span class="decl"><span class="istickedoff">zComponent (V x y z) = z</span></span>
+<span class="lineno">  120 </span>
+<span class="lineno">  121 </span>point :: Double -&gt; Double -&gt; Double -&gt; Point
+<span class="lineno">  122 </span><span class="decl"><span class="istickedoff">point x y z = P x y z</span></span>
+<span class="lineno">  123 </span>
+<span class="lineno">  124 </span>vector :: Double -&gt; Double -&gt; Double -&gt; Vector
+<span class="lineno">  125 </span><span class="decl"><span class="istickedoff">vector x y z = V x y z</span></span>
+<span class="lineno">  126 </span>
+<span class="lineno">  127 </span>nearV :: Vector -&gt; Vector -&gt; Bool
+<span class="lineno">  128 </span><span class="decl"><span class="nottickedoff">nearV (V a b c) (V d e f) = a `near` d &amp;&amp; b `near` e &amp;&amp; c `near` f</span></span>
+<span class="lineno">  129 </span>
+<span class="lineno">  130 </span>point_to_vector :: Point -&gt; Vector
+<span class="lineno">  131 </span><span class="decl"><span class="nottickedoff">point_to_vector (P x y z) = V x y z</span></span>
+<span class="lineno">  132 </span>
+<span class="lineno">  133 </span>vector_to_point :: Vector -&gt; Point
+<span class="lineno">  134 </span><span class="decl"><span class="nottickedoff">vector_to_point (V x y z)  = P x y z</span></span> 
+<span class="lineno">  135 </span>
+<span class="lineno">  136 </span>{-# INLINE vector_to_quad #-}
+<span class="lineno">  137 </span>vector_to_quad :: Vector -&gt; Quad
+<span class="lineno">  138 </span><span class="decl"><span class="istickedoff">vector_to_quad (V x y z) = Q x y z 0</span></span>
+<span class="lineno">  139 </span>
+<span class="lineno">  140 </span>{-# INLINE point_to_quad #-}
+<span class="lineno">  141 </span>point_to_quad :: Point -&gt; Quad
+<span class="lineno">  142 </span><span class="decl"><span class="istickedoff">point_to_quad (P x y z) = Q x y z 1</span></span>
+<span class="lineno">  143 </span>
+<span class="lineno">  144 </span>{-# INLINE quad_to_point #-}
+<span class="lineno">  145 </span>quad_to_point :: Quad -&gt; Point
+<span class="lineno">  146 </span><span class="decl"><span class="istickedoff">quad_to_point (Q x y z _) = P x y z</span></span>
+<span class="lineno">  147 </span>
+<span class="lineno">  148 </span>{-# INLINE quad_to_vector #-}
+<span class="lineno">  149 </span>quad_to_vector :: Quad -&gt; Vector
+<span class="lineno">  150 </span><span class="decl"><span class="istickedoff">quad_to_vector (Q x y z _) = V x y z</span></span>
+<span class="lineno">  151 </span>
+<span class="lineno">  152 </span>--{-# INLINE dot #-}
+<span class="lineno">  153 </span>dot :: Vector -&gt; Vector -&gt; Double
+<span class="lineno">  154 </span><span class="decl"><span class="istickedoff">dot (V x1 y1 z1) (V x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2</span></span>
+<span class="lineno">  155 </span>
+<span class="lineno">  156 </span>cross :: Vector -&gt; Vector -&gt; Vector
+<span class="lineno">  157 </span><span class="decl"><span class="istickedoff">cross (V x1 y1 z1) (V x2 y2 z2)</span>
+<span class="lineno">  158 </span><span class="spaces">  </span><span class="istickedoff">= V (y1 * z2 - z1 * y2) (z1 * x2 - x1 * z2) (x1 * y2 - y1 * x2)</span></span>
+<span class="lineno">  159 </span>
+<span class="lineno">  160 </span>-- assumption: the input vector is a normal
+<span class="lineno">  161 </span>tangents :: Vector -&gt; (Vector, Vector)
+<span class="lineno">  162 </span><span class="decl"><span class="nottickedoff">tangents v@(V x y z)</span>
+<span class="lineno">  163 </span><span class="spaces">  </span><span class="nottickedoff">= (v1, v `cross` v1)</span>
+<span class="lineno">  164 </span><span class="spaces">  </span><span class="nottickedoff">where v1 | x == 0    = normalize (vector 0 z (-y))</span>
+<span class="lineno">  165 </span><span class="spaces">           </span><span class="nottickedoff">| otherwise = normalize (vector (-y) x 0)</span></span>
+<span class="lineno">  166 </span>
+<span class="lineno">  167 </span>{-# INLINE dot4 #-}
+<span class="lineno">  168 </span>dot4 :: Quad -&gt; Quad -&gt; Double
+<span class="lineno">  169 </span><span class="decl"><span class="istickedoff">dot4 (Q x1 y1 z1 w1) (Q x2 y2 z2 w2) = x1 * x2 + y1 * y2 + z1 * z2 + w1 * w2</span></span>
+<span class="lineno">  170 </span>
+<span class="lineno">  171 </span>addVV :: Vector -&gt; Vector -&gt; Vector
+<span class="lineno">  172 </span><span class="decl"><span class="nottickedoff">addVV (V x1 y1 z1) (V x2 y2 z2) </span>
+<span class="lineno">  173 </span><span class="spaces">    </span><span class="nottickedoff">= V (x1 + x2) (y1 + y2) (z1 + z2)</span></span>
+<span class="lineno">  174 </span>
+<span class="lineno">  175 </span>addPV :: Point -&gt; Vector -&gt; Point
+<span class="lineno">  176 </span><span class="decl"><span class="istickedoff">addPV (P x1 y1 z1) (V x2 y2 z2) </span>
+<span class="lineno">  177 </span><span class="spaces">    </span><span class="istickedoff">= P (x1 + x2) (y1 + y2) (z1 + z2)</span></span>
+<span class="lineno">  178 </span>
+<span class="lineno">  179 </span>subVV :: Vector -&gt; Vector -&gt; Vector
+<span class="lineno">  180 </span><span class="decl"><span class="istickedoff">subVV (V x1 y1 z1) (V x2 y2 z2) </span>
+<span class="lineno">  181 </span><span class="spaces">    </span><span class="istickedoff">= V (x1 - x2) (y1 - y2) (z1 - z2)</span></span>
+<span class="lineno">  182 </span>
+<span class="lineno">  183 </span>negV :: Vector -&gt; Vector
+<span class="lineno">  184 </span><span class="decl"><span class="nottickedoff">negV (V x1 y1 z1) </span>
+<span class="lineno">  185 </span><span class="spaces">    </span><span class="nottickedoff">= V (-x1) (-y1) (-z1)</span></span>
+<span class="lineno">  186 </span>
+<span class="lineno">  187 </span>subPP :: Point -&gt; Point -&gt; Vector
+<span class="lineno">  188 </span><span class="decl"><span class="nottickedoff">subPP (P x1 y1 z1) (P x2 y2 z2) </span>
+<span class="lineno">  189 </span><span class="spaces">    </span><span class="nottickedoff">= V (x1 - x2) (y1 - y2) (z1 - z2)</span></span>
+<span class="lineno">  190 </span>
+<span class="lineno">  191 </span>--{-# INLINE norm #-}
+<span class="lineno">  192 </span>norm :: Vector -&gt; Double
+<span class="lineno">  193 </span><span class="decl"><span class="nottickedoff">norm (V x y z) = sqrt (sq x + sq y + sq z)</span></span>
+<span class="lineno">  194 </span>
+<span class="lineno">  195 </span>--{-# INLINE normalize #-}
+<span class="lineno">  196 </span>-- normalize a vector to a unit vector
+<span class="lineno">  197 </span>normalize :: Vector -&gt; Vector
+<span class="lineno">  198 </span><span class="decl"><span class="istickedoff">normalize v@(V x y z)</span>
+<span class="lineno">  199 </span><span class="spaces">             </span><span class="istickedoff">| <span class="tickonlytrue">norm /= 0</span> = multSV (1/norm) v</span>
+<span class="lineno">  200 </span><span class="spaces">             </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span> = <span class="nottickedoff">error &quot;normalize empty!&quot;</span></span>
+<span class="lineno">  201 </span><span class="spaces">    </span><span class="istickedoff">where norm = sqrt (sq x + sq y + sq z)</span></span>
+<span class="lineno">  202 </span>
+<span class="lineno">  203 </span>-- This does computes the distance *squared*
+<span class="lineno">  204 </span>dist2 :: Point -&gt; Point -&gt; Double
+<span class="lineno">  205 </span><span class="decl"><span class="nottickedoff">dist2 us vs = sq x + sq y + sq z</span>
+<span class="lineno">  206 </span><span class="spaces">    </span><span class="nottickedoff">where</span>
+<span class="lineno">  207 </span><span class="spaces">       </span><span class="nottickedoff">(V x y z) = subPP us vs</span></span>
+<span class="lineno">  208 </span>
+<span class="lineno">  209 </span>{-# INLINE sq #-}
+<span class="lineno">  210 </span>sq :: Double -&gt; Double
+<span class="lineno">  211 </span><span class="decl"><span class="istickedoff">sq d = d * d</span></span> 
+<span class="lineno">  212 </span>
+<span class="lineno">  213 </span>{-# INLINE distFrom0Sq #-}
+<span class="lineno">  214 </span>distFrom0Sq :: Point -&gt; Double  -- Distance of point from origin.
+<span class="lineno">  215 </span><span class="decl"><span class="nottickedoff">distFrom0Sq (P x y z) = sq x + sq y + sq z</span></span>
+<span class="lineno">  216 </span>
+<span class="lineno">  217 </span>{-# INLINE distFrom0 #-}
+<span class="lineno">  218 </span>distFrom0 :: Point -&gt; Double  -- Distance of point from origin.
+<span class="lineno">  219 </span><span class="decl"><span class="nottickedoff">distFrom0 p = sqrt (distFrom0Sq p)</span></span>
+<span class="lineno">  220 </span>
+<span class="lineno">  221 </span>--{-# INLINE multSV #-}
+<span class="lineno">  222 </span>multSV :: Double -&gt; Vector -&gt; Vector
+<span class="lineno">  223 </span><span class="decl"><span class="istickedoff">multSV k (V x y z) = V (k*x) (k*y) (k*z)</span></span>
+<span class="lineno">  224 </span>
+<span class="lineno">  225 </span>--{-# INLINE multMM #-}
+<span class="lineno">  226 </span>multMM :: Matrix -&gt; Matrix -&gt; Matrix
+<span class="lineno">  227 </span><span class="decl"><span class="istickedoff">multMM m1@(M q1 q2 q3 q4) m2</span>
+<span class="lineno">  228 </span><span class="spaces">     </span><span class="istickedoff">= M (multMQ m2' q1)</span>
+<span class="lineno">  229 </span><span class="spaces">         </span><span class="istickedoff">(multMQ m2' q2)</span>
+<span class="lineno">  230 </span><span class="spaces">         </span><span class="istickedoff">(multMQ m2' q3)</span>
+<span class="lineno">  231 </span><span class="spaces">         </span><span class="istickedoff">(multMQ m2' q4)</span>
+<span class="lineno">  232 </span><span class="spaces">  </span><span class="istickedoff">where</span>
+<span class="lineno">  233 </span><span class="spaces">     </span><span class="istickedoff">m2' = transposeM m2</span></span>
+<span class="lineno">  234 </span>
+<span class="lineno">  235 </span>{-# INLINE transposeM #-}     
+<span class="lineno">  236 </span>transposeM :: Matrix -&gt; Matrix
+<span class="lineno">  237 </span><span class="decl"><span class="istickedoff">transposeM (M (Q e11  e12  e13  e14)</span>
+<span class="lineno">  238 </span><span class="spaces">              </span><span class="istickedoff">(Q e21  e22  e23  e24)</span>
+<span class="lineno">  239 </span><span class="spaces">              </span><span class="istickedoff">(Q e31  e32  e33  e34)</span>
+<span class="lineno">  240 </span><span class="spaces">              </span><span class="istickedoff">(Q e41  e42  e43  e44)) = (M (Q e11  e21  e31  e41)</span>
+<span class="lineno">  241 </span><span class="spaces">                                           </span><span class="istickedoff">(Q e12  e22  e32  e42)</span>
+<span class="lineno">  242 </span><span class="spaces">                                           </span><span class="istickedoff">(Q e13  e23  e33  e43)</span>
+<span class="lineno">  243 </span><span class="spaces">                                           </span><span class="istickedoff">(Q e14  e24  e34  e44))</span></span>
+<span class="lineno">  244 </span>
+<span class="lineno">  245 </span>
+<span class="lineno">  246 </span>--multMM m1 m2 = [map (dot4 row) (transpose m2) | row &lt;- m1]
+<span class="lineno">  247 </span>
+<span class="lineno">  248 </span>--{-# INLINE multMV #-}
+<span class="lineno">  249 </span>multMV :: Matrix -&gt; Vector -&gt; Vector
+<span class="lineno">  250 </span><span class="decl"><span class="istickedoff">multMV m v = quad_to_vector (multMQ m (vector_to_quad v))</span></span>
+<span class="lineno">  251 </span>
+<span class="lineno">  252 </span>--{-# INLINE multMP #-}
+<span class="lineno">  253 </span>multMP :: Matrix -&gt; Point -&gt; Point
+<span class="lineno">  254 </span><span class="decl"><span class="istickedoff">multMP m p = quad_to_point (multMQ m (point_to_quad p))</span></span>
+<span class="lineno">  255 </span>
+<span class="lineno">  256 </span>-- mat vec = map (dot4 vec) mat
+<span class="lineno">  257 </span>
+<span class="lineno">  258 </span>{-# INLINE multMQ #-}
+<span class="lineno">  259 </span>multMQ :: Matrix -&gt; Quad -&gt; Quad
+<span class="lineno">  260 </span><span class="decl"><span class="istickedoff">multMQ (M q1 q2 q3 q4) q</span>
+<span class="lineno">  261 </span><span class="spaces">       </span><span class="istickedoff">= Q (dot4 q q1)</span>
+<span class="lineno">  262 </span><span class="spaces">           </span><span class="istickedoff">(dot4 q q2)</span>
+<span class="lineno">  263 </span><span class="spaces">           </span><span class="istickedoff">(dot4 q q3)</span>
+<span class="lineno">  264 </span><span class="spaces">           </span><span class="istickedoff">(dot4 q q4)</span></span>
+<span class="lineno">  265 </span>
+<span class="lineno">  266 </span>{-# INLINE multMR #-}
+<span class="lineno">  267 </span>multMR :: Matrix -&gt; Ray -&gt; Ray
+<span class="lineno">  268 </span><span class="decl"><span class="istickedoff">multMR m (r, v) = (multMP m r, multMV m v)</span></span>
+<span class="lineno">  269 </span>
+<span class="lineno">  270 </span>white :: Color
+<span class="lineno">  271 </span><span class="decl"><span class="nottickedoff">white = C 1 1 1</span></span>
+<span class="lineno">  272 </span>black :: Color
+<span class="lineno">  273 </span><span class="decl"><span class="istickedoff">black = C 0 0 0</span></span>
+<span class="lineno">  274 </span>
+<span class="lineno">  275 </span>addCC :: Color -&gt; Color -&gt; Color
+<span class="lineno">  276 </span><span class="decl"><span class="istickedoff">addCC (C a b c) (C d e f) = C (a+d) (b+e) (c+f)</span></span>
+<span class="lineno">  277 </span>
+<span class="lineno">  278 </span>subCC :: Color -&gt; Color -&gt; Color
+<span class="lineno">  279 </span><span class="decl"><span class="nottickedoff">subCC (C a b c) (C d e f) = C (a-d) (b-e) (c-f)</span></span>
+<span class="lineno">  280 </span>
+<span class="lineno">  281 </span>sumCC :: [Color] -&gt; Color
+<span class="lineno">  282 </span><span class="decl"><span class="istickedoff">sumCC = foldr addCC black</span></span>
+<span class="lineno">  283 </span>
+<span class="lineno">  284 </span>multCC :: Color -&gt; Color -&gt; Color
+<span class="lineno">  285 </span><span class="decl"><span class="istickedoff">multCC (C a b c) (C d e f) = C (a*d) (b*e) (c*f)</span></span>
+<span class="lineno">  286 </span>
+<span class="lineno">  287 </span>multSC :: Double -&gt; Color -&gt; Color
+<span class="lineno">  288 </span><span class="decl"><span class="istickedoff">multSC k       (C a b c) = C (a*k) (b*k) (c*k)</span></span>
+<span class="lineno">  289 </span>
+<span class="lineno">  290 </span>nearC :: Color -&gt; Color -&gt; Bool
+<span class="lineno">  291 </span><span class="decl"><span class="istickedoff">nearC (C a b c) (C d e f) = a `near` d &amp;&amp; b `near` e &amp;&amp; c `near` f</span></span>
+<span class="lineno">  292 </span>
+<span class="lineno">  293 </span>offsetToPoint :: Ray -&gt; Double -&gt; Point
+<span class="lineno">  294 </span><span class="decl"><span class="istickedoff">offsetToPoint (r,v) i = r `addPV` (i `multSV` v)</span></span>
+<span class="lineno">  295 </span>
+<span class="lineno">  296 </span>--
+<span class="lineno">  297 </span>
+<span class="lineno">  298 </span>epsilon, inf :: Double      -- aproximate zero and infinity
+<span class="lineno">  299 </span><span class="decl"><span class="istickedoff">epsilon = 1.0e-10</span></span>
+<span class="lineno">  300 </span><span class="decl"><span class="istickedoff">inf = 1.0e20</span></span>
+<span class="lineno">  301 </span>
+<span class="lineno">  302 </span>nonZero :: Double -&gt; Double         -- Use before a division. It makes definitions
+<span class="lineno">  303 </span><span class="decl"><span class="istickedoff">nonZero x | <span class="tickonlytrue">x &gt; epsilon</span>  = x        -- more complete and I bet the errors that get </span>
+<span class="lineno">  304 </span><span class="spaces">          </span><span class="istickedoff">| <span class="nottickedoff">x &lt; -epsilon</span> = <span class="nottickedoff">x</span>        -- introduced will be undetectable if epsilon</span>
+<span class="lineno">  305 </span><span class="spaces">          </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span>    = <span class="nottickedoff">epsilon</span></span></span>  -- is small enough
+<span class="lineno">  306 </span>
+<span class="lineno">  307 </span>
+<span class="lineno">  308 </span><span class="decl"><span class="istickedoff">eqEps x y = abs (x-y) &lt; epsilon</span></span>
+<span class="lineno">  309 </span><span class="decl"><span class="istickedoff">near = eqEps</span></span>
+<span class="lineno">  310 </span>
+<span class="lineno">  311 </span>clampf :: Double -&gt; Double
+<span class="lineno">  312 </span><span class="decl"><span class="istickedoff">clampf p | <span class="tickonlyfalse">p &lt; 0</span> = <span class="nottickedoff">0</span></span>
+<span class="lineno">  313 </span><span class="spaces">         </span><span class="istickedoff">| p &gt; 1 = 1</span>
+<span class="lineno">  314 </span><span class="spaces">         </span><span class="istickedoff">| <span class="tickonlytrue">True</span>  = p</span></span>
 
 </pre>
 </html>
 
 </pre>
 </html>
-Writing: Primitives.hs.html
+Writing: Intersections.hs.html
 <html><style type="text/css">
 span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
 span.nottickedoff { background: yellow}
 <html><style type="text/css">
 span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
 span.nottickedoff { background: yellow}
@@ -2351,395 +1909,837 @@ span.spaces    { background: white }
 <span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
 <span class="lineno">    4 </span>-- which is included in the distribution.
 <span class="lineno">    5 </span>
 <span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
 <span class="lineno">    4 </span>-- which is included in the distribution.
 <span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module Primitives where
-<span class="lineno">    7 </span>
-<span class="lineno">    8 </span>rad2deg :: Double -&gt; Double
-<span class="lineno">    9 </span><span class="decl"><span class="nottickedoff">rad2deg r = r * 180 / pi</span></span>
+<span class="lineno">    6 </span>module Intersections 
+<span class="lineno">    7 </span>    ( intersectRayWithObject,
+<span class="lineno">    8 </span>      quadratic
+<span class="lineno">    9 </span>    ) where
 <span class="lineno">   10 </span>
 <span class="lineno">   10 </span>
-<span class="lineno">   11 </span>deg2rad :: Double -&gt; Double
-<span class="lineno">   12 </span><span class="decl"><span class="istickedoff">deg2rad d = d * pi / 180</span></span>
-<span class="lineno">   13 </span>
-<span class="lineno">   14 </span>addi :: Int -&gt; Int -&gt; Int
-<span class="lineno">   15 </span><span class="decl"><span class="nottickedoff">addi = (+)</span></span>
-<span class="lineno">   16 </span>
-<span class="lineno">   17 </span>addf :: Double -&gt; Double -&gt; Double
-<span class="lineno">   18 </span><span class="decl"><span class="nottickedoff">addf = (+)</span></span>
-<span class="lineno">   19 </span>
-<span class="lineno">   20 </span>acosD :: Double -&gt; Double
-<span class="lineno">   21 </span><span class="decl"><span class="nottickedoff">acosD x = acos x * 180 / pi</span></span>
-<span class="lineno">   22 </span>
-<span class="lineno">   23 </span>asinD :: Double -&gt; Double
-<span class="lineno">   24 </span><span class="decl"><span class="nottickedoff">asinD x = asin x * 180 / pi</span></span>
-
-</pre>
-</html>
-Writing: Eval.hs.html
-<html><style type="text/css">
-span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }
-span.nottickedoff { background: yellow}
-span.istickedoff { background: white }
-span.tickonlyfalse { margin: -1px; border: 1px solid #f20913; background: #f20913 }
-span.tickonlytrue  { margin: -1px; border: 1px solid #60de51; background: #60de51 }
-span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }
-span.decl { font-weight: bold }
-span.spaces    { background: white }
-</style>
-<pre>
-<span class="lineno">    1 </span>-- Copyright (c) 2000 Galois Connections, Inc.
-<span class="lineno">    2 </span>-- All rights reserved.  This software is distributed as
-<span class="lineno">    3 </span>-- free software under the license in the file &quot;LICENSE&quot;,
-<span class="lineno">    4 </span>-- which is included in the distribution.
-<span class="lineno">    5 </span>
-<span class="lineno">    6 </span>module Eval where
-<span class="lineno">    7 </span>
-<span class="lineno">    8 </span>import Array
-<span class="lineno">    9 </span>
-<span class="lineno">   10 </span>import Geometry
-<span class="lineno">   11 </span>import CSG
-<span class="lineno">   12 </span>import Surface
-<span class="lineno">   13 </span>import Data
-<span class="lineno">   14 </span>import Parse (rayParse, rayParseF)
-<span class="lineno">   15 </span>
-<span class="lineno">   16 </span>class Monad m =&gt; MonadEval m where
-<span class="lineno">   17 </span>  doOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; m Stack
-<span class="lineno">   18 </span>  tick :: m ()
-<span class="lineno">   19 </span>  err  :: String -&gt; m a
-<span class="lineno">   20 </span>
-<span class="lineno">   21 </span>  <span class="decl"><span class="istickedoff">tick = return <span class="nottickedoff">()</span></span></span>
+<span class="lineno">   11 </span>import Maybe(isJust)
+<span class="lineno">   12 </span>
+<span class="lineno">   13 </span>import Construct
+<span class="lineno">   14 </span>import Geometry
+<span class="lineno">   15 </span>import Interval
+<span class="lineno">   16 </span>import Misc
+<span class="lineno">   17 </span>
+<span class="lineno">   18 </span>-- This is factored into two bits.  The main function `intersections'
+<span class="lineno">   19 </span>-- intersects a line with an object.
+<span class="lineno">   20 </span>-- The wrapper call `intersectRayWithObject' coerces this to an intersection
+<span class="lineno">   21 </span>-- with a ray by clamping the result to start at 0.
 <span class="lineno">   22 </span>
 <span class="lineno">   22 </span>
-<span class="lineno">   23 </span>newtype Pure a = Pure a deriving Show
-<span class="lineno">   24 </span>
-<span class="lineno">   25 </span>instance Monad Pure where
-<span class="lineno">   26 </span>    <span class="decl"><span class="istickedoff">Pure x &gt;&gt;= k = k x</span></span>
-<span class="lineno">   27 </span>    <span class="decl"><span class="istickedoff">return       = Pure</span></span>
-<span class="lineno">   28 </span>    <span class="decl"><span class="nottickedoff">fail s       = error s</span></span>
-<span class="lineno">   29 </span>
-<span class="lineno">   30 </span>instance MonadEval Pure where
-<span class="lineno">   31 </span>  <span class="decl"><span class="istickedoff">doOp   = doPureOp</span></span> 
-<span class="lineno">   32 </span>  <span class="decl"><span class="nottickedoff">err  s = error s</span></span>
-<span class="lineno">   33 </span>
-<span class="lineno">   34 </span>instance MonadEval IO where
-<span class="lineno">   35 </span>  <span class="decl"><span class="istickedoff">doOp prim op stk = do { -- putStrLn (&quot;Calling &quot; ++ show op</span>
-<span class="lineno">   36 </span><span class="spaces">                          </span><span class="istickedoff">--           ++ &quot; &lt;&lt; &quot; ++ show stk ++ &quot; &gt;&gt;&quot;)</span>
-<span class="lineno">   37 </span><span class="spaces">                          </span><span class="istickedoff">doAllOp  prim op stk</span>
-<span class="lineno">   38 </span><span class="spaces">                        </span><span class="istickedoff">}</span></span>
-<span class="lineno">   39 </span>  <span class="decl"><span class="nottickedoff">err  s = error s</span></span>
+<span class="lineno">   23 </span><span class="decl"><span class="istickedoff">intersectRayWithObject ray p</span>
+<span class="lineno">   24 </span><span class="spaces">  </span><span class="istickedoff">= clampIntervals is</span>
+<span class="lineno">   25 </span><span class="spaces">  </span><span class="istickedoff">where is = intersections ray p</span></span>
+<span class="lineno">   26 </span>
+<span class="lineno">   27 </span><span class="decl"><span class="istickedoff">clampIntervals (True, [], True) = <span class="nottickedoff">(False, [(0, True, undefined)], True)</span></span>
+<span class="lineno">   28 </span><span class="spaces"></span><span class="istickedoff">clampIntervals empty@(False, [], False) = empty</span>
+<span class="lineno">   29 </span><span class="spaces"></span><span class="istickedoff">clampIntervals (True, is@((i, False, p) : is'), isOpen)</span>
+<span class="lineno">   30 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">i `near` 0 || i &lt; 0</span></span>
+<span class="lineno">   31 </span><span class="spaces">  </span><span class="istickedoff">= clampIntervals (False, is', isOpen)</span>
+<span class="lineno">   32 </span><span class="spaces">  </span><span class="istickedoff">| <span class="nottickedoff">otherwise</span></span>
+<span class="lineno">   33 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">(False, (0, True, undefined) : is, isOpen)</span></span>
+<span class="lineno">   34 </span><span class="spaces"></span><span class="istickedoff">clampIntervals ivals@(False, is@((i, True, p) : is'), isOpen)</span>
+<span class="lineno">   35 </span><span class="spaces">  </span><span class="istickedoff">| i `near` 0 || i &lt; 0</span>
+<span class="lineno">   36 </span><span class="spaces">  </span><span class="istickedoff">-- can unify this with first case...</span>
+<span class="lineno">   37 </span><span class="spaces">  </span><span class="istickedoff">= clampIntervals (True, is', isOpen)</span>
+<span class="lineno">   38 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span></span>
+<span class="lineno">   39 </span><span class="spaces">  </span><span class="istickedoff">= ivals</span></span>
 <span class="lineno">   40 </span>
 <span class="lineno">   40 </span>
-<span class="lineno">   41 </span>data State
-<span class="lineno">   42 </span>        = State { env   :: Env
-<span class="lineno">   43 </span>                , stack :: Stack
-<span class="lineno">   44 </span>                , code  :: Code
-<span class="lineno">   45 </span>                } deriving Show
-<span class="lineno">   46 </span>
-<span class="lineno">   47 </span>callback :: Env -&gt; Code -&gt; Stack -&gt; Stack
-<span class="lineno">   48 </span><span class="decl"><span class="istickedoff">callback env code stk</span>
-<span class="lineno">   49 </span><span class="spaces">      </span><span class="istickedoff">= case eval (State { env = env, stack = stk, code = code}) of</span>
-<span class="lineno">   50 </span><span class="spaces">             </span><span class="istickedoff">Pure stk -&gt; stk</span></span>
-<span class="lineno">   51 </span>
-<span class="lineno">   52 </span>{-# SPECIALIZE eval ::  State -&gt; Pure Stack #-}
-<span class="lineno">   53 </span>{-# SPECIALIZE eval ::  State -&gt; IO Stack #-}
-<span class="lineno">   54 </span>
-<span class="lineno">   55 </span>eval :: MonadEval m =&gt; State -&gt; m Stack
-<span class="lineno">   56 </span><span class="decl"><span class="istickedoff">eval st =</span>
-<span class="lineno">   57 </span><span class="spaces">  </span><span class="istickedoff">do { () &lt;- return () -- $ unsafePerformIO (print st)   -- Functional debugger</span>
-<span class="lineno">   58 </span><span class="spaces">     </span><span class="istickedoff">; if moreCode st then</span>
-<span class="lineno">   59 </span><span class="spaces">       </span><span class="istickedoff">do { tick             -- tick first, so as to catch loops on new eval.</span>
-<span class="lineno">   60 </span><span class="spaces">            </span><span class="istickedoff">; st' &lt;- step st</span>
-<span class="lineno">   61 </span><span class="spaces">            </span><span class="istickedoff">; eval st'</span>
-<span class="lineno">   62 </span><span class="spaces">            </span><span class="istickedoff">}</span>
-<span class="lineno">   63 </span><span class="spaces">        </span><span class="istickedoff">else return (stack st)</span>
-<span class="lineno">   64 </span><span class="spaces">     </span><span class="istickedoff">}</span></span>
-<span class="lineno">   65 </span>     
-<span class="lineno">   66 </span>moreCode :: State -&gt; Bool
-<span class="lineno">   67 </span><span class="decl"><span class="istickedoff">moreCode (State {code = []}) = False</span>
-<span class="lineno">   68 </span><span class="spaces"></span><span class="istickedoff">moreCode _                   = True</span></span>
-<span class="lineno">   69 </span>
-<span class="lineno">   70 </span>-- Step has a precondition that there *is* code to run
-<span class="lineno">   71 </span>{-# SPECIALIZE step ::  State -&gt; Pure State #-}
-<span class="lineno">   72 </span>{-# SPECIALIZE step ::  State -&gt; IO State #-}
-<span class="lineno">   73 </span>step :: MonadEval m =&gt; State -&gt; m State
-<span class="lineno">   74 </span>
-<span class="lineno">   75 </span>-- Rule 1: Pushing BaseValues
-<span class="lineno">   76 </span><span class="decl"><span class="istickedoff">step st@(State{ stack = stack, code = (TBool b):cs })    </span>
-<span class="lineno">   77 </span><span class="spaces">    </span><span class="istickedoff">= <span class="nottickedoff">return (st { stack = (VBool b):stack,    code = cs })</span></span>
-<span class="lineno">   78 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ stack = stack, code = (TInt i):cs })     </span>
-<span class="lineno">   79 </span><span class="spaces">    </span><span class="istickedoff">= return (st { stack = (VInt i):stack,     code = cs })</span>
-<span class="lineno">   80 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ stack = stack, code = (TReal r):cs })    </span>
-<span class="lineno">   81 </span><span class="spaces">    </span><span class="istickedoff">= return (st { stack = (VReal r):stack,    code = cs })</span>
-<span class="lineno">   82 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ stack = stack, code = (TString s):cs })  </span>
-<span class="lineno">   83 </span><span class="spaces">    </span><span class="istickedoff">= return (st { stack = (VString <span class="nottickedoff">s</span>):stack,  code = cs })</span>
-<span class="lineno">   84 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   85 </span><span class="spaces"></span><span class="istickedoff">-- Rule 2: Name binding</span>
-<span class="lineno">   86 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = (v:stack), code = (TBind id):cs }) =</span>
-<span class="lineno">   87 </span><span class="spaces">  </span><span class="istickedoff">return (State { env = extendEnv env id v, stack = stack,  code = cs })</span>
-<span class="lineno">   88 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = [], code = (TBind id):cs }) =</span>
-<span class="lineno">   89 </span><span class="spaces">  </span><span class="istickedoff"><span class="nottickedoff">err &quot;Attempt to bind the top of an empty stack&quot;</span></span>
-<span class="lineno">   90 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   91 </span><span class="spaces"></span><span class="istickedoff">-- Rule 3: Name lookup</span>
-<span class="lineno">   92 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = stack, code = (TId id):cs }) =</span>
-<span class="lineno">   93 </span><span class="spaces">  </span><span class="istickedoff">case (lookupEnv env id) of</span>
-<span class="lineno">   94 </span><span class="spaces">  </span><span class="istickedoff">Just v -&gt; return (st { stack = v:stack,  code = cs })</span>
-<span class="lineno">   95 </span><span class="spaces">  </span><span class="istickedoff">Nothing -&gt; <span class="nottickedoff">err (&quot;Cannot find value for identifier: &quot; ++ id)</span></span>
-<span class="lineno">   96 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">   97 </span><span class="spaces"></span><span class="istickedoff">-- Rule 4: Closure creation</span>
-<span class="lineno">   98 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = stack, code = (TBody body):cs }) =</span>
-<span class="lineno">   99 </span><span class="spaces">  </span><span class="istickedoff">return (st { stack = (VClosure env body):stack, code = cs })</span>
-<span class="lineno">  100 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  101 </span><span class="spaces"></span><span class="istickedoff">-- Rule 5: Application</span>
-<span class="lineno">  102 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = (VClosure env' code'):stack, code = TApply:cs }) =</span>
-<span class="lineno">  103 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- eval (State {env = <span class="nottickedoff">env'</span>, stack = stack, code = code'})</span>
-<span class="lineno">  104 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = stk, code = cs })</span>
-<span class="lineno">  105 </span><span class="spaces">     </span><span class="istickedoff">}</span>
-<span class="lineno">  106 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = [], code = TApply:cs }) =</span>
-<span class="lineno">  107 </span><span class="spaces">  </span><span class="istickedoff"><span class="nottickedoff">err &quot;Application with an empty stack&quot;</span></span>
-<span class="lineno">  108 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = _:_, code = TApply:cs }) =</span>
-<span class="lineno">  109 </span><span class="spaces">  </span><span class="istickedoff"><span class="nottickedoff">err &quot;Application of a non-closure&quot;</span></span>
-<span class="lineno">  110 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  111 </span><span class="spaces"></span><span class="istickedoff">-- Rule 6: Arrays</span>
-<span class="lineno">  112 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = stack, code = TArray code':cs }) =</span>
-<span class="lineno">  113 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- eval (State {env = env, stack = [], code = code'})</span>
-<span class="lineno">  114 </span><span class="spaces">     </span><span class="istickedoff">; let last = length stk-1</span>
-<span class="lineno">  115 </span><span class="spaces">     </span><span class="istickedoff">; let arr = array (0,last) (zip [last,last-1..] stk)</span>
-<span class="lineno">  116 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = (VArray arr):stack, code = cs })</span>
-<span class="lineno">  117 </span><span class="spaces">     </span><span class="istickedoff">}</span>
-<span class="lineno">  118 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  119 </span><span class="spaces"></span><span class="istickedoff">-- Rule 7 &amp; 8: If statement</span>
-<span class="lineno">  120 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = (VClosure e2 c2):(VClosure e1 c1):(VBool True):stack, code = TIf:cs }) =</span>
-<span class="lineno">  121 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- eval (State {env = e1, stack = stack, code = c1})</span>
-<span class="lineno">  122 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = stk, code = cs })</span>
-<span class="lineno">  123 </span><span class="spaces">     </span><span class="istickedoff">}</span>
-<span class="lineno">  124 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = (VClosure e2 c2):(VClosure e1 c1):(VBool False):stack, code = TIf:cs }) =</span>
-<span class="lineno">  125 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- eval (State {env = e2, stack = stack, code = c2})</span>
-<span class="lineno">  126 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = stk, code = cs })</span>
-<span class="lineno">  127 </span><span class="spaces">     </span><span class="istickedoff">}</span>
-<span class="lineno">  128 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = _, code = TIf:cs }) =</span>
-<span class="lineno">  129 </span><span class="spaces">  </span><span class="istickedoff"><span class="nottickedoff">err &quot;Incorrect use of if (bad and/or inappropriate values on the stack)&quot;</span></span>
+<span class="lineno">   41 </span><span class="decl"><span class="istickedoff">intersections ray (Union p q)</span>
+<span class="lineno">   42 </span><span class="spaces">  </span><span class="istickedoff">= unionIntervals is js</span>
+<span class="lineno">   43 </span><span class="spaces">  </span><span class="istickedoff">where is = intersections ray p</span>
+<span class="lineno">   44 </span><span class="spaces">        </span><span class="istickedoff">js = intersections ray q</span>
+<span class="lineno">   45 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   46 </span><span class="spaces"></span><span class="istickedoff">intersections ray (Intersect p q)</span>
+<span class="lineno">   47 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">intersectIntervals is js</span></span>
+<span class="lineno">   48 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">is = intersections ray p</span></span>
+<span class="lineno">   49 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">js = intersections ray q</span></span>
+<span class="lineno">   50 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   51 </span><span class="spaces"></span><span class="istickedoff">intersections ray (Difference p q)</span>
+<span class="lineno">   52 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">differenceIntervals is (negateSurfaces js)</span></span>
+<span class="lineno">   53 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">is = intersections ray p</span></span>
+<span class="lineno">   54 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">js = intersections ray q</span></span>
+<span class="lineno">   55 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   56 </span><span class="spaces"></span><span class="istickedoff">intersections ray (Transform m m' p)</span>
+<span class="lineno">   57 </span><span class="spaces">  </span><span class="istickedoff">= mapI (xform m) is</span>
+<span class="lineno">   58 </span><span class="spaces">  </span><span class="istickedoff">where is = intersections (m' `multMR` ray) p</span>
+<span class="lineno">   59 </span><span class="spaces">        </span><span class="istickedoff">xform m (i, b, (s, p0)) = (i, b, (transformSurface m s, p0))</span>
+<span class="lineno">   60 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   61 </span><span class="spaces"></span><span class="istickedoff">intersections ray (Box box p)</span>
+<span class="lineno">   62 </span><span class="spaces">  </span><span class="istickedoff">| intersectWithBox ray box = intersections ray p</span>
+<span class="lineno">   63 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span> = emptyIList</span>
+<span class="lineno">   64 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   65 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Plane s)</span>
+<span class="lineno">   66 </span><span class="spaces">  </span><span class="istickedoff">= intersectPlane ray s</span>
+<span class="lineno">   67 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   68 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Sphere s)</span>
+<span class="lineno">   69 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">intersectSphere ray s</span></span>
+<span class="lineno">   70 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   71 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Cube s)</span>
+<span class="lineno">   72 </span><span class="spaces">  </span><span class="istickedoff">= intersectCube ray s</span>
+<span class="lineno">   73 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   74 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Cylinder s)</span>
+<span class="lineno">   75 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">intersectCylinder ray s</span></span>
+<span class="lineno">   76 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   77 </span><span class="spaces"></span><span class="istickedoff">intersections ray p@(Cone s)</span>
+<span class="lineno">   78 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">intersectCone ray s</span></span></span>
+<span class="lineno">   79 </span>
+<span class="lineno">   80 </span>negateSurfaces :: IList (Surface, Texture a) -&gt; IList (Surface, Texture a)
+<span class="lineno">   81 </span><span class="decl"><span class="nottickedoff">negateSurfaces = mapI negSurf</span>
+<span class="lineno">   82 </span><span class="spaces">  </span><span class="nottickedoff">where negSurf (i, b, (s,t)) = (i, b, (negateSurface s, t))</span></span>
+<span class="lineno">   83 </span>
+<span class="lineno">   84 </span><span class="decl"><span class="nottickedoff">negateSurface (Planar p0 v0 v1)</span>
+<span class="lineno">   85 </span><span class="spaces">  </span><span class="nottickedoff">= Planar p0 v1 v0</span>
+<span class="lineno">   86 </span><span class="spaces"></span><span class="nottickedoff">negateSurface (Spherical p0 v0 v1)</span>
+<span class="lineno">   87 </span><span class="spaces">  </span><span class="nottickedoff">= Spherical p0 v1 v0</span>
+<span class="lineno">   88 </span><span class="spaces"></span><span class="nottickedoff">negateSurface (Cylindrical p0 v0 v1)</span>
+<span class="lineno">   89 </span><span class="spaces">  </span><span class="nottickedoff">= Cylindrical p0 v1 v0</span>
+<span class="lineno">   90 </span><span class="spaces"></span><span class="nottickedoff">negateSurface (Conic p0 v0 v1)</span>
+<span class="lineno">   91 </span><span class="spaces">  </span><span class="nottickedoff">= Conic p0 v1 v0</span></span>
+<span class="lineno">   92 </span>
+<span class="lineno">   93 </span><span class="decl"><span class="istickedoff">transformSurface m (Planar p0 v0 v1)</span>
+<span class="lineno">   94 </span><span class="spaces">  </span><span class="istickedoff">= Planar <span class="nottickedoff">p0'</span> v0' v1'</span>
+<span class="lineno">   95 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">p0' = multMP m p0</span></span>
+<span class="lineno">   96 </span><span class="spaces">        </span><span class="istickedoff">v0' = multMV m v0</span>
+<span class="lineno">   97 </span><span class="spaces">        </span><span class="istickedoff">v1' = multMV m v1</span>
+<span class="lineno">   98 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">   99 </span><span class="spaces"></span><span class="istickedoff">transformSurface m (Spherical p0 v0 v1)</span>
+<span class="lineno">  100 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">Spherical p0' v0' v1'</span></span>
+<span class="lineno">  101 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">p0' = multMP m p0</span></span>
+<span class="lineno">  102 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v0' = multMV m v0</span></span>
+<span class="lineno">  103 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v1' = multMV m v1</span></span>
+<span class="lineno">  104 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  105 </span><span class="spaces"></span><span class="istickedoff">-- ditto as above</span>
+<span class="lineno">  106 </span><span class="spaces"></span><span class="istickedoff">transformSurface m (Cylindrical p0 v0 v1)</span>
+<span class="lineno">  107 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">Cylindrical p0' v0' v1'</span></span>
+<span class="lineno">  108 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">p0' = multMP m p0</span></span>
+<span class="lineno">  109 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v0' = multMV m v0</span></span>
+<span class="lineno">  110 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v1' = multMV m v1</span></span>
+<span class="lineno">  111 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  112 </span><span class="spaces"></span><span class="istickedoff">transformSurface m (Conic p0 v0 v1)</span>
+<span class="lineno">  113 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">Conic p0' v0' v1'</span></span>
+<span class="lineno">  114 </span><span class="spaces">  </span><span class="istickedoff">where <span class="nottickedoff">p0' = multMP m p0</span></span>
+<span class="lineno">  115 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v0' = multMV m v0</span></span>
+<span class="lineno">  116 </span><span class="spaces">        </span><span class="istickedoff"><span class="nottickedoff">v1' = multMV m v1</span></span></span>
+<span class="lineno">  117 </span>
+<span class="lineno">  118 </span>--------------------------------
+<span class="lineno">  119 </span>-- Plane
+<span class="lineno">  120 </span>--------------------------------
+<span class="lineno">  121 </span>
+<span class="lineno">  122 </span>intersectPlane :: Ray -&gt; a -&gt; IList (Surface, Texture a)
+<span class="lineno">  123 </span><span class="decl"><span class="istickedoff">intersectPlane ray texture = intersectXZPlane PlaneFace ray 0.0 texture</span></span>
+<span class="lineno">  124 </span>
+<span class="lineno">  125 </span>intersectXZPlane :: Face -&gt; Ray -&gt; Double -&gt; a -&gt; IList (Surface, Texture a)
+<span class="lineno">  126 </span><span class="decl"><span class="istickedoff">intersectXZPlane n (r,v) yoffset texture</span>
+<span class="lineno">  127 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlyfalse">b `near` 0</span></span>
+<span class="lineno">  128 </span><span class="spaces">  </span><span class="istickedoff">= -- the ray is parallel to the plane - it's either all in, or all out</span>
+<span class="lineno">  129 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">if y `near` yoffset || y &lt; yoffset then openIList else emptyIList</span></span>
 <span class="lineno">  130 </span><span class="spaces"></span><span class="istickedoff"></span>
 <span class="lineno">  130 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  131 </span><span class="spaces"></span><span class="istickedoff">-- Rule 9: Operators</span>
-<span class="lineno">  132 </span><span class="spaces"></span><span class="istickedoff">step st@(State{ env = env, stack = stack, code = (TOp op):cs }) =</span>
-<span class="lineno">  133 </span><span class="spaces">  </span><span class="istickedoff">do { stk &lt;- doOp (opFnTable ! op) op stack</span>
-<span class="lineno">  134 </span><span class="spaces">     </span><span class="istickedoff">; return (st { stack = stk, code = cs })</span>
-<span class="lineno">  135 </span><span class="spaces">     </span><span class="istickedoff">}</span>
-<span class="lineno">  136 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  137 </span><span class="spaces"></span><span class="istickedoff">-- Rule Opps</span>
-<span class="lineno">  138 </span><span class="spaces"></span><span class="istickedoff">step _ = <span class="nottickedoff">err &quot;Tripped on sidewalk while stepping.&quot;</span></span></span>
-<span class="lineno">  139 </span>
-<span class="lineno">  140 </span>
-<span class="lineno">  141 </span>--------------------------------------------------------------------------
-<span class="lineno">  142 </span>-- Operator code
-<span class="lineno">  143 </span>
-<span class="lineno">  144 </span>opFnTable :: Array GMLOp PrimOp
-<span class="lineno">  145 </span><span class="decl"><span class="istickedoff">opFnTable = array (minBound,maxBound) </span>
-<span class="lineno">  146 </span><span class="spaces">                  </span><span class="istickedoff">[ (op,prim) | (_,TOp op,prim) &lt;- opcodes ]</span></span>
-<span class="lineno">  147 </span>
-<span class="lineno">  148 </span>
-<span class="lineno">  149 </span>
-<span class="lineno">  150 </span>
-<span class="lineno">  151 </span>doPureOp :: (MonadEval m) =&gt; PrimOp -&gt; GMLOp -&gt; Stack -&gt; m Stack
-<span class="lineno">  152 </span><span class="decl"><span class="istickedoff">doPureOp _ Op_render _ = </span>
-<span class="lineno">  153 </span><span class="spaces">    </span><span class="istickedoff"><span class="nottickedoff">err (&quot;\nAttempting to call render from inside a purely functional callback.&quot;)</span></span>
-<span class="lineno">  154 </span><span class="spaces"></span><span class="istickedoff">doPureOp primOp op stk = doPrimOp primOp <span class="nottickedoff">op</span> stk</span></span> -- call the purely functional operators
+<span class="lineno">  131 </span><span class="spaces">    </span><span class="istickedoff">-- The line intersects the plane. Find t such that</span>
+<span class="lineno">  132 </span><span class="spaces">    </span><span class="istickedoff">-- (x + at, y + bt, z + ct) intersects the X-Z plane.</span>
+<span class="lineno">  133 </span><span class="spaces">    </span><span class="istickedoff">-- t may be negative (the ray starts within the halfspace),</span>
+<span class="lineno">  134 </span><span class="spaces">    </span><span class="istickedoff">-- but we'll catch that later when we clamp the intervals</span>
+<span class="lineno">  135 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  136 </span><span class="spaces">  </span><span class="istickedoff">| b &lt; 0       -- the ray is pointing downwards</span>
+<span class="lineno">  137 </span><span class="spaces">  </span><span class="istickedoff">= (False, [mkEntry (t0, (Planar <span class="nottickedoff">p0</span> v0 v1, (n, p0, texture)))], <span class="nottickedoff">True</span>)</span>
+<span class="lineno">  138 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  139 </span><span class="spaces">  </span><span class="istickedoff">| <span class="tickonlytrue">otherwise</span>   -- the ray is pointing upwards</span>
+<span class="lineno">  140 </span><span class="spaces">  </span><span class="istickedoff">= (True,  [mkExit (t0, (<span class="nottickedoff">Planar p0 v0 v1</span>, <span class="nottickedoff">(n, p0, texture)</span>))],  False)</span>
+<span class="lineno">  141 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  142 </span><span class="spaces">  </span><span class="istickedoff">where t0 = (yoffset-y) / b</span>
+<span class="lineno">  143 </span><span class="spaces">        </span><span class="istickedoff">x0 = x + a * t0</span>
+<span class="lineno">  144 </span><span class="spaces">        </span><span class="istickedoff">z0 = z + c * t0</span>
+<span class="lineno">  145 </span><span class="spaces">        </span><span class="istickedoff">p0 = point x0 0 z0</span>
+<span class="lineno">  146 </span><span class="spaces">        </span><span class="istickedoff">v0 = vector 0 0 1</span>
+<span class="lineno">  147 </span><span class="spaces">        </span><span class="istickedoff">v1 = vector 1 0 0</span>
+<span class="lineno">  148 </span><span class="spaces"></span><span class="istickedoff"></span>
+<span class="lineno">  149 </span><span class="spaces">        </span><span class="istickedoff">x = xCoord r</span>
+<span class="lineno">  150 </span><span class="spaces">        </span><span class="istickedoff">y = yCoord r</span>
+<span class="lineno">  151 </span><span class="spaces">        </span><span class="istickedoff">z = zCoord r</span>
+<span class="lineno">  152 </span><span class="spaces">        </span><span class="istickedoff">a = xComponent v</span>
+<span class="lineno">  153 </span><span class="spaces">        </span><span class="istickedoff">b = yComponent v</span>
+<span class="lineno">  154 </span><span class="spaces">        </span><span class="istickedoff">c = zComponent v</span></span>
 <span class="lineno">  155 </span>
 <span class="lineno">  155 </span>
-<span class="lineno">  156 </span>{-# SPECIALIZE doPrimOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; Pure Stack #-}
-<span class="lineno">  157 </span>{-# SPECIALIZE doPrimOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; IO Stack #-}
-<span class="lineno">  158 </span>{-# SPECIALIZE doPrimOp :: PrimOp -&gt; GMLOp -&gt; Stack -&gt; Abs Stack #-}
-<span class="lineno">  159 </span>
-<span class="lineno">  160 </span>doPrimOp ::  (MonadEval m) =&gt; PrimOp -&gt; GMLOp -&gt; Stack -&gt; m Stack
-<span class="lineno">  161 </span>
-<span class="lineno">  162 </span>-- 1 argument.
-<span class="lineno">  163 </span>
-<span class="lineno">  164 </span><span class="decl"><span class="istickedoff">doPrimOp (Int_Int fn) _ (VInt i1:stk)</span>
-<span class="lineno">  165 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">return ((VInt (fn i1)) : stk)</span></span>
-<span class="lineno">  166 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Real fn) _ (VReal r1:stk)</span>
-<span class="lineno">  167 </span><span class="spaces">  </span><span class="istickedoff">= return ((VReal (fn r1)) : stk)</span>
-<span class="lineno">  168 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Point_Real fn) _ (VPoint x y z:stk)</span>
-<span class="lineno">  169 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">return ((VReal (fn x y z)) : stk)</span></span>
-<span class="lineno">  170 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  171 </span><span class="spaces"></span><span class="istickedoff">-- This is where the callbacks happen from...</span>
-<span class="lineno">  172 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Surface_Obj fn) _ (VClosure env code:stk)</span>
-<span class="lineno">  173 </span><span class="spaces">  </span><span class="istickedoff">= case absapply env code [<span class="nottickedoff">VAbsObj AbsFACE</span>,<span class="nottickedoff">VAbsObj AbsU</span>,<span class="nottickedoff">VAbsObj AbsV</span>] of</span>
-<span class="lineno">  174 </span><span class="spaces">      </span><span class="istickedoff">Just [VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3] -&gt; </span>
-<span class="lineno">  175 </span><span class="spaces">           </span><span class="istickedoff"><span class="nottickedoff">let</span></span>
-<span class="lineno">  176 </span><span class="spaces">               </span><span class="istickedoff"><span class="nottickedoff">res = prop (color c1 c2 c3) r1 r2 r3</span></span>
-<span class="lineno">  177 </span><span class="spaces">           </span><span class="istickedoff"><span class="nottickedoff">in</span></span>
-<span class="lineno">  178 </span><span class="spaces">               </span><span class="istickedoff"><span class="nottickedoff">return ((VObject (fn (SConst res))) : stk)</span></span>
-<span class="lineno">  179 </span><span class="spaces">      </span><span class="istickedoff">_ -&gt; return ((VObject (fn (SFun call))) : stk)</span>
-<span class="lineno">  180 </span><span class="spaces">  </span><span class="istickedoff">where </span>
-<span class="lineno">  181 </span><span class="spaces">        </span><span class="istickedoff">-- The most general case</span>
-<span class="lineno">  182 </span><span class="spaces">        </span><span class="istickedoff">call i r1 r2 =</span>
-<span class="lineno">  183 </span><span class="spaces">          </span><span class="istickedoff">case callback env code [VReal r2,VReal r1,<span class="nottickedoff">VInt i</span>] of</span>
-<span class="lineno">  184 </span><span class="spaces">             </span><span class="istickedoff">[VReal r3,VReal r2,VReal r1,VPoint c1 c2 c3] </span>
-<span class="lineno">  185 </span><span class="spaces">                 </span><span class="istickedoff">-&gt; prop (color c1 c2 c3) r1 r2 r3</span>
-<span class="lineno">  186 </span><span class="spaces">             </span><span class="istickedoff">stk -&gt; <span class="nottickedoff">error (&quot;callback failed: incorrectly typed return arguments&quot;</span></span>
-<span class="lineno">  187 </span><span class="spaces">                         </span><span class="istickedoff"><span class="nottickedoff">++ show stk)</span></span>
-<span class="lineno">  188 </span><span class="spaces">       </span><span class="istickedoff"></span>
-<span class="lineno">  189 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Int fn) _ (VReal r1:stk)</span>
-<span class="lineno">  190 </span><span class="spaces">  </span><span class="istickedoff">= return ((VInt (fn r1)) : stk)</span>
-<span class="lineno">  191 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Int_Real fn) _ (VInt r1:stk)</span>
-<span class="lineno">  192 </span><span class="spaces">  </span><span class="istickedoff">= return ((VReal (fn r1)) : stk)</span>
-<span class="lineno">  193 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Arr_Int fn) _ (VArray arr:stk)</span>
-<span class="lineno">  194 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">return ((VInt (fn arr)) : stk)</span></span>
-<span class="lineno">  195 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  196 </span><span class="spaces"></span><span class="istickedoff">-- 2 arguments.</span>
-<span class="lineno">  197 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  198 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Int_Int_Int fn) _ (VInt i2:VInt i1:stk)</span>
-<span class="lineno">  199 </span><span class="spaces">  </span><span class="istickedoff">= return ((VInt (fn i1 i2)) : stk)</span>
-<span class="lineno">  200 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Int_Int_Bool fn) _ (VInt i2:VInt i1:stk)</span>
-<span class="lineno">  201 </span><span class="spaces">  </span><span class="istickedoff">= return ((VBool (fn i1 i2)) : stk)</span>
-<span class="lineno">  202 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Real_Real fn) _ (VReal r2:VReal r1:stk)</span>
-<span class="lineno">  203 </span><span class="spaces">  </span><span class="istickedoff">= return ((VReal (fn r1 r2)) : stk)</span>
-<span class="lineno">  204 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Real_Bool fn) _ (VReal r2:VReal r1:stk)</span>
-<span class="lineno">  205 </span><span class="spaces">  </span><span class="istickedoff">= return ((VBool (fn r1 r2)) : stk)</span>
-<span class="lineno">  206 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Arr_Int_Value fn) _ (VInt i:VArray arr:stk)</span>
-<span class="lineno">  207 </span><span class="spaces">  </span><span class="istickedoff">= return ((fn arr i) : stk)</span>
-<span class="lineno">  208 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  209 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  210 </span><span class="spaces">    </span><span class="istickedoff">-- Many arguments, typically image mangling</span>
-<span class="lineno">  211 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  212 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Obj_Obj_Obj fn) _ (VObject o2:VObject o1:stk)</span>
-<span class="lineno">  213 </span><span class="spaces">  </span><span class="istickedoff">= return ((VObject (fn o1 o2)) : <span class="nottickedoff">stk</span>)</span>
-<span class="lineno">  214 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Point_Color_Light fn) _ (VPoint r g b:VPoint x y z : stk)</span>
-<span class="lineno">  215 </span><span class="spaces">  </span><span class="istickedoff">= return (VLight (fn (x,y,z) (color r g b)) : <span class="nottickedoff">stk</span>)</span>
-<span class="lineno">  216 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Point_Point_Color_Real_Real_Light fn) _ </span>
-<span class="lineno">  217 </span><span class="spaces">         </span><span class="istickedoff">(VReal r2:VReal r1:VPoint r g b:VPoint x2 y2 z2:VPoint x1 y1 z1 : stk)</span>
-<span class="lineno">  218 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">return (VLight (fn (x1,y1,z1) (x2,y2,z2) (color r g b) r1 r2) : stk)</span></span>
-<span class="lineno">  219 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Real_Real_Real_Point fn) _ (VReal r3:VReal r2:VReal r1:stk)</span>
-<span class="lineno">  220 </span><span class="spaces">  </span><span class="istickedoff">= return ((fn r1 r2 r3) : stk)</span>
-<span class="lineno">  221 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Obj_Real_Obj fn) _ (VReal r:VObject o:stk)</span>
-<span class="lineno">  222 </span><span class="spaces">  </span><span class="istickedoff">= return (VObject (fn o r) : <span class="nottickedoff">stk</span>)</span>
-<span class="lineno">  223 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Obj_Real_Real_Real_Obj fn) _ (VReal r3:VReal r2:VReal r1:VObject o:stk)</span>
-<span class="lineno">  224 </span><span class="spaces">  </span><span class="istickedoff">= return (VObject (fn o r1 r2 r3) : stk)</span>
-<span class="lineno">  225 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  226 </span><span class="spaces"></span><span class="istickedoff">-- This one is our testing harness</span>
-<span class="lineno">  227 </span><span class="spaces"></span><span class="istickedoff">doPrimOp (Value_String_Value fn) _ (VString s:o:stk)</span>
-<span class="lineno">  228 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">res `seq` return (res : stk)</span></span>
-<span class="lineno">  229 </span><span class="spaces">  </span><span class="istickedoff">where</span>
-<span class="lineno">  230 </span><span class="spaces">     </span><span class="istickedoff"><span class="nottickedoff">res = fn o s</span></span>
-<span class="lineno">  231 </span><span class="spaces"></span><span class="istickedoff"></span>
-<span class="lineno">  232 </span><span class="spaces"></span><span class="istickedoff">doPrimOp primOp op args </span>
-<span class="lineno">  233 </span><span class="spaces">  </span><span class="istickedoff">= <span class="nottickedoff">err (&quot;\n\ntype error when attempting to execute builtin primitive \&quot;&quot; ++</span></span>
-<span class="lineno">  234 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">show op ++ &quot;\&quot;\n\n| &quot; ++</span></span>
-<span class="lineno">  235 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">show op ++ &quot; takes &quot; ++ show (length types) ++ &quot; argument&quot; ++ s</span></span>
-<span class="lineno">  236 </span><span class="spaces">                   </span><span class="istickedoff"><span class="nottickedoff">++ &quot; with&quot; ++ the ++ &quot; type&quot; ++ s ++ &quot;\n|\n|&quot; ++</span></span>
-<span class="lineno">  237 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">&quot;      &quot; ++ unwords [ show ty | ty &lt;- types ]  ++ &quot;\n|\n|&quot; ++ </span></span>
-<span class="lineno">  238 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">&quot; currently, the relevent argument&quot; ++ s ++ &quot; on the stack &quot; ++ </span></span>
-<span class="lineno">  239 </span><span class="spaces">                  </span><span class="istickedoff"><span class="nottickedoff">are ++ &quot;\n|\n| &quot; ++ </span></span>
-<span class="lineno">  240 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">unwords [ &quot;(&quot; ++ show arg ++ &quot;)&quot; </span></span>
-<span class="lineno">  241 </span><span class="spaces">                  </span><span class="istickedoff"><span class="nottickedoff">| arg &lt;-  reverse (take (length types) args) ]  ++ &quot;\n|\n| &quot;</span></span>
-<span class="lineno">  242 </span><span class="spaces">          </span><span class="istickedoff"><span class="nottickedoff">++ &quot;    (top of stack is on the right hand side)\n\n&quot;)</span></span>
-<span class="lineno">  243 </span><span class="spaces">  </span><span class="istickedoff">where</span>
-<span class="lineno">  244 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">len   = length types</span></span>
-<span class="lineno">  245 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">s =  (if len /= 1 then &quot;s&quot; else &quot;&quot;)</span></span>
-<span class="lineno">  246 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">are =  (if len /= 1 then &quot;are&quot; else &quot;is&quot;)</span></span>
-<span class="lineno">  247 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">the =  (if len /= 1 then &quot;&quot; else &quot; the&quot;)</span></span>
-<span class="lineno">  248 </span><span class="spaces">      </span><span class="istickedoff"><span class="nottickedoff">types = getPrimOpType primOp</span></span></span>
-<span class="lineno">  249 </span>
+<span class="lineno">  156 </span>
+<span class="lineno">  157 </span>--------------------------------
+<span class="lineno">  158 </span>-- Sphere
+<span class="lineno">  159 </span>--------------------------------
+<span class="lineno">  160 </span>
+<span class="lineno">  161 </span>intersectSphere :: Ray -&gt; a -&gt; IList (Surface, Texture a)
+<span class="lineno">  162 </span><span class="decl"><span class="nottickedoff">intersectSphere ray@(r, v) texture</span>
+<span class="lineno">  163 </span><span class="spaces">  </span><span class="nottickedoff">= -- Find t such that (x + ta, y + tb, z + tc) intersects the</span>
+<span class="lineno">  164 </span><span class="spaces">    </span><span class="nottickedoff">-- unit sphere, that is, such that:</span>
+<span class="lineno">  165 </span><span class="spaces">    </span><span class="nottickedoff">--   (x + ta)^2 + (y + tb)^2 + (z + tc)^2 = 1</span>
+<span class="lineno">  166 </span><span class="spaces">    </span><span class="nottickedoff">-- This is a quadratic equation in t:</span>
+<span class="lineno">  167 </span><span class="spaces">    </span><span class="nottickedoff">--   t^2(a^2 + b^2 + c^2) + 2t(xa + yb + zc) + (x^2 + y^2 + z^2 - 1) = 0</span>
+<span class="lineno">  168 </span><span class="spaces">    </span><span class="nottickedoff">let c1 = sq a + sq b + sq c</span>
+<span class="lineno">  169 </span><span class="spaces">        </span><span class="nottickedoff">c2 = 2 * (x * a + y * b + z * c)</span>
+<span class="lineno">  170 </span><span class="spaces">        </span><span class="nottickedoff">c3 = sq x + sq y + sq z - 1</span>
+<span class="lineno">  171 </span><span class="spaces">    </span><span class="nottickedoff">in</span>
+<span class="lineno">  172 </span><span class="spaces">