Fix up the dielectric, and output as PNG (#4)

RayTracing.App/Program.fs

@@ -11,13 +11,13 @@ module Program =
 
         member this.Increment (prog : float<progress>) = this.Increment (prog / 1.0<progress>)
 
-    let go (sample : SampleImages) (ppmOutput : IFileInfo) (ctx : ProgressContext) =
+    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 = ppmOutput.FileSystem.Path.GetTempFileName () |> ppmOutput.FileSystem.FileInfo.FromFileName
+        let logFile = pngOutput.FileSystem.Path.GetTempFileName () |> pngOutput.FileSystem.FileInfo.FromFileName
         use stream = logFile.OpenWrite ()
         use writer = new StreamWriter(stream)
         writer.AutoFlush <- true
@@ -35,20 +35,20 @@ module Program =
         readTask.MaxValue <- maxProgress / 1.0<progress>
         writeTask.MaxValue <- maxProgress / 1.0<progress>
 
-        let tempOutput, await = ImageOutput.toPpm writeUnorderedTask.Increment image ppmOutput.FileSystem
+        let tempOutput, await = ImageOutput.toPpm writeUnorderedTask.Increment image pngOutput.FileSystem
         AnsiConsole.WriteLine (sprintf "Temporary output being written eagerly to '%s'" tempOutput.FullName)
 
         async {
             do! await
             let! pixelMap = ImageOutput.readPixelMap readTask.Increment tempOutput (Image.rowCount image) (Image.colCount image)
             let pixelMap = ImageOutput.assertComplete pixelMap
-            do! ImageOutput.writePpm true writeTask.Increment pixelMap ppmOutput
+            do! Png.write true writeTask.Increment pixelMap pngOutput
             tempOutput.Delete ()
             return ()
         }
         |> Async.RunSynchronously
 
-        printfn "%s" ppmOutput.FullName
+        printfn "%s" pngOutput.FullName
 
     [<EntryPoint>]
     let main (argv : string []) : int =
@@ -57,7 +57,7 @@ module Program =
             match argv with
             | [| name |] ->
                 SampleImages.Parse name,
-                fs.Path.GetTempFileName () |> fun i -> fs.Path.ChangeExtension (i, ".ppm") |> fs.FileInfo.FromFileName
+                fs.Path.GetTempFileName () |> fun i -> fs.Path.ChangeExtension (i, ".png") |> fs.FileInfo.FromFileName
             | [| name ; output |] ->
                 SampleImages.Parse name, fs.FileInfo.FromFileName output
             | _ -> failwithf "Expected two args 'sample name' 'output file', got %+A"  argv

RayTracing.App/SampleImages.fs

@@ -5,11 +5,12 @@ open System
 type SampleImages =
     | Gradient
     | Spheres
+    | RandomSpheres
     | ShinyFloor
     | FuzzyFloor
     | InsideSphere
     | TotalRefraction
-    | HollowDielectric
+    | GlassSphere
     | MovedCamera
     static member Parse (s : string) =
         match s with
@@ -20,7 +21,8 @@ type SampleImages =
         | "inside-sphere" -> SampleImages.InsideSphere
         | "total-refraction" -> SampleImages.TotalRefraction
         | "moved-camera" -> SampleImages.MovedCamera
-        | "hollow-dielectric" -> SampleImages.HollowDielectric
+        | "glass" -> SampleImages.GlassSphere
+        | "random-spheres" -> SampleImages.RandomSpheres
         | s -> failwithf "Unrecognised arg: %s" s
 
 [<RequireQualifiedAccess>]
@@ -50,7 +52,7 @@ module SampleImages =
         let aspectRatio = 16.0 / 9.0
         let origin = Point.make 0.0 0.0 0.0
         let camera =
-            Camera.makeBasic 2.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
+            Camera.makeBasic 50 2.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
         let pixels = 400
         {
             Objects =
@@ -66,7 +68,7 @@ module SampleImages =
         let aspectRatio = 16.0 / 9.0
         let origin = Point.make 0.0 0.0 0.0
         let camera =
-            Camera.makeBasic 2.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
+            Camera.makeBasic 50 2.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
         let pixels = 400
         {
             Objects =
@@ -84,7 +86,7 @@ module SampleImages =
         let aspectRatio = 16.0 / 9.0
         let origin = Point.make 0.0 0.0 0.0
         let camera =
-            Camera.makeBasic 7.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
+            Camera.makeBasic 50 7.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
         let pixels = 200
         {
             Objects =
@@ -117,7 +119,7 @@ module SampleImages =
         let aspectRatio = 16.0 / 9.0
         let origin = Point.make 0.0 0.0 0.0
         let camera =
-            Camera.makeBasic 7.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
+            Camera.makeBasic 50 7.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
         let pixels = 1200
         {
             Objects =
@@ -132,47 +134,20 @@ module SampleImages =
                     Hittable.Sphere (Sphere.make (SphereStyle.FuzzedReflection (0.6<albedo>, { Red = 200uy ; Green = 50uy ; Blue = 255uy }, 0.4<fuzz>, random3)) (Point.make 0.0 -76.0 9.0) 75.0 )
                     Hittable.Sphere (Sphere.make (SphereStyle.FuzzedReflection (0.4<albedo>, { Red = 200uy ; Green = 200uy ; Blue = 200uy }, 0.0<fuzz>, random4)) (Point.make 0.0 0.0 20.0) 100.0)
                     // Light pad behind us
-                    Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.LightSource ({ Red = 80uy ; Green = 80uy ; Blue = 150uy })) (Point.make 0.0 0.0 -5.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get))
+                    Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.LightSource { Red = 80uy ; Green = 80uy ; Blue = 150uy }) (Point.make 0.0 0.0 -5.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get))
 
                 |]
         }
         |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera
 
     let totalRefraction (progressIncrement : float<progress> -> unit) (log : string -> unit) : float<progress> * Image =
-        let random = Random () |> FloatProducer
-        let aspectRatio = 16.0 / 9.0
-        let origin = Point.make 0.0 0.0 0.0
-        let camera =
-            Camera.makeBasic 1.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
-        let pixels = 300
-        {
-            Objects =
-                [|
-                    // Floor
-                    Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.5<albedo>, { Red = 204uy ; Green = 204uy ; Blue = 0uy }, random)) (Point.make 0.0 -100.5 1.0) 100.0)
-
-                    // Right sphere
-                    Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0<albedo>, { Red = 204uy ; Green = 153uy ; Blue = 51uy })) (Point.make 1.0 0.0 1.0) 0.5)
-                    // Middle sphere
-                    Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (1.0<albedo>, { Red = 25uy ; Green = 50uy ; Blue = 120uy }, random)) (Point.make 0.0 0.0 1.0) 0.5)
-                    // Left sphere
-                    Hittable.Sphere (Sphere.make (SphereStyle.Dielectric (1.0<albedo>, Colour.White, 1.5<ior>, 1.0<prob>, random)) (Point.make -1.0 0.0 1.0) 0.5)
-
-                    // Light around us
-                    Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 80uy ; Green = 80uy ; Blue = 150uy }) (Point.make 0.0 0.0 0.0) 200.0)
-                |]
-        }
-        |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera
-
-    let hollowGlassSphere (progressIncrement : float<progress> -> unit) (log : string -> unit) : float<progress> * Image =
         let random1 = Random () |> FloatProducer
         let random2 = Random () |> FloatProducer
         let random3 = Random () |> FloatProducer
-        let random4 = Random () |> FloatProducer
         let aspectRatio = 16.0 / 9.0
         let origin = Point.make 0.0 0.0 0.0
         let camera =
-            Camera.makeBasic 1.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
+            Camera.makeBasic 50 1.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
         let pixels = 300
         {
             Objects =
@@ -180,13 +155,41 @@ module SampleImages =
                     // Floor
                     Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.5<albedo>, { Red = 204uy ; Green = 204uy ; Blue = 0uy }, random1)) (Point.make 0.0 -100.5 1.0) 100.0)
 
+                    // Right sphere
+                    Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0<albedo>, { Red = 204uy ; Green = 153uy ; Blue = 51uy })) (Point.make 1.0 0.0 1.0) 0.5)
+                    // Middle sphere
+                    Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (1.0<albedo>, { Red = 25uy ; Green = 50uy ; Blue = 120uy }, random2)) (Point.make 0.0 0.0 1.0) 0.5)
+                    // Left sphere
+                    Hittable.Sphere (Sphere.make (SphereStyle.Dielectric (1.0<albedo>, Colour.White, 1.5<ior>, 1.0<prob>, random3)) (Point.make -1.0 0.0 1.0) 0.5)
+
+                    // Light around us
+                    Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 80uy ; Green = 80uy ; Blue = 150uy }) (Point.make 0.0 0.0 0.0) 200.0)
+                |]
+        }
+        |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera
+
+    let glassSphere (progressIncrement : float<progress> -> unit) (log : string -> unit) : float<progress> * Image =
+        let random1 = Random () |> FloatProducer
+        let random2 = Random () |> FloatProducer
+        let random3 = Random () |> FloatProducer
+        let random4 = Random () |> FloatProducer
+        let aspectRatio = 16.0 / 9.0
+        let origin = Point.make 0.0 0.0 0.0
+        let camera =
+            Camera.makeBasic 50 1.0 aspectRatio origin (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
+        let pixels = 200
+        {
+            Objects =
+                [|
+                    // Floor
+                    Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.5<albedo>, { Red = 204uy ; Green = 204uy ; Blue = 0uy }, random1)) (Point.make 0.0 -100.5 1.0) 100.0)
+
                     // Right sphere
                     Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0<albedo>, { Red = 204uy ; Green = 153uy ; Blue = 51uy })) (Point.make 1.0 0.0 1.0) 0.5)
                     // Middle sphere
                     Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (1.0<albedo>, { Red = 25uy ; Green = 50uy ; Blue = 120uy }, random2)) (Point.make 0.0 0.0 1.0) 0.5)
                     // Left sphere
                     Hittable.Sphere (Sphere.make (SphereStyle.Glass (0.9<albedo>, Colour.White, 1.5<ior>, random3)) (Point.make -1.0 0.0 1.0) 0.5)
-                    Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0<albedo>, Colour.White, 1.0<ior> / 1.5, random4)) (Point.make -1.0 0.0 1.0) 0.4)
 
                     // Light around us
                     Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 80uy ; Green = 80uy ; Blue = 150uy }) (Point.make 0.0 0.0 0.0) 200.0)
@@ -195,25 +198,28 @@ module SampleImages =
         |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera
 
     let movedCamera (progressIncrement : float<progress> -> unit) (log : string -> unit) : float<progress> * Image =
-        let random = Random () |> FloatProducer
+        let random1 = Random () |> FloatProducer
+        let random2 = Random () |> FloatProducer
+        let random3 = Random () |> FloatProducer
+        let random4 = Random () |> FloatProducer
         let aspectRatio = 16.0 / 9.0
         let origin = Point.make -2.0 2.0 -1.0
         let camera =
-            Camera.makeBasic 10.0 aspectRatio origin (Point.differenceToThenFrom (Point.make -1.0 0.0 1.0) origin |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
+            Camera.makeBasic 50 10.0 aspectRatio origin (Point.differenceToThenFrom (Point.make -1.0 0.0 1.0) origin |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
         let pixels = 300
         {
             Objects =
                 [|
                     // Floor
-                    Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.5<albedo>, { Red = 204uy ; Green = 204uy ; Blue = 0uy }, random)) (Point.make 0.0 -100.5 1.0) 100.0)
+                    Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.5<albedo>, { Red = 204uy ; Green = 204uy ; Blue = 0uy }, random1)) (Point.make 0.0 -100.5 1.0) 100.0)
 
                     // Right sphere
                     Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0<albedo>, { Red = 204uy ; Green = 153uy ; Blue = 51uy })) (Point.make 1.0 0.0 1.0) 0.5)
                     // Middle sphere
-                    Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (1.0<albedo>, { Red = 25uy ; Green = 50uy ; Blue = 120uy }, random)) (Point.make 0.0 0.0 1.0) 0.5)
+                    Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (1.0<albedo>, { Red = 25uy ; Green = 50uy ; Blue = 120uy }, random2)) (Point.make 0.0 0.0 1.0) 0.5)
                     // Left sphere
-                    Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0<albedo>, Colour.White, 1.5<ior>, random)) (Point.make -1.0 0.0 1.0) 0.5)
-                    Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0<albedo>, Colour.White, 1.0<ior> / 1.5, random)) (Point.make -1.0 0.0 1.0) 0.45)
+                    Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0<albedo>, Colour.White, 1.5<ior>, random3)) (Point.make -1.0 0.0 1.0) 0.5)
+                    Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0<albedo>, Colour.White, 1.0<ior> / 1.5, random4)) (Point.make -1.0 0.0 1.0) -0.45)
 
                     // Light around us
                     Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 130uy ; Green = 130uy ; Blue = 200uy }) (Point.make 0.0 0.0 0.0) 200.0)
@@ -221,6 +227,62 @@ module SampleImages =
         }
         |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera
 
+    let randomSpheres (progressIncrement : float<progress> -> unit) (log : string -> unit) : float<progress> * Image =
+        let aspectRatio = 3.0 / 2.0
+        let origin = Point.make 13.0 2.0 -3.0
+        let camera =
+            Camera.makeBasic 500 10.0 aspectRatio origin (Point.differenceToThenFrom (Point.make 0.0 0.0 0.0) origin |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0)
+        let pixels = 800
+
+        let spheres =
+            [|
+                for a in -11..10 do
+                    for b in -11..10 do
+                        let rand = Random ()
+                        let floatProducer = FloatProducer rand
+                        let materialChoice = floatProducer.Get ()
+                        let centre = Point.make (float a + 0.9 * floatProducer.Get ()) 0.2 (float b + 0.9 * floatProducer.Get ())
+
+                        if Vector.normSquared (Point.differenceToThenFrom centre (Point.make 4.0 0.2 0.0)) > 0.9 * 0.9 then
+                            if Float.compare materialChoice 0.8 = Less then
+                                // diffuse
+                                let albedo = floatProducer.Get () * floatProducer.Get () * 1.0<albedo>
+                                yield Sphere.make (SphereStyle.LambertReflection (albedo, Colour.random rand, floatProducer)) centre 0.2
+                            elif Float.compare materialChoice 0.95 = Less then
+                                // metal
+                                let albedo = floatProducer.Get () / 2.0 * 1.0<albedo> + 0.5<albedo>
+                                let fuzz = floatProducer.Get () / 2.0 * 1.0<fuzz>
+                                yield Sphere.make (SphereStyle.FuzzedReflection (albedo, Colour.random rand, fuzz, floatProducer)) centre 0.2
+                            else
+                                // glass
+                                yield Sphere.make (SphereStyle.Glass (1.0<albedo>, Colour.White, 1.5<ior>, floatProducer)) centre 0.2
+
+
+                let rand = Random ()
+                let floatProducer = FloatProducer rand
+                yield Sphere.make (SphereStyle.Glass (1.0<albedo>, Colour.White, 1.5<ior>, floatProducer)) (Point.make 0.0 1.0 0.0) 1.0
+
+                let rand = Random ()
+                let floatProducer = FloatProducer rand
+                yield Sphere.make (SphereStyle.LambertReflection (1.0<albedo>, { Red = 80uy ; Green = 40uy ; Blue = 20uy }, floatProducer)) (Point.make -4.0 1.0 0.0) 1.0
+
+                yield Sphere.make (SphereStyle.PureReflection (1.0<albedo>, { Red = 180uy ; Green = 150uy ; Blue = 128uy })) (Point.make 4.0 1.0 0.0) 1.0
+
+                // Ceiling
+                yield Sphere.make (SphereStyle.LightSource { Colour.White with Red = 200uy ; Green = 200uy }) (Point.make 0.0 0.0 0.0) 2000.0
+
+                // Floor
+                let rand = Random ()
+                let floatProducer = FloatProducer rand
+                yield Sphere.make (SphereStyle.LambertReflection (0.5<albedo>, Colour.White, floatProducer)) (Point.make 0.0 -1000.0 0.0) 1000.0
+            |]
+
+        {
+            Objects = spheres |> Array.map Hittable.Sphere
+        }
+        |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera
+
+
     let get (s : SampleImages) : (float<progress> -> unit) -> (string -> unit) -> float<progress> * Image =
         match s with
         | Gradient -> gradient
@@ -229,5 +291,6 @@ module SampleImages =
         | FuzzyFloor -> fuzzyPlane
         | InsideSphere -> insideSphere
         | TotalRefraction -> totalRefraction
-        | HollowDielectric -> hollowGlassSphere
+        | GlassSphere -> glassSphere
         | MovedCamera -> movedCamera
+        | RandomSpheres -> randomSpheres