diff --git a/RayTracing.App/Program.fs b/RayTracing.App/Program.fs index cab1499..75ae139 100644 --- a/RayTracing.App/Program.fs +++ b/RayTracing.App/Program.fs @@ -11,13 +11,13 @@ module Program = member this.Increment (prog : float) = this.Increment (prog / 1.0) - 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 writeTask.MaxValue <- maxProgress / 1.0 - 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 [] 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 diff --git a/RayTracing.App/SampleImages.fs b/RayTracing.App/SampleImages.fs index 5d89489..05be195 100644 --- a/RayTracing.App/SampleImages.fs +++ b/RayTracing.App/SampleImages.fs @@ -5,11 +5,12 @@ open System type SampleImages = | Gradient | Spheres + | RandomSpheres | ShinyFloor | FuzzyFloor | InsideSphere | TotalRefraction - | HollowDielectric + | HollowGlassSphere | 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 + | "hollow-glass" -> SampleImages.HollowGlassSphere + | "random-spheres" -> SampleImages.RandomSpheres | s -> failwithf "Unrecognised arg: %s" s [] @@ -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,31 +134,33 @@ module SampleImages = Hittable.Sphere (Sphere.make (SphereStyle.FuzzedReflection (0.6, { Red = 200uy ; Green = 50uy ; Blue = 255uy }, 0.4, random3)) (Point.make 0.0 -76.0 9.0) 75.0 ) Hittable.Sphere (Sphere.make (SphereStyle.FuzzedReflection (0.4, { Red = 200uy ; Green = 200uy ; Blue = 200uy }, 0.0, 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 -> unit) (log : string -> unit) : float * Image = - let random = Random () |> FloatProducer + let random1 = Random () |> FloatProducer + let random2 = Random () |> FloatProducer + let random3 = 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 = [| // Floor - Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.5, { 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, { 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, { 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, { 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, { 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, Colour.White, 1.5, 1.0, random)) (Point.make -1.0 0.0 1.0) 0.5) + Hittable.Sphere (Sphere.make (SphereStyle.Dielectric (1.0, Colour.White, 1.5, 1.0, 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) @@ -172,8 +176,8 @@ module SampleImages = 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 + 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 = [| @@ -186,7 +190,7 @@ module SampleImages = Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (1.0, { 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, Colour.White, 1.5, random3)) (Point.make -1.0 0.0 1.0) 0.5) - Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.0 / 1.5, random4)) (Point.make -1.0 0.0 1.0) 0.4) + Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.0 / 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 +199,28 @@ module SampleImages = |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera let movedCamera (progressIncrement : float -> unit) (log : string -> unit) : float * 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, { 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, { 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, { 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, { 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, { 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, Colour.White, 1.5, random)) (Point.make -1.0 0.0 1.0) 0.5) - Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.0 / 1.5, random)) (Point.make -1.0 0.0 1.0) 0.45) + Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.5, random3)) (Point.make -1.0 0.0 1.0) 0.5) + Hittable.Sphere (Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.0 / 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 +228,62 @@ module SampleImages = } |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera + let randomSpheres (progressIncrement : float -> unit) (log : string -> unit) : float * 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 + 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 + 0.5 + let fuzz = floatProducer.Get () / 2.0 * 1.0 + yield Sphere.make (SphereStyle.FuzzedReflection (albedo, Colour.random rand, fuzz, floatProducer)) centre 0.2 + else + // glass + yield Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.5, floatProducer)) centre 0.2 + + + let rand = Random () + let floatProducer = FloatProducer rand + yield Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.5, 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, { Red = 80uy ; Green = 40uy ; Blue = 20uy }, floatProducer)) (Point.make -4.0 1.0 0.0) 1.0 + + yield Sphere.make (SphereStyle.PureReflection (1.0, { 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, 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 -> unit) -> (string -> unit) -> float * Image = match s with | Gradient -> gradient @@ -229,5 +292,6 @@ module SampleImages = | FuzzyFloor -> fuzzyPlane | InsideSphere -> insideSphere | TotalRefraction -> totalRefraction - | HollowDielectric -> hollowGlassSphere + | HollowGlassSphere -> hollowGlassSphere | MovedCamera -> movedCamera + | RandomSpheres -> randomSpheres diff --git a/RayTracing.Test/RayTracing.Test.fsproj b/RayTracing.Test/RayTracing.Test.fsproj index 838a7f4..f406e0f 100644 --- a/RayTracing.Test/RayTracing.Test.fsproj +++ b/RayTracing.Test/RayTracing.Test.fsproj @@ -13,6 +13,7 @@ + diff --git a/RayTracing.Test/TestRandom.fs b/RayTracing.Test/TestRandom.fs new file mode 100644 index 0000000..8da85d5 --- /dev/null +++ b/RayTracing.Test/TestRandom.fs @@ -0,0 +1,71 @@ +namespace RayTracing.Test + +open System +open NUnit.Framework +open FsUnitTyped +open RayTracing + +[] +module TestRandom = + + [] + [] + [] + let ``Random floats are in the right range`` (outputNum : int) = + let check (r : float) : unit = + Double.IsNormal r |> shouldEqual true + r < 0.0 |> shouldEqual false + r > 1.0 |> shouldEqual false + + let rand = Random () |> FloatProducer + for _ in 1..100 do + match outputNum with + | 1 -> + let r = rand.Get () + check r + | 2 -> + let struct(r, s) = rand.GetTwo () + check r + check s + | 3 -> + let struct(r, s, t) = rand.GetThree () + check r + check s + check t + | _ -> failwithf "unknown: %i" outputNum + + [] + let ``Random floats are distributed over the whole range`` () = + let rand = Random () |> FloatProducer + let randoms = Array.init 100 (fun _ -> rand.Get ()) |> Array.sort + for i in 0..9 do + let contains = + randoms + |> Array.exists (fun j -> float i * 0.1 < j && j < float (i + 1) * 0.1) + if not contains then failwithf "%i: %+A" i randoms + contains + |> shouldEqual true + + [] + [] + [] + let ``Floats aren't obviously correlated`` (inputNum : int) = + let rand = Random () |> FloatProducer + match inputNum with + | 1 -> + let r1 = rand.Get () + let r2 = rand.Get () + r1 |> shouldNotEqual r2 + | 2 -> + let struct(r1, r2) = rand.GetTwo () + let struct(r3, r4) = rand.GetTwo () + Set.ofList [r1 ; r2 ; r3 ; r4] + |> Set.count + |> shouldEqual 4 + | 3 -> + let struct(r1, r2, r3) = rand.GetThree () + let struct(r4, r5, r6) = rand.GetThree () + Set.ofList [r1 ; r2 ; r3 ; r4 ; r5 ; r6] + |> Set.count + |> shouldEqual 6 + | _ -> failwithf "unrecognised: %i" inputNum \ No newline at end of file diff --git a/RayTracing.Test/TestSphere.fs b/RayTracing.Test/TestSphere.fs index 5eacf4d..a0b13e3 100644 --- a/RayTracing.Test/TestSphere.fs +++ b/RayTracing.Test/TestSphere.fs @@ -1,8 +1,10 @@ namespace RayTracing.Test +open System open RayTracing open NUnit.Framework open FsCheck +open FsUnitTyped [] module TestSphere = @@ -37,4 +39,73 @@ module TestSphere = property |> Prop.forAll (Arb.fromGen gen) - |> Check.QuickThrowOnFailure \ No newline at end of file + |> Check.QuickThrowOnFailure + + [] + let ``Glass sphere perfectly reflects against the edge`` () = + let rand = Random () |> FloatProducer + let ray = Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) + let strikePoint = Point.make 0.0 0.0 1.0 + let destination = + Sphere.reflection + (SphereStyle.Glass (1.0, Colour.Green, 1.5, rand)) + (Point.make 0.0 1.0 1.0) + 1.0 + 1.0 + false + { LightRay.Ray = ray ; Colour = Colour.White } + strikePoint + + match destination with + | Continues onward -> + onward.Colour |> shouldEqual Colour.Green + Point.equal (Ray.origin onward.Ray) strikePoint |> shouldEqual true + Vector.equal (Ray.vector onward.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0) |> shouldEqual true + | Absorbs colour -> + failwithf "Absorbed: %+A" colour + + [] + let ``Glass sphere perfectly refracts through the middle`` () = + let rand = Random () |> FloatProducer + let ray = Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) + let strikePoint = Point.make 0.0 0.0 1.0 + let destination = + Sphere.reflection + (SphereStyle.Glass (1.0, Colour.Green, 1.5, rand)) + (Point.make 0.0 0.0 2.0) + 1.0 + 1.0 + false + { LightRay.Ray = ray ; Colour = Colour.White } + strikePoint + + match destination with + | Continues onward -> + onward.Colour |> shouldEqual Colour.Green + Point.equal (Ray.origin onward.Ray) strikePoint |> shouldEqual true + Vector.equal (Ray.vector onward.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0) |> shouldEqual true + | Absorbs colour -> + failwithf "Absorbed: %+A" colour + + [] + let ``Dielectric sphere refracts when incoming ray `` () = + let rand = Random () |> FloatProducer + let ray = Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) + let strikePoint = Point.make 0.0 0.0 1.0 + let destination = + Sphere.reflection + (SphereStyle.Dielectric (1.0, Colour.Green, 1.5, 1.0, rand)) + (Point.make 0.0 0.0 2.0) + 1.0 + 1.0 + false + { LightRay.Ray = ray ; Colour = Colour.White } + strikePoint + + match destination with + | Continues onward -> + onward.Colour |> shouldEqual Colour.Green + Point.equal (Ray.origin onward.Ray) strikePoint |> shouldEqual true + Vector.equal (Ray.vector onward.Ray |> UnitVector.scale 1.0) (Ray.vector ray |> UnitVector.scale 1.0) |> shouldEqual true + | Absorbs colour -> + failwithf "Absorbed: %+A" colour diff --git a/RayTracing/Camera.fs b/RayTracing/Camera.fs index 5e45e5a..48d9b07 100644 --- a/RayTracing/Camera.fs +++ b/RayTracing/Camera.fs @@ -30,6 +30,7 @@ module Camera = /// View angle is in radians (specified arbitrarily) let makeBasic + (samplesPerPixel : int) (focalLength : float) (aspectRatio : float) (origin : Point) @@ -51,5 +52,5 @@ module Camera = View = view ViewportXAxis = xAxis ViewportYAxis = yAxis - SamplesPerPixel = 60 + SamplesPerPixel = samplesPerPixel } \ No newline at end of file diff --git a/RayTracing/Float.fs b/RayTracing/Float.fs index fafae61..a4ee758 100644 --- a/RayTracing/Float.fs +++ b/RayTracing/Float.fs @@ -11,7 +11,7 @@ type Comparison = [] module private FloatProducer = - let inline generateInt32 (x : byref) (y : byref) (z : byref) (w : byref) = + let inline generateInt32 (x : byref) (y : byref) (z : byref) (w : byref) = let t = x ^^^ (x <<< 11) x <- y y <- z @@ -19,22 +19,22 @@ module private FloatProducer = w <- w ^^^ (w >>> 19) ^^^ (t ^^^ (t >>> 8)) w - let inline toInt (w : int) = - let highest = (w &&& 0xFF) - let secondHighest = ((w >>> 8) &&& 0xFF) - let thirdHighest = ((w >>> 16) &&& 0xFF) - let lowest = ((w >>> 24) &&& 0xFF) + let inline toInt (w : uint) : uint = + let highest = (w &&& 0xFFu) + let secondHighest = ((w >>> 8) &&& 0xFFu) + let thirdHighest = ((w >>> 16) &&& 0xFFu) + let lowest = ((w >>> 24) &&& 0xFFu) ((highest <<< 24) ^^^ (secondHighest <<< 16) ^^^ (thirdHighest <<< 8) ^^^ lowest) - let inline toDouble (i : int) = - float i / float Int32.MaxValue + let inline toDouble (i : uint) = + float i / float UInt32.MaxValue type FloatProducer (rand : Random) = let locker = obj () - let mutable x = rand.Next () - let mutable y = rand.Next () - let mutable z = rand.Next () - let mutable w = rand.Next () + let mutable x = uint (rand.Next ()) + let mutable y = uint (rand.Next ()) + let mutable z = uint (rand.Next ()) + let mutable w = uint (rand.Next ()) member __.Get () = Monitor.Enter locker diff --git a/RayTracing/ImageOutput.fs b/RayTracing/ImageOutput.fs index 1644cfa..4ac51e1 100644 --- a/RayTracing/ImageOutput.fs +++ b/RayTracing/ImageOutput.fs @@ -3,6 +3,7 @@ open System open System.Collections.Generic open System.Collections.Immutable +open System.Drawing.Imaging open System.IO open System.IO.Abstractions open System.Text @@ -30,6 +31,17 @@ module PixelOutput = let blue = pixel.Blue sprintf "%i %i %i" red green blue + let toSystem (gammaCorrect : bool) (pixel : Pixel) : System.Drawing.Color = + if gammaCorrect then + let red = correct pixel.Red + let green = correct pixel.Green + let blue = correct pixel.Blue + Drawing.Color.FromArgb (255, int red, int green, int blue) + else + let red = pixel.Red + let green = pixel.Green + let blue = pixel.Blue + Drawing.Color.FromArgb (255, int red, int green, int blue) [] module ImageOutput = @@ -169,3 +181,31 @@ module ImageOutput = : IFileInfo * Async = resume progressIncrement ImmutableDictionary.Empty image fs + +[] +module Png = + + let write (gammaCorrect : bool) (incrementProgress : float -> unit) (pixels : Pixel [] []) (output : IFileInfo) : Async = + let maxRow = pixels.Length + let maxCol = pixels.[0].Length + async { + use img = new System.Drawing.Bitmap (maxCol, maxRow) + + let writeRow (row : int) = + for col in 0..pixels.[row].Length - 2 do + let colour = PixelOutput.toSystem gammaCorrect pixels.[row].[col] + img.SetPixel (col, row, colour) + incrementProgress 1.0 + + let colour = PixelOutput.toSystem gammaCorrect pixels.[row].[pixels.[row].Length - 1] + img.SetPixel (pixels.[row].Length - 1, row, colour) + incrementProgress 1.0 + + for row in 0..pixels.Length - 2 do + writeRow row + writeRow (pixels.Length - 1) + + use fileStream = output.OpenWrite () + img.Save (fileStream, ImageFormat.Png) + return () + } \ No newline at end of file diff --git a/RayTracing/Pixel.fs b/RayTracing/Pixel.fs index b4d14c7..1057197 100644 --- a/RayTracing/Pixel.fs +++ b/RayTracing/Pixel.fs @@ -59,6 +59,15 @@ module Colour = Blue = 180uy } + let random (rand : Random) = + let buffer = Array.zeroCreate 3 + rand.NextBytes buffer + { + Red = buffer.[0] + Green = buffer.[1] + Blue = buffer.[2] + } + type PixelStats = private { diff --git a/RayTracing/RayTracing.fsproj b/RayTracing/RayTracing.fsproj index 9355416..c7c33a2 100644 --- a/RayTracing/RayTracing.fsproj +++ b/RayTracing/RayTracing.fsproj @@ -21,6 +21,7 @@ + diff --git a/RayTracing/Scene.fs b/RayTracing/Scene.fs index 78f04d5..3f3f7f7 100644 --- a/RayTracing/Scene.fs +++ b/RayTracing/Scene.fs @@ -97,7 +97,9 @@ module Scene = : Pixel = let rec go (bounces : int) (ray : LightRay) : Pixel = - if bounces > maxCount then Colour.HotPink else + if bounces > maxCount then + if ray.Colour = Colour.Black then Colour.Black else Colour.HotPink + else let thingsWeHit = hitObject scene ray.Ray match thingsWeHit with @@ -159,7 +161,7 @@ module Scene = let newMean = PixelStats.mean stats let difference = Pixel.difference newMean oldMean - if difference < 2 then + if difference = 0 then // The mean didn't really change when we added another five samples; assume it's not going to change // with more. newMean diff --git a/RayTracing/Sphere.fs b/RayTracing/Sphere.fs index 7557d98..60bbc75 100644 --- a/RayTracing/Sphere.fs +++ b/RayTracing/Sphere.fs @@ -64,20 +64,24 @@ module Sphere = (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. + + // 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))) (radius * radius) with + 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 - true, Ray.make (Ray.origin normal) (UnitVector.scale -1.0 (Ray.vector normal) |> UnitVector) + if flipped then false, normal else true, Ray.make (Ray.origin normal) (UnitVector.flip (Ray.vector normal)) | Greater -> - false, normal + if flipped then true, Ray.make (Ray.origin normal) (UnitVector.flip (Ray.vector normal)) else false, normal let fuzzedReflection (fuzz : (float * FloatProducer) option) = let plane = @@ -119,9 +123,16 @@ module Sphere = let refract (incomingCos : float) (index : float) = let index = if inside then 1.0 / index else index / 1.0 - let plane = Plane.makeSpannedBy normal incomingLight.Ray + let plane = + Plane.makeSpannedBy normal incomingLight.Ray + |> Plane.orthonormalise + match plane with + | None -> + // Incoming ray was parallel to normal; pass straight through + Ray.make strikePoint (Ray.vector incomingLight.Ray) + | Some plane -> let incomingSin = sqrt (1.0 - incomingCos * incomingCos) - let outgoingSin = incomingSin * index + let outgoingSin = incomingSin / index 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 @@ -197,7 +208,7 @@ module Sphere = // reflect! Continues { Ray = fuzzedReflection None ; Colour = newColour } else - let incomingCos = UnitVector.dot (UnitVector.flip (Ray.vector incomingLight.Ray)) (Ray.vector normal) + let incomingCos = UnitVector.dot (Ray.vector incomingLight.Ray) (Ray.vector normal) Continues { Ray = refract incomingCos sphereRefractance ; Colour = newColour } | SphereStyle.Glass (albedo, colour, sphereRefractance, random) -> @@ -205,26 +216,28 @@ module Sphere = Pixel.combine incomingLight.Colour colour |> Pixel.darken albedo - let incomingCos = UnitVector.dot (Ray.vector normal) (UnitVector.flip (Ray.vector incomingLight.Ray)) + let incomingCos = UnitVector.dot (UnitVector.flip (Ray.vector incomingLight.Ray)) (Ray.vector normal) let rand = random.Get () let reflectionProb = + let sphereRefractance = if inside then 1.0 / sphereRefractance else sphereRefractance let param = (1.0 - sphereRefractance) / (1.0 + sphereRefractance) let param = param * param param + (1.0 - param) * ((1.0 - incomingCos) ** 5.0) - if LanguagePrimitives.FloatWithMeasure rand > reflectionProb then + if LanguagePrimitives.FloatWithMeasure rand < reflectionProb then // reflect! Continues { Ray = fuzzedReflection None ; Colour = newColour } else Continues { Ray = refract incomingCos sphereRefractance ; Colour = newColour } let make (style : SphereStyle) (centre : Point) (radius : float) : Sphere = + let radiusSquared = radius * radius { Centre = centre Radius = radius - Reflection = reflection style centre radius - RadiusSquared = radius * radius + Reflection = reflection style centre radius radiusSquared (Float.compare radius 0.0 = Less) + RadiusSquared = radiusSquared } let liesOn (point : Point) (sphere : Sphere) : bool =