Should pull these apart and study them separately

RayTracing.App/Program.fs

@@ -15,7 +15,6 @@ module Program =
     let go (sample : SampleImages) (pngOutput : IFileInfo) (ctx : ProgressContext) =
         let renderTask = ctx.AddTask "[green]Generating image[/]"
         let writeUnorderedTask = ctx.AddTask "[green]Writing unordered pixels[/]"
-        let readTask = ctx.AddTask "[green]Reading in serialised pixels[/]"
         let writeTask = ctx.AddTask "[green]Writing PPM file[/]"
 
         let logFile =
@@ -35,7 +34,6 @@ module Program =
         let maxProgress, image = SampleImages.get sample renderTask.Increment write
         renderTask.MaxValue <- maxProgress / 1.0<progress>
         writeUnorderedTask.MaxValue <- maxProgress / 1.0<progress>
-        readTask.MaxValue <- maxProgress / 1.0<progress>
         writeTask.MaxValue <- maxProgress / 1.0<progress>
 
         let tempOutput, await =
@@ -46,8 +44,7 @@ module Program =
         async {
             do! Async.AwaitTask await
 
-            let! pixelMap =
+            let! pixelMap = ImageOutput.readPixelMap tempOutput (Image.rowCount image) (Image.colCount image)
-                ImageOutput.readPixelMap readTask.Increment tempOutput (Image.rowCount image) (Image.colCount image)
 
             let pixelMap = ImageOutput.assertComplete pixelMap
             do! Png.write true writeTask.Increment pixelMap pngOutput

RayTracing.App/SampleImages.fs

@@ -43,12 +43,14 @@ module SampleImages =
             }
 
         let image =
-            Array.init
+            Seq.init
                 256
                 (fun height ->
-                    let output = Array.init 256 (fun i -> async { return pixelAt height i })
+                    async {
-                    progressIncrement 1.0<progress>
+                        let output = Array.init 256 (pixelAt height)
-                    output
+                        progressIncrement 1.0<progress>
+                        return output
+                    }
                 )
             |> Image.make 256 256
 

RayTracing.Test/TestPpmOutput.fs

@@ -16,24 +16,18 @@ module TestRayTracing =
 
         let image =
             [|
+                [| Colour.Red ; Colour.Green ; Colour.Blue |]
                 [|
-                    async { return Colour.Red }
+                    {
-                    async { return Colour.Green }
+                        Red = 255uy
-                    async { return Colour.Blue }
+                        Blue = 0uy
-                |]
+                        Green = 255uy
-                [|
-                    async {
-                        return
-                            {
-                                Red = 255uy
-                                Blue = 0uy
-                                Green = 255uy
-                            }
                     }
-                    async { return Colour.White }
+                    Colour.White
-                    async { return Colour.Black }
+                    Colour.Black
                 |]
             |]
+            |> Array.map async.Return
             |> Image.make 2 3
 
         let outputFile = fs.Path.GetTempFileName () |> fs.FileInfo.FromFileName
@@ -42,7 +36,7 @@ module TestRayTracing =
 
         async {
             do! Async.AwaitTask await
-            let! pixelMap = ImageOutput.readPixelMap ignore tempOutput (Image.rowCount image) (Image.colCount image)
+            let! pixelMap = ImageOutput.readPixelMap tempOutput (Image.rowCount image) (Image.colCount image)
             let arr = ImageOutput.assertComplete pixelMap
             do! ImageOutput.writePpm false ignore arr outputFile
             return ()

RayTracing/Domain.fs

@@ -1,5 +1,6 @@
 namespace RayTracing
 
+open System.Threading.Tasks
 open RayTracing
 
 [<Measure>]
@@ -8,7 +9,7 @@ type progress
 type Image =
     private
         {
-            Rows : Pixel Async[] seq
+            Rows : Async<Pixel[]> seq
             RowCount : int
             ColCount : int
         }
@@ -19,34 +20,10 @@ module Image =
 
     let colCount i = i.ColCount
 
-    let render (i : Image) : (Pixel * Async<unit>)[] seq =
+    let render (i : Image) : Pixel[][] Task =
-        i.Rows
+        i.Rows |> Async.Parallel |> Async.StartAsTask
-        |> Seq.map (fun imageRow ->
-            if imageRow.Length <> i.ColCount then
-                failwithf
-                    "Thought the image had %i columns, got a pixel array with %i columns"
-                    i.ColCount
-                    imageRow.Length
 
-            let outputRow = Array.zeroCreate<Pixel * Async<unit>> i.ColCount
+    let make (rowCount : int) (colCount : int) (pixels : Async<Pixel[]> seq) : Image =
-
-            let doIt =
-                imageRow
-                |> Array.mapi (fun i p ->
-                    async {
-                        let! pixel = p
-                        let _, a = outputRow.[i]
-                        outputRow.[i] <- pixel, a
-                    }
-                )
-
-            for k in 0 .. i.ColCount - 1 do
-                outputRow.[k] <- Unchecked.defaultof<_>, doIt.[k]
-
-            outputRow
-        )
-
-    let make (rowCount : int) (colCount : int) (pixels : Async<Pixel>[] seq) : Image =
         {
             RowCount = rowCount
             ColCount = colCount

RayTracing/ImageOutput.fs

@@ -1,11 +1,8 @@
 namespace RayTracing
 
 open System
-open System.Collections.Generic
-open System.Collections.Immutable
 open System.IO
 open System.IO.Abstractions
-open System.Text
 open System.Threading.Tasks
 open SkiaSharp
 
@@ -68,13 +65,7 @@ module ImageOutput =
 
         toRet
 
-    let readPixelMap
+    let readPixelMap (progress : IFileInfo) (numRows : int) (numCols : int) : Async<Pixel ValueOption[][]> =
-        (incrementProgress : float<progress> -> unit)
-        (progress : IFileInfo)
-        (numRows : int)
-        (numCols : int)
-        : Async<Pixel ValueOption[][]>
-        =
         let rec go (dict : _[][]) (reader : Stream) =
             let row = consumeAsciiInteger reader
 
@@ -104,8 +95,6 @@ module ImageOutput =
                         dict
                     else
 
-                        incrementProgress 1.0<progress>
-
                         dict.[row].[col] <-
                             ValueSome
                                 {
@@ -141,53 +130,35 @@ module ImageOutput =
 
     let resume
         (incrementProgress : float<progress> -> unit)
-        (soFar : IReadOnlyDictionary<int * int, Pixel>)
         (image : Image)
         (fs : IFileSystem)
         : IFileInfo * Task<unit>
         =
         let tempFile = fs.Path.GetTempFileName () |> fs.FileInfo.FromFileName
 
-        tempFile,
+        let task =
-        task {
+            async {
-            use outputStream = tempFile.OpenWrite ()
+                use outputStream = tempFile.OpenWrite ()
-            use enumerator = image.Rows.GetEnumerator ()
+                let! pixels = image.Rows |> Async.Parallel
-            let mutable rowNum = 0
 
-            while enumerator.MoveNext () do
+                pixels
-
+                |> Array.iteri (fun rowNum row ->
-                let row = enumerator.Current
-
-                let! _ =
                     row
-                    |> Array.mapi (fun colNum pixel ->
+                    |> Array.iteri (fun colNum pixel ->
-                        backgroundTask {
+                        writeAsciiInt outputStream rowNum
-                            let! pixel =
+                        outputStream.WriteByte 44uy // ','
-                                match soFar.TryGetValue ((rowNum, colNum)) with
+                        writeAsciiInt outputStream colNum
-                                | false, _ -> pixel
+                        outputStream.WriteByte 10uy // '\n'
-                                | true, v -> async { return v }
+                        outputStream.WriteByte pixel.Red
-
+                        outputStream.WriteByte pixel.Green
-                            lock
+                        outputStream.WriteByte pixel.Blue
-                                outputStream
-                                (fun () ->
-                                    writeAsciiInt outputStream rowNum
-                                    outputStream.WriteByte 44uy // ','
-                                    writeAsciiInt outputStream colNum
-                                    outputStream.WriteByte 10uy // '\n'
-                                    outputStream.WriteByte pixel.Red
-                                    outputStream.WriteByte pixel.Green
-                                    outputStream.WriteByte pixel.Blue
-                                )
-
-                            incrementProgress 1.0<progress>
-                            return ()
-                        }
                     )
-                    |> Task.WhenAll
 
-                rowNum <- rowNum + 1
+                    incrementProgress 1.0<progress>
-        }
+                )
+            }
 
+        tempFile, Async.StartAsTask task
 
     let writePpm
         (gammaCorrect : bool)
@@ -237,7 +208,7 @@ module ImageOutput =
         (fs : IFileSystem)
         : IFileInfo * Task<unit>
         =
-        resume progressIncrement ImmutableDictionary.Empty image fs
+        resume progressIncrement image fs
 
 [<RequireQualifiedAccess>]
 module Png =
@@ -264,10 +235,10 @@ module Png =
                 let colour = PixelOutput.toSkia gammaCorrect pixels.[row].[pixels.[row].Length - 1]
 
                 img.SetPixel (pixels.[row].Length - 1, row, colour)
-                incrementProgress 1.0<progress>
 
             for row = 0 to pixels.Length - 2 do
                 writeRow row
+                incrementProgress 1.0<progress>
 
             writeRow (pixels.Length - 1)
 

RayTracing/InfinitePlane.fs

@@ -15,13 +15,14 @@ type InfinitePlaneStyle =
 [<RequireQualifiedAccess>]
 module InfinitePlane =
 
-    let pureOutgoing (strikePoint : Point) (normal : UnitVector) (incomingRay : Ray) : Ray =
+    let pureOutgoing (strikePoint : Point) (normal : UnitVector) (incomingRay : byref<Ray>) : unit =
-        let plane = Plane.makeOrthonormalSpannedBy (Ray.make strikePoint normal) incomingRay
+        let plane = Plane.makeOrthonormalSpannedBy' strikePoint normal incomingRay
 
         match plane with
         | ValueNone ->
             // Incoming ray is directly along the normal
-            Ray.flip incomingRay |> Ray.parallelTo strikePoint
+            Ray.flipInPlace incomingRay
+            Ray.translateToIntersect strikePoint incomingRay
         | 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
@@ -29,13 +30,19 @@ module InfinitePlane =
             let tangentComponent = (UnitVector.dot plane.V2 (Ray.vector incomingRay))
 
             let s =
+                // (plane.Point + plane.V1 * normalComponent) + plane.V2 * tangentComponent
                 tangentComponent
-                |> Ray.walkAlong (Ray.make (Ray.walkAlong (Ray.make plane.Point plane.V1) normalComponent) plane.V2)
+                |> Ray.walkAlongRay (Ray.walkAlongRay plane.Point plane.V1 normalComponent) plane.V2
 
-            Point.differenceToThenFrom s strikePoint
+
-            |> Ray.make' strikePoint
+            let newVector =
-            // This is definitely safe. It's actually a logic error if this fails.
+                Point.differenceToThenFrom s strikePoint
-            |> ValueOption.get
+                |> Vector.unitise
+                // This is definitely safe. It's actually a logic error if this fails.
+                |> ValueOption.get
+
+            incomingRay.Origin <- strikePoint
+            incomingRay.Vector <- newVector
 
     let newColour (incomingColour : Pixel) albedo colour =
         Pixel.combine incomingColour colour |> Pixel.darken albedo
@@ -57,29 +64,32 @@ module InfinitePlane =
 
         | InfinitePlaneStyle.FuzzedReflection (albedo, colour, fuzz, rand) ->
             let newColour = newColour incomingRay.Colour albedo colour
-            let pureOutgoing = pureOutgoing strikePoint normal incomingRay.Ray
+            pureOutgoing strikePoint normal &incomingRay.Ray
-            let mutable outgoing = Unchecked.defaultof<_>
+            // Henceforth `incomingRay` is actually the outgoing ray: we mutated it above.
+            let mutable isDone = false
 
-            while obj.ReferenceEquals (outgoing, null) do
+            while not isDone do
                 let offset = UnitVector.random rand (Point.dimension pointOnPlane)
-                let sphereCentre = Ray.walkAlong pureOutgoing 1.0
+                let sphereCentre = Ray.walkAlong incomingRay.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 output = Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
+                let outgoing = Point.differenceToThenFrom target strikePoint
 
-                match output with
+                match Vector.unitise outgoing with
                 | ValueNone -> ()
-                | ValueSome output -> outgoing <- output
+                | ValueSome output ->
+                    incomingRay.Ray.Vector <- output
+                    Ray.translateToIntersect strikePoint incomingRay.Ray
+                    isDone <- true
 
             incomingRay.Colour <- newColour
-            incomingRay.Ray <- outgoing
 
             ValueNone
 
         | InfinitePlaneStyle.LambertReflection (albedo, colour, rand) ->
             let outgoing =
-                let sphereCentre = Ray.walkAlong (Ray.make strikePoint normal) 1.0
+                let sphereCentre = Ray.walkAlongRay strikePoint normal 1.0
                 let offset = UnitVector.random rand (Point.dimension pointOnPlane)
-                let target = Ray.walkAlong (Ray.make sphereCentre offset) 1.0
+                let target = Ray.walkAlongRay sphereCentre offset 1.0
 
                 Point.differenceToThenFrom target strikePoint
                 |> Ray.make' strikePoint
@@ -93,8 +103,9 @@ module InfinitePlane =
             ValueNone
 
         | InfinitePlaneStyle.PureReflection (albedo, colour) ->
-            incomingRay.Colour <- newColour incomingRay.Colour albedo colour
+            let newColour = newColour incomingRay.Colour albedo colour
-            incomingRay.Ray <- pureOutgoing strikePoint normal incomingRay.Ray
+            incomingRay.Colour <- newColour
+            pureOutgoing strikePoint normal &incomingRay.Ray
 
             ValueNone
 

RayTracing/Plane.fs

@@ -61,23 +61,26 @@ module Plane =
             Point = Ray.origin r1
         }
 
-    let makeOrthonormalSpannedBy (r1 : Ray) (r2 : Ray) : OrthonormalPlane ValueOption =
+    let makeOrthonormalSpannedBy' (r1Origin : Point) (r1Vector : UnitVector) (r2 : Ray) : OrthonormalPlane ValueOption =
-        let coefficient = UnitVector.dot r1.Vector r2.Vector
+        let coefficient = UnitVector.dot r1Vector r2.Vector
 
         let vec2 =
-            UnitVector.difference' r2.Vector (UnitVector.scale coefficient r1.Vector)
+            UnitVector.difference' r2.Vector (UnitVector.scale coefficient r1Vector)
             |> Vector.unitise
 
         match vec2 with
         | ValueNone -> ValueNone
         | ValueSome v2 ->
             {
-                V1 = r1.Vector
+                V1 = r1Vector
                 V2 = v2
-                Point = Ray.origin r1
+                Point = r1Origin
             }
             |> ValueSome
 
+    let inline makeOrthonormalSpannedBy (r : Ray) (r2 : Ray) =
+        makeOrthonormalSpannedBy' r.Origin r.Vector r2
+
     /// 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/Scene.fs

@@ -208,26 +208,29 @@ module Scene =
         let rowsIter = 2 * maxHeightCoord + 1
         let colsIter = 2 * maxWidthCoord + 1
 
-        1.0<progress> * float (rowsIter * colsIter),
+        1.0<progress> * float rowsIter,
         {
             RowCount = rowsIter
             ColCount = colsIter
             Rows =
-                Array.init
+                Seq.init
                     rowsIter
                     (fun row ->
                         let row = maxHeightCoord - row - 1
 
-                        Array.init
+                        async {
-                            colsIter
+                            let result =
-                            (fun col ->
+                                Array.init
-                                let col = col - maxWidthCoord
+                                    colsIter
+                                    (fun col ->
+                                        let col = col - maxWidthCoord
 
-                                async {
+                                        let ret = renderPixel print s rand camera maxWidthCoord maxHeightCoord row col
-                                    let ret = renderPixel print s rand camera maxWidthCoord maxHeightCoord row col
+                                        ret
-                                    progressIncrement 1.0<progress>
+                                    )
-                                    return ret
+
-                                }
+                            progressIncrement 1.0<progress>
-                            )
+                            return result
+                        }
                     )
         }

RayTracing/Sphere.fs

@@ -136,7 +136,7 @@ module Sphere =
         let outgoingCos = sqrt (1.0 - outgoingSin * outgoingSin)
 
         let outgoingPoint =
-            Ray.walkAlong (Ray.make (Ray.walkAlong normal (-outgoingCos)) plane.V2) outgoingSin
+            Ray.walkAlongRay (Ray.walkAlong normal (-outgoingCos)) plane.V2 outgoingSin
 
         let outgoingLine = Point.differenceToThenFrom outgoingPoint strikePoint