Switch to mutable rays (#13)

RayTracing.Test/TestSphere.fs

@@ -45,6 +45,12 @@ module TestSphere =
 
         let strikePoint = Point.make 0.0 0.0 1.0
 
+        let mutable incoming =
+            {
+                LightRay.Ray = ray
+                Colour = Colour.White
+            }
+
         let destination =
             Sphere.reflection
                 (SphereStyle.Glass (1.0<albedo>, Texture.Colour Colour.Green, 1.5<ior>, rand))
@@ -52,20 +58,17 @@ module TestSphere =
                 1.0
                 1.0
                 false
-                {
+                &incoming
-                    LightRay.Ray = ray
-                    Colour = Colour.White
-                }
                 strikePoint
 
         match destination with
-        | Continues onward ->
+        | ValueNone ->
-            onward.Colour |> shouldEqual Colour.Green
+            incoming.Colour |> shouldEqual Colour.Green
-            Point.equal (Ray.origin onward.Ray) strikePoint |> shouldEqual true
+            Point.equal (Ray.origin incoming.Ray) strikePoint |> shouldEqual true
 
-            Vector.equal (Ray.vector onward.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0)
+            Vector.equal (Ray.vector incoming.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0)
             |> shouldEqual true
-        | Absorbs colour -> failwithf "Absorbed: %+A" colour
+        | ValueSome colour -> failwithf "Absorbed: %+A" colour
 
     [<Test>]
     let ``Glass sphere perfectly refracts through the middle`` () =
@@ -76,6 +79,12 @@ module TestSphere =
 
         let strikePoint = Point.make 0.0 0.0 1.0
 
+        let mutable incoming =
+            {
+                LightRay.Ray = ray
+                Colour = Colour.White
+            }
+
         let destination =
             Sphere.reflection
                 (SphereStyle.Glass (1.0<albedo>, Texture.Colour Colour.Green, 1.5<ior>, rand))
@@ -83,20 +92,17 @@ module TestSphere =
                 1.0
                 1.0
                 false
-                {
+                &incoming
-                    LightRay.Ray = ray
-                    Colour = Colour.White
-                }
                 strikePoint
 
         match destination with
-        | Continues onward ->
+        | ValueNone ->
-            onward.Colour |> shouldEqual Colour.Green
+            incoming.Colour |> shouldEqual Colour.Green
-            Point.equal (Ray.origin onward.Ray) strikePoint |> shouldEqual true
+            Point.equal (Ray.origin incoming.Ray) strikePoint |> shouldEqual true
 
-            Vector.equal (Ray.vector onward.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0)
+            Vector.equal (Ray.vector incoming.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0)
             |> shouldEqual true
-        | Absorbs colour -> failwithf "Absorbed: %+A" colour
+        | ValueSome colour -> failwithf "Absorbed: %+A" colour
 
     [<Test>]
     let ``Dielectric sphere refracts when incoming ray `` () =
@@ -107,6 +113,12 @@ module TestSphere =
 
         let strikePoint = Point.make 0.0 0.0 1.0
 
+        let mutable incoming =
+            {
+                LightRay.Ray = ray
+                Colour = Colour.White
+            }
+
         let destination =
             Sphere.reflection
                 (SphereStyle.Dielectric (1.0<albedo>, Texture.Colour Colour.Green, 1.5<ior>, 1.0<prob>, rand))
@@ -114,20 +126,17 @@ module TestSphere =
                 1.0
                 1.0
                 false
-                {
+                &incoming
-                    LightRay.Ray = ray
-                    Colour = Colour.White
-                }
                 strikePoint
 
         match destination with
-        | Continues onward ->
+        | ValueNone ->
-            onward.Colour |> shouldEqual Colour.Green
+            incoming.Colour |> shouldEqual Colour.Green
-            Point.equal (Ray.origin onward.Ray) strikePoint |> shouldEqual true
+            Point.equal (Ray.origin incoming.Ray) strikePoint |> shouldEqual true
 
-            Vector.equal (Ray.vector onward.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0)
+            Vector.equal (Ray.vector incoming.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0)
             |> shouldEqual true
-        | Absorbs colour -> failwithf "Absorbed: %+A" colour
+        | ValueSome colour -> failwithf "Absorbed: %+A" colour
 
     [<Test>]
     let ``Test planeMap`` () =

RayTracing/Hittable.fs

@@ -5,11 +5,11 @@ type Hittable =
     | UnboundedSphere of Sphere
     | InfinitePlane of InfinitePlane
 
-    member this.Reflection (incoming : LightRay) (strikePoint : Point) =
+    member this.Reflection (incoming : byref<LightRay>, strikePoint : Point) =
         match this with
         | Sphere s
-        | UnboundedSphere s -> s.Reflection incoming strikePoint
+        | UnboundedSphere s -> s.Reflection (&incoming, strikePoint)
-        | InfinitePlane p -> p.Reflection incoming strikePoint
+        | InfinitePlane p -> p.Reflection (&incoming, strikePoint)
 
     member this.BoundingBox : BoundingBox voption =
         match this with

RayTracing/InfinitePlane.fs

@@ -12,39 +12,11 @@ type InfinitePlaneStyle =
     | LambertReflection of albedo : float<albedo> * colour : Pixel * FloatProducer
     | FuzzedReflection of albedo : float<albedo> * colour : Pixel * fuzz : float<fuzz> * FloatProducer
 
-type InfinitePlane =
-    {
-        Normal : UnitVector
-        Point : Point
-        /// If an incoming ray hits the given point (which is guaranteed to be on the surface),
-        /// what colour ray does it output and in what direction?
-        Reflection : LightRay -> Point -> LightDestination
-    }
-
 [<RequireQualifiedAccess>]
 module InfinitePlane =
 
-    /// Returns the position along this ray where we intersect this plane, or None if none exists or the ray is in the plane.
-    /// Does not return any intersections which are behind us.
-    /// If the plane is made of a material which does not re-emit light, you'll
-    /// get a None for the outgoing ray.
-    let intersection (plane : InfinitePlane) (ray : Ray) : float voption =
-        let rayVec = Ray.vector ray
-        let denominator = UnitVector.dot plane.Normal rayVec
-
-        if Float.equal denominator 0.0 then
-            ValueNone
-        else
-            let t =
-                (UnitVector.dot' plane.Normal (Point.differenceToThenFrom plane.Point (Ray.origin ray)))
-                / denominator
-
-            if Float.positive t then ValueSome t else ValueNone
-
     let pureOutgoing (strikePoint : Point) (normal : UnitVector) (incomingRay : Ray) : Ray =
-        let plane =
+        let plane = Plane.makeOrthonormalSpannedBy (Ray.make strikePoint normal) incomingRay
-            Plane.makeSpannedBy (Ray.make strikePoint normal) incomingRay
-            |> Plane.orthonormalise
 
         match plane with
         | ValueNone ->
@@ -72,15 +44,16 @@ module InfinitePlane =
         (style : InfinitePlaneStyle)
         (pointOnPlane : Point)
         (normal : UnitVector)
-        : LightRay -> Point -> LightDestination
+        (incomingRay : byref<LightRay>)
+        (strikePoint : Point)
+        : Pixel ValueOption
         =
-        fun incomingRay strikePoint ->
         match style with
         | InfinitePlaneStyle.LightSource texture ->
             texture
             |> Texture.colourAt strikePoint
             |> Pixel.combine incomingRay.Colour
-                |> Absorbs
+            |> ValueSome
 
         | InfinitePlaneStyle.FuzzedReflection (albedo, colour, fuzz, rand) ->
             let newColour = newColour incomingRay.Colour albedo colour
@@ -97,11 +70,10 @@ module InfinitePlane =
                 | ValueNone -> ()
                 | ValueSome output -> outgoing <- output
 
-                Continues
+            incomingRay.Colour <- newColour
-                    {
+            incomingRay.Ray <- outgoing
-                        Ray = outgoing
+
-                        Colour = newColour
+            ValueNone
-                    }
 
         | InfinitePlaneStyle.LambertReflection (albedo, colour, rand) ->
             let outgoing =
@@ -115,22 +87,50 @@ module InfinitePlane =
 
             let newColour = Pixel.combine incomingRay.Colour colour |> Pixel.darken albedo
 
-                Continues
+            incomingRay.Colour <- newColour
-                    {
+            incomingRay.Ray <- outgoing
-                        Ray = outgoing
+
-                        Colour = newColour
+            ValueNone
-                    }
 
         | InfinitePlaneStyle.PureReflection (albedo, colour) ->
-                {
+            incomingRay.Colour <- newColour incomingRay.Colour albedo colour
-                    Ray = pureOutgoing strikePoint normal incomingRay.Ray
+            incomingRay.Ray <- pureOutgoing strikePoint normal incomingRay.Ray
-                    Colour = newColour incomingRay.Colour albedo colour
-                }
-                |> Continues
 
-    let make (style : InfinitePlaneStyle) (pointOnPlane : Point) (normal : UnitVector) : InfinitePlane =
+            ValueNone
+
+type InfinitePlane =
+    {
+        Style : InfinitePlaneStyle
+        Normal : UnitVector
+        Point : Point
+    }
+
+    /// If an incoming ray hits the given point (which is guaranteed to be on the surface),
+    /// is it absorbed (if so, returns Some(the colour of light)), or does it bounce off
+    /// (if so, returns None and mutates the input ray to the new reflected ray)?
+    member this.Reflection (ray : byref<LightRay>, strikePoint : Point) : Pixel ValueOption =
+        InfinitePlane.reflection this.Style this.Point this.Normal &ray strikePoint
+
+    static member make (style : InfinitePlaneStyle) (pointOnPlane : Point) (normal : UnitVector) : InfinitePlane =
         {
             Point = pointOnPlane
+            Style = style
             Normal = normal
-            Reflection = reflection style pointOnPlane normal
         }
+
+    /// Returns the position along this ray where we intersect this plane, or None if none exists or the ray is in the plane.
+    /// Does not return any intersections which are behind us.
+    /// If the plane is made of a material which does not re-emit light, you'll
+    /// get a None for the outgoing ray.
+    static member intersection (plane : InfinitePlane) (ray : Ray) : float voption =
+        let rayVec = Ray.vector ray
+        let denominator = UnitVector.dot plane.Normal rayVec
+
+        if Float.equal denominator 0.0 then
+            ValueNone
+        else
+            let t =
+                (UnitVector.dot' plane.Normal (Point.differenceToThenFrom plane.Point (Ray.origin ray)))
+                / denominator
+
+            if Float.positive t then ValueSome t else ValueNone

RayTracing/LightRay.fs

@@ -6,14 +6,14 @@ type ior
 
 type LightRay =
     {
-        Ray : Ray
-        Colour : Pixel
         // We have chosen not to include refractance here, because that would mean
         // we had to model the material at every point in space rather than just the
         // ratio of refractance at the boundaries of objects. (For example, if we
         // modelled a light ray leaving a glass sphere, we would have to know what
         // material we were leaving *into*, which we can't easily know given the
         // current structure of things.)
+        mutable Ray : Ray
+        mutable Colour : Pixel
     }
 
 type LightDestination =

RayTracing/Plane.fs

@@ -61,6 +61,23 @@ module Plane =
             Point = Ray.origin r1
         }
 
+    let makeOrthonormalSpannedBy (r1 : Ray) (r2 : Ray) : OrthonormalPlane ValueOption =
+        let coefficient = UnitVector.dot r1.Vector r2.Vector
+
+        let vec2 =
+            UnitVector.difference' r2.Vector (UnitVector.scale coefficient r1.Vector)
+            |> Vector.unitise
+
+        match vec2 with
+        | ValueNone -> ValueNone
+        | ValueSome v2 ->
+            {
+                V1 = r1.Vector
+                V2 = v2
+                Point = Ray.origin r1
+            }
+            |> ValueSome
+
     /// Construct a basis for this plane, whose second ("up") component is `viewUp` when projected onto the plane.
     let basis (viewUp : Vector) (plane : OrthonormalPlane) : Ray * Ray =
         let viewUp = Vector.unitise viewUp |> ValueOption.get

RayTracing/Ray.fs

@@ -2,12 +2,27 @@ namespace RayTracing
 
 type Ray =
     {
-        Origin : Point
+        mutable Origin : Point
-        Vector : UnitVector
+        mutable Vector : UnitVector
     }
 
 [<RequireQualifiedAccess>]
 module Ray =
+    let overwriteWithMake (origin : Point) (vector : Vector) (ray : byref<Ray>) : bool =
+        let dot = Vector.dot vector vector
+
+        if Float.equal dot 0.0 then
+            false
+        else
+
+        ray.Origin <- origin
+
+        ray.Vector <-
+            let factor = 1.0 / sqrt dot
+            Vector.scale factor vector |> UnitVector
+
+        true
+
     let make' (origin : Point) (vector : Vector) : Ray voption =
         match Vector.unitise vector with
         | ValueNone -> ValueNone
@@ -24,18 +39,20 @@ module Ray =
             Vector = vector
         }
 
-    let walkAlong (ray : Ray) (magnitude : float) : Point =
+    let walkAlongRay (Point (oX, oY, oZ)) (UnitVector (Vector (vX, vY, vZ))) (magnitude : float) : Point =
-        let (Point (oX, oY, oZ)) = ray.Origin
-        let (UnitVector (Vector (vX, vY, vZ))) = ray.Vector
-
         Point.make (oX + (vX * magnitude)) (oY + (vY * magnitude)) (oZ + (vZ * magnitude))
 
+    let walkAlong (ray : Ray) (magnitude : float) : Point =
+        walkAlongRay ray.Origin ray.Vector magnitude
+
     let parallelTo (p1 : Point) (ray : Ray) : Ray =
         {
             Vector = ray.Vector
             Origin = p1
         }
 
+    let translateToIntersect (p1 : Point) (ray : Ray) : unit = ray.Origin <- p1
+
     let liesOn (point : Point) (ray : Ray) : bool =
         match point, ray.Origin, ray.Vector with
         | Point (p1, p2, p3), Point (o1, o2, o3), UnitVector (Vector (r1, r2, r3)) ->
@@ -58,3 +75,7 @@ module Ray =
                 let (UnitVector v) = r.Vector
                 Vector.scale -1.0 v |> UnitVector
         }
+
+    let flipInPlace (r : Ray) : unit =
+        let (UnitVector v) = r.Vector
+        r.Vector <- Vector.scale -1.0 v |> UnitVector

RayTracing/Ray.fsi

@@ -3,9 +3,9 @@ namespace RayTracing
 type Ray =
     {
         /// For performance reasons, this is public, but please don't use it
-        Origin : Point
+        mutable Origin : Point
         /// For performance reasons, this is public, but please don't use it
-        Vector : UnitVector
+        mutable Vector : UnitVector
     }
 
 [<RequireQualifiedAccess>]
@@ -13,9 +13,16 @@ module Ray =
     val make' : Point -> Vector -> Ray voption
     val make : Point -> UnitVector -> Ray
 
+    /// If we can make a ray from Point and Vector, overwrite the input and return true.
+    /// Otherwise do nothing and return false.
+    val overwriteWithMake : Point -> Vector -> byref<Ray> -> bool
+
     val walkAlong : Ray -> float -> Point
 
+    val walkAlongRay : Point -> UnitVector -> float -> Point
+
     val parallelTo : Point -> Ray -> Ray
+    val translateToIntersect : Point -> Ray -> unit
 
     val liesOn : Point -> Ray -> bool
 
@@ -23,3 +30,4 @@ module Ray =
     val inline origin : Ray -> Point
 
     val flip : Ray -> Ray
+    val flipInPlace : Ray -> unit

RayTracing/Scene.fs

@@ -59,7 +59,7 @@ module Scene =
             else
                 struct (bestFloat, bestObject, bestLength)
 
-    let hitObject (s : Scene) (ray : Ray) : (Hittable * Point) voption =
+    let hitObject (s : Scene) (ray : Ray) : struct (Hittable * Point) voption =
         let mutable best = Unchecked.defaultof<_>
         let mutable bestLength = nan
         let mutable bestFloat = infinity
@@ -88,31 +88,30 @@ module Scene =
         if Double.IsNaN bestLength then
             ValueNone
         else
-            ValueSome (best, Ray.walkAlong ray bestLength)
+            ValueSome (struct (best, Ray.walkAlong ray bestLength))
 
-    let internal traceRay (maxCount : int) (scene : Scene) (ray : LightRay) : Pixel =
+    let internal traceRay (maxCount : int) (scene : Scene) (ray : byref<LightRay>) : Pixel =
-        let rec go (bounces : int) (ray : LightRay) : Pixel =
+        let mutable bounces = 0
-            if bounces > maxCount then
+        let mutable result = Colour.Black
-                if ray.Colour = Colour.Black then
+        let mutable isDone = false
-                    Colour.Black
-                else
-                    Colour.HotPink
-            else
 
+        while bounces <= maxCount && not isDone do
             let thingsWeHit = hitObject scene ray.Ray
 
             match thingsWeHit with
             | ValueNone ->
                 // Ray goes off into the distance and is never heard from again
-                Colour.Black
+                isDone <- true
             | ValueSome (object, strikePoint) ->
-                let outgoingRay = object.Reflection ray strikePoint
+                let stopWithColour = object.Reflection (&ray, strikePoint)
 
-                match outgoingRay with
+                match stopWithColour with
-                | Absorbs colour -> colour
+                | ValueSome colour ->
-                | Continues outgoingRay -> go (bounces + 1) outgoingRay
+                    isDone <- true
+                    result <- colour
+                | ValueNone -> bounces <- bounces + 1
 
-        go 0 ray
+        if not isDone then Colour.HotPink else result
 
     /// Trace a ray to this one pixel, updating the PixelStats with the result.
     /// n.b. not thread safe
@@ -122,36 +121,37 @@ module Scene =
         (camera : Camera)
         (maxWidthCoord : int)
         (maxHeightCoord : int)
-        row
+        (row : int)
-        col
+        (col : int)
-        stats
+        (stats : PixelStats)
+        : unit
         =
         let struct (rand1, rand2) = rand.GetTwo ()
 
         let landingPoint =
             ((float col + rand1) * camera.ViewportWidth) / float maxWidthCoord
 
-        let pointOnXAxis = landingPoint |> Ray.walkAlong camera.ViewportXAxis
+        let pointOnXAxis = Ray.walkAlong camera.ViewportXAxis landingPoint
-        let toWalkUp = Ray.parallelTo pointOnXAxis camera.ViewportYAxis
+
+        let walkDistance =
+            ((float row + rand2) * camera.ViewportHeight) / float maxHeightCoord
 
         let endPoint =
-            ((float row + rand2) * camera.ViewportHeight) / float maxHeightCoord
+            Ray.walkAlongRay pointOnXAxis camera.ViewportYAxis.Vector walkDistance
-            |> Ray.walkAlong toWalkUp
 
         let ray =
             Ray.make' (Ray.origin camera.View) (Point.differenceToThenFrom endPoint (Ray.origin camera.View))
             |> ValueOption.get
 
-        // Here we've hardcoded that the eye is emitting white light through a medium with refractance 1.
+        let mutable initialRay =
-        let result =
-            traceRay
-                camera.BounceDepth
-                scene
             {
                 Ray = ray
                 Colour = Colour.White
             }
 
+        // Here we've hardcoded that the eye is emitting white light through a medium with refractance 1.
+        let result = traceRay camera.BounceDepth scene &initialRay
+
         PixelStats.add result stats
 
     let renderPixel
@@ -171,12 +171,12 @@ module Scene =
 
         let firstTrial = min 5 (camera.SamplesPerPixel / 2)
 
-        for _ in 0..firstTrial do
+        for _ = 0 to firstTrial do
             traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats
 
         let oldMean = PixelStats.mean stats
 
-        for _ in 1..firstTrial do
+        for _ = 1 to firstTrial do
             traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats
 
         let newMean = PixelStats.mean stats
@@ -188,7 +188,7 @@ module Scene =
             newMean
         else
 
-            for _ in 1 .. (camera.SamplesPerPixel - 2 * firstTrial - 1) do
+            for _ = 1 to (camera.SamplesPerPixel - 2 * firstTrial - 1) do
                 traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats
 
             PixelStats.mean stats

RayTracing/Sphere.fs

@@ -7,19 +7,6 @@ type fuzz
 [<Measure>]
 type prob
 
-type Sphere =
-    private
-        {
-            Centre : Point
-            Radius : float
-            /// If an incoming ray has the given colour, and hits the
-            /// given point (which is guaranteed to be on the surface),
-            /// what colour ray does it output and in what direction?
-            Reflection : LightRay -> Point -> LightDestination
-            RadiusSquared : float
-            BoundingBox : BoundingBox
-        }
-
 type SphereStyle =
     /// An emitter of light.
     | LightSource of Texture
@@ -78,51 +65,14 @@ module Sphere =
     let normal (centre : Point) (p : Point) : Ray =
         Ray.make' p (Point.differenceToThenFrom p centre) |> ValueOption.get
 
-    let private liesOn' (centre : Point) (radius : float) (p : Point) : bool =
+    let private reflectWithoutFuzz normal (strikePoint : Point) (incomingLight : byref<LightRay>) : unit =
-        let rSquared = radius * radius
+        let plane = Plane.makeOrthonormalSpannedBy normal incomingLight.Ray
-        Float.equal (Vector.normSquared (Point.differenceToThenFrom p centre)) rSquared
 
-    let reflection
-        (style : SphereStyle)
-        (centre : Point)
-        (radius : float)
-        (radiusSquared : float)
-        (flipped : bool)
-        (incomingLight : LightRay)
-        (strikePoint : Point)
-        : LightDestination
-        =
-        let normal = normal centre strikePoint
-
-        // If the incoming ray is on the sphere, then we have to be an internal ray, so the normal is flipped.
-        // But to model a glass shell (not a sphere), we allow negative radius, which contributes a flipping term.
-        let inside, normal =
-            match
-                Float.compare
-                    (Vector.normSquared (Point.differenceToThenFrom centre (Ray.origin incomingLight.Ray)))
-                    radiusSquared
-            with
-            | Equal
-            | Less ->
-                // Point is inside or on the sphere so we are coming from within
-                if flipped then
-                    false, normal
-                else
-                    true, Ray.make (Ray.origin normal) (UnitVector.flip (Ray.vector normal))
-            | Greater ->
-                if flipped then
-                    true, Ray.make (Ray.origin normal) (UnitVector.flip (Ray.vector normal))
-                else
-                    false, normal
-
-        let fuzzedReflection (fuzz : (float<fuzz> * FloatProducer) option) =
-            let plane = Plane.makeSpannedBy normal incomingLight.Ray |> Plane.orthonormalise
-
-            let outgoing =
         match plane with
         | ValueNone ->
             // Incoming ray is directly along the normal
-                    Ray.flip incomingLight.Ray |> Ray.parallelTo strikePoint
+            Ray.flipInPlace incomingLight.Ray
+            Ray.translateToIntersect strikePoint incomingLight.Ray
         | ValueSome plane ->
             // Incoming ray is (plane1.ray) plane1 + (plane2.ray) plane2
             // We want the reflection in the normal, so need (plane1.ray) plane1 - (plane2.ray) plane2
@@ -130,42 +80,48 @@ module Sphere =
             let tangentComponent = (UnitVector.dot plane.V2 (Ray.vector incomingLight.Ray))
 
             let dest =
-                        Ray.walkAlong
+                Ray.walkAlongRay (Ray.walkAlongRay plane.Point plane.V1 normalComponent) plane.V2 tangentComponent
-                            (Ray.make (Ray.walkAlong (Ray.make plane.Point plane.V1) normalComponent) plane.V2)
-                            tangentComponent
 
-                    Point.differenceToThenFrom dest strikePoint
+            Ray.overwriteWithMake strikePoint (Point.differenceToThenFrom dest strikePoint) &incomingLight.Ray
-                    |> Ray.make' strikePoint
             // This is safe: it's actually a logic error for this to fail.
-                    |> ValueOption.get
+            |> ignore
 
-            match fuzz with
+    let private addFuzz
-            | None -> outgoing
+        (fuzz : float<fuzz>)
-            | Some (fuzz, rand) ->
+        (rand : FloatProducer)
-                let mutable answer = Unchecked.defaultof<_>
+        (strikePoint : Point)
+        (reflected : byref<LightRay>)
+        : unit
+        =
+        let mutable isDone = false
 
-                while obj.ReferenceEquals (answer, null) do
+        while not isDone do
-                    let offset = UnitVector.random rand (Point.dimension centre)
+            let offset = UnitVector.random rand (Point.dimension strikePoint)
-                    let sphereCentre = Ray.walkAlong outgoing 1.0
+            let sphereCentre = Ray.walkAlong reflected.Ray 1.0
-                    let target = Ray.walkAlong (Ray.make sphereCentre offset) (fuzz / 1.0<fuzz>)
+            let target = Ray.walkAlongRay sphereCentre offset (fuzz / 1.0<fuzz>)
 
-                    let exitPoint =
+            let newDirection = Point.differenceToThenFrom target strikePoint
-                        Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
+            isDone <- Ray.overwriteWithMake strikePoint newDirection &reflected.Ray
 
-                    match exitPoint with
+    /// If there were no refraction at all, the reflected ray would bounce off as `reflectionWithoutFuzz`.
-                    | ValueNone -> ()
+    /// This function adds a refraction term.
-                    | ValueSome o -> answer <- o
+    let private refract
-
+        (inside : bool)
-                answer
+        (normal : Ray)
-
+        (strikePoint : Point)
-        let refract (incomingCos : float) (index : float<ior>) =
+        (incomingCos : float)
+        (index : float<ior>)
+        (incomingLight : byref<LightRay>)
+        : unit
+        =
         let index = if inside then 1.0<ior> / index else index / 1.0<ior>
-            let plane = Plane.makeSpannedBy normal incomingLight.Ray |> Plane.orthonormalise
+        let plane = Plane.makeOrthonormalSpannedBy normal incomingLight.Ray
 
         match plane with
         | ValueNone ->
             // Incoming ray was parallel to normal; pass straight through
-                Ray.make strikePoint (Ray.vector incomingLight.Ray)
+            let (UnitVector vec) = Ray.vector incomingLight.Ray
+            Ray.overwriteWithMake strikePoint vec &incomingLight.Ray |> ignore
         | ValueSome plane ->
 
         let incomingSin = sqrt (1.0 - incomingCos * incomingCos)
@@ -173,7 +129,7 @@ module Sphere =
 
         if Float.compare outgoingSin 1.0 = Greater then
             // override our decision to refract - from this angle, there's no way we could have refracted
-                fuzzedReflection None
+            reflectWithoutFuzz normal strikePoint &incomingLight
 
         else
 
@@ -182,18 +138,55 @@ module Sphere =
         let outgoingPoint =
             Ray.walkAlong (Ray.make (Ray.walkAlong normal (-outgoingCos)) plane.V2) outgoingSin
 
-            Point.differenceToThenFrom outgoingPoint strikePoint
+        let outgoingLine = Point.differenceToThenFrom outgoingPoint strikePoint
-            |> Ray.make' strikePoint
+
+        Ray.overwriteWithMake strikePoint outgoingLine &incomingLight.Ray
         // This is safe: it's a logic error for this to fail. It would imply both the
         // cos and the sin outgoing components were 0.
-            |> ValueOption.get
+        |> ignore
+
+    /// If the light ray is absorbed, this returns Some(the colour of light).
+    /// Otherwise, returns None and mutates `incomingLight`.
+    let reflection
+        (style : SphereStyle)
+        (centre : Point)
+        (radius : float)
+        (radiusSquared : float)
+        (flipped : bool)
+        (incomingLight : byref<LightRay>)
+        (strikePoint : Point)
+        : Pixel ValueOption
+        =
+        // If the incoming ray is on the sphere, then we have to be an internal ray, so the normal is flipped.
+        // But to model a glass shell (not a sphere), we allow negative radius, which contributes a flipping term.
+        let mutable inside = false
+        let mutable normal = normal centre strikePoint
+
+        match
+            Float.compare
+                (Vector.normSquared (Point.differenceToThenFrom centre (Ray.origin incomingLight.Ray)))
+                radiusSquared
+        with
+        | Equal
+        | Less ->
+            // Point is inside or on the sphere so we are coming from within
+            if not flipped then
+                inside <- true
+                Ray.flipInPlace normal
+        | Greater ->
+            if flipped then
+                inside <- true
+                Ray.flipInPlace normal
+
+        let inside = inside
+        let normal = normal
 
         match style with
         | SphereStyle.LightSource texture ->
             texture
             |> Texture.colourAt strikePoint
             |> Pixel.combine incomingLight.Colour
-            |> Absorbs
+            |> ValueSome
         | SphereStyle.LightSourceCap colour ->
             let circleCentreZCoord = Point.coordinate 0 centre
             let zCoordLowerBound = circleCentreZCoord + (radius - (radius / 4.0))
@@ -204,37 +197,29 @@ module Sphere =
                 | Greater -> Pixel.combine colour incomingLight.Colour
                 | _ -> Colour.Black
 
-            Absorbs colour
+            ValueSome colour
 
         | SphereStyle.LambertReflection (albedo, texture, rand) ->
-            let outgoing =
-                let sphereCentre = Ray.walkAlong normal 1.0
-                let mutable answer = Unchecked.defaultof<_>
-
-                while obj.ReferenceEquals (answer, null) do
-                    let offset = UnitVector.random rand (Point.dimension sphereCentre)
-                    let target = Ray.walkAlong (Ray.make sphereCentre offset) 1.0
-
-                    let outputPoint =
-                        Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
-
-                    match outputPoint with
-                    | ValueSome o -> answer <- o
-                    | ValueNone -> ()
-
-                answer
-
             let newColour =
                 texture
                 |> Texture.colourAt strikePoint
                 |> Pixel.combine incomingLight.Colour
                 |> Pixel.darken albedo
 
-            Continues
+            incomingLight.Colour <- newColour
-                {
+
-                    Ray = outgoing
+            let sphereCentre = Ray.walkAlong normal 1.0
-                    Colour = newColour
+            let mutable isDone = false
-                }
+
+            while not isDone do
+                let offset = UnitVector.random rand (Point.dimension sphereCentre)
+                let target = Ray.walkAlongRay sphereCentre offset 1.0
+
+                let outputVec = Point.differenceToThenFrom target strikePoint
+
+                isDone <- Ray.overwriteWithMake strikePoint outputVec &incomingLight.Ray
+
+            ValueNone
 
         | SphereStyle.PureReflection (albedo, texture) ->
             let darkened =
@@ -243,11 +228,9 @@ module Sphere =
                 |> Pixel.combine incomingLight.Colour
                 |> Pixel.darken albedo
 
-            Continues
+            reflectWithoutFuzz normal strikePoint &incomingLight
-                {
+            incomingLight.Colour <- darkened
-                    Ray = fuzzedReflection None
+            ValueNone
-                    Colour = darkened
-                }
 
         | SphereStyle.FuzzedReflection (albedo, texture, fuzz, random) ->
             let darkened =
@@ -256,11 +239,11 @@ module Sphere =
                 |> Pixel.combine incomingLight.Colour
                 |> Pixel.darken albedo
 
-            Continues
+            incomingLight.Colour <- darkened
-                {
+
-                    Ray = fuzzedReflection (Some (fuzz, random))
+            reflectWithoutFuzz normal strikePoint &incomingLight
-                    Colour = darkened
+            addFuzz fuzz random strikePoint &incomingLight
-                }
+            ValueNone
 
         | SphereStyle.Dielectric (albedo, texture, sphereRefractance, refractionProb, random) ->
             let newColour =
@@ -273,19 +256,15 @@ module Sphere =
 
             if LanguagePrimitives.FloatWithMeasure rand > refractionProb then
                 // reflect!
-                Continues
+                incomingLight.Colour <- newColour
-                    {
+                reflectWithoutFuzz normal strikePoint &incomingLight
-                        Ray = fuzzedReflection None
+                ValueNone
-                        Colour = newColour
-                    }
             else
                 let incomingCos = UnitVector.dot (Ray.vector incomingLight.Ray) (Ray.vector normal)
 
-                Continues
+                refract inside normal strikePoint incomingCos sphereRefractance &incomingLight
-                    {
+                incomingLight.Colour <- newColour
-                        Ray = refract incomingCos sphereRefractance
+                ValueNone
-                        Colour = newColour
-                    }
 
         | SphereStyle.Glass (albedo, texture, sphereRefractance, random) ->
             let newColour =
@@ -312,25 +291,44 @@ module Sphere =
 
             if LanguagePrimitives.FloatWithMeasure rand < reflectionProb then
                 // reflect!
-                Continues
+                reflectWithoutFuzz normal strikePoint &incomingLight
-                    {
+                incomingLight.Colour <- newColour
-                        Ray = fuzzedReflection None
+                ValueNone
-                        Colour = newColour
-                    }
             else
-                Continues
+                refract inside normal strikePoint incomingCos sphereRefractance &incomingLight
+                incomingLight.Colour <- newColour
+                ValueNone
+
+type Sphere =
+    private
         {
-                        Ray = refract incomingCos sphereRefractance
+            Centre : Point
-                        Colour = newColour
+            Radius : float
+            RadiusSquared : float
+            BoundingBox : BoundingBox
+            Style : SphereStyle
         }
 
-    let make (style : SphereStyle) (centre : Point) (radius : float) : Sphere =
+    /// If an incoming ray has the given colour, and hits the
+    /// given point (which is guaranteed to be on the surface),
+    /// does it get absorbed? If not, mutates the input `ray` to hold the new light ray.
+    member this.Reflection (ray : byref<LightRay>, strikePoint : Point) : Pixel ValueOption =
+        Sphere.reflection
+            this.Style
+            this.Centre
+            this.Radius
+            this.RadiusSquared
+            (Float.compare this.Radius 0.0 = Less)
+            &ray
+            strikePoint
+
+    static member make (style : SphereStyle) (centre : Point) (radius : float) : Sphere =
         let radiusSquared = radius * radius
 
         {
+            Style = style
             Centre = centre
             Radius = radius
-            Reflection = reflection style centre radius radiusSquared (Float.compare radius 0.0 = Less)
             RadiusSquared = radiusSquared
             BoundingBox =
                 BoundingBox.make
@@ -338,16 +336,17 @@ module Sphere =
                     (Point.sum centre (Point.make radius radius radius))
         }
 
-    let boundingBox (s : Sphere) = s.BoundingBox
+    static member boundingBox (s : Sphere) = s.BoundingBox
 
-    let liesOn (point : Point) (sphere : Sphere) : bool =
+    static member liesOn (point : Point) (sphere : Sphere) : bool =
-        liesOn' sphere.Centre sphere.Radius point
+        let rSquared = sphere.RadiusSquared
+        Float.equal (Vector.normSquared (Point.differenceToThenFrom point sphere.Centre)) rSquared
 
     /// Returns the distance along this ray at which the nearest intersection of the ray lies with this sphere.
     /// Does not return any intersections which are behind us.
     /// If the sphere is made of a material which does not re-emit light, you'll
     /// get a None for the outgoing ray.
-    let firstIntersection (sphere : Sphere) (ray : Ray) : float voption =
+    static member firstIntersection (sphere : Sphere) (ray : Ray) : float voption =
         let difference = Point.differenceToThenFrom (Ray.origin ray) sphere.Centre
 
         let b = (UnitVector.dot' (Ray.vector ray) difference)