diff --git a/RayTracing.App/Program.fs b/RayTracing.App/Program.fs index 633e15b..cab1499 100644 --- a/RayTracing.App/Program.fs +++ b/RayTracing.App/Program.fs @@ -1,5 +1,6 @@ namespace RayTracing.App +open System.IO open RayTracing open System.IO.Abstractions open Spectre.Console @@ -16,7 +17,19 @@ module Program = let readTask = ctx.AddTask "[green]Reading in serialised pixels[/]" let writeTask = ctx.AddTask "[green]Writing PPM file[/]" - let maxProgress, image = SampleImages.get sample renderTask.Increment + let logFile = ppmOutput.FileSystem.Path.GetTempFileName () |> ppmOutput.FileSystem.FileInfo.FromFileName + use stream = logFile.OpenWrite () + use writer = new StreamWriter(stream) + writer.AutoFlush <- true + let lockObj = obj () + let write (s : string) = + lock lockObj (fun () -> + writer.WriteLine s + ) + + printfn "Log output, if any, to '%s'" logFile.FullName + + let maxProgress, image = SampleImages.get sample renderTask.Increment write renderTask.MaxValue <- maxProgress / 1.0 writeUnorderedTask.MaxValue <- maxProgress / 1.0 readTask.MaxValue <- maxProgress / 1.0 diff --git a/RayTracing.App/SampleImages.fs b/RayTracing.App/SampleImages.fs index 45c634d..5d89489 100644 --- a/RayTracing.App/SampleImages.fs +++ b/RayTracing.App/SampleImages.fs @@ -9,6 +9,7 @@ type SampleImages = | FuzzyFloor | InsideSphere | TotalRefraction + | HollowDielectric | MovedCamera static member Parse (s : string) = match s with @@ -19,12 +20,13 @@ type SampleImages = | "inside-sphere" -> SampleImages.InsideSphere | "total-refraction" -> SampleImages.TotalRefraction | "moved-camera" -> SampleImages.MovedCamera + | "hollow-dielectric" -> SampleImages.HollowDielectric | s -> failwithf "Unrecognised arg: %s" s [] module SampleImages = - let gradient (progressIncrement : float -> unit) : float * Image = + let gradient (progressIncrement : float -> unit) (_ : string -> unit) : float * Image = let pixelAt height width = { Red = (byte width) @@ -44,7 +46,7 @@ module SampleImages = 256.0, image - let shinyPlane (progressIncrement : float -> unit) : float * Image = + let shinyPlane (progressIncrement : float -> unit) (log : string -> unit) : float * Image = let aspectRatio = 16.0 / 9.0 let origin = Point.make 0.0 0.0 0.0 let camera = @@ -57,9 +59,9 @@ module SampleImages = Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.PureReflection (0.5, Colour.White)) (Point.make 0.0 -1.0 0.0) (Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get)) // Floor rug |] } - |> Scene.render progressIncrement (aspectRatio * (float pixels) |> int) pixels camera + |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera - let fuzzyPlane (progressIncrement : float -> unit) : float * Image = + let fuzzyPlane (progressIncrement : float -> unit) (log : string -> unit) : float * Image = let random = Random () |> FloatProducer let aspectRatio = 16.0 / 9.0 let origin = Point.make 0.0 0.0 0.0 @@ -73,9 +75,9 @@ module SampleImages = Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.FuzzedReflection (1.0, Colour.White, 0.75, random)) (Point.make 0.0 -1.0 0.0) (Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get)) // Floor rug |] } - |> Scene.render progressIncrement (aspectRatio * (float pixels) |> int) pixels camera + |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera - let spheres (progressIncrement : float -> unit) : float * Image = + let spheres (progressIncrement : float -> unit) (log : string -> unit) : float * Image = let random1 = Random () |> FloatProducer let random2 = Random () |> FloatProducer let random3 = Random () |> FloatProducer @@ -105,9 +107,9 @@ module SampleImages = Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.LightSource { Red = 15uy ; Green = 15uy ; Blue = 15uy }) (Point.make 0.0 1.0 -1.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get)) |] } - |> Scene.render progressIncrement (aspectRatio * (float pixels) |> int) pixels camera + |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera - let insideSphere (progressIncrement : float -> unit) : float * Image = + let insideSphere (progressIncrement : float -> unit) (log : string -> unit) : float * Image = let random1 = Random () |> FloatProducer let random2 = Random () |> FloatProducer let random3 = Random () |> FloatProducer @@ -134,9 +136,9 @@ module SampleImages = |] } - |> Scene.render progressIncrement (aspectRatio * (float pixels) |> int) pixels camera + |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera - let totalRefraction (progressIncrement : float -> unit) : float * Image = + let totalRefraction (progressIncrement : float -> unit) (log : string -> unit) : float * Image = let random = Random () |> FloatProducer let aspectRatio = 16.0 / 9.0 let origin = Point.make 0.0 0.0 0.0 @@ -154,22 +156,51 @@ module SampleImages = // 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) // Left sphere - Hittable.Sphere (Sphere.make (SphereStyle.Dielectric (1.0, Colour.White, 0.666, 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, random)) (Point.make -1.0 0.0 1.0) 0.4) + 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) // 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 (aspectRatio * (float pixels) |> int) pixels camera + |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera - let movedCamera (progressIncrement : float -> unit) : float * Image = + let hollowGlassSphere (progressIncrement : float -> unit) (log : string -> unit) : float * 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) + let pixels = 300 + { + Objects = + [| + // Floor + 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 }, 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) + + // 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 movedCamera (progressIncrement : float -> unit) (log : string -> unit) : float * Image = let random = Random () |> FloatProducer let aspectRatio = 16.0 / 9.0 let origin = Point.make -2.0 2.0 -1.0 let camera = - Camera.makeBasic 1.0 aspectRatio origin (Point.differenceToThenFrom (Point.make 0.0 0.0 1.0) origin |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0) - let pixels = 200 + 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) + let pixels = 300 { Objects = [| @@ -181,16 +212,16 @@ module SampleImages = // 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) // Left sphere - Hittable.Sphere (Sphere.make (SphereStyle.Dielectric (1.0, Colour.White, 0.666, 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, random)) (Point.make -1.0 0.0 1.0) 0.4) + 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) // 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) + Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 130uy ; Green = 130uy ; Blue = 200uy }) (Point.make 0.0 0.0 0.0) 200.0) |] } - |> Scene.render progressIncrement (aspectRatio * (float pixels) |> int) pixels camera + |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera - let get (s : SampleImages) : (float -> unit) -> float * Image = + let get (s : SampleImages) : (float -> unit) -> (string -> unit) -> float * Image = match s with | Gradient -> gradient | Spheres -> spheres @@ -198,6 +229,5 @@ module SampleImages = | FuzzyFloor -> fuzzyPlane | InsideSphere -> insideSphere | TotalRefraction -> totalRefraction - // TODO - the movedCamera image is weird and not right - probably to do with the x and y axes being - // vertical rather than scaled with the lookAt? + | HollowDielectric -> hollowGlassSphere | MovedCamera -> movedCamera diff --git a/RayTracing.Test/TestRay.fs b/RayTracing.Test/TestRay.fs index a3c0d18..c9c3ce1 100644 --- a/RayTracing.Test/TestRay.fs +++ b/RayTracing.Test/TestRay.fs @@ -67,3 +67,10 @@ module TestRay = property |> Prop.forAll (Arb.fromGen (Gen.zip TestUtils.rayGen (Arb.generate |> Gen.map NormalFloat.op_Explicit))) |> Check.QuickThrowOnFailure + + [] + let foo () = + let r = System.Random () + let fp = FloatProducer r + for i in Array.init 100 (fun _ -> fp.Get ()) |> Array.sort do + printfn "%f" i diff --git a/RayTracing/Camera.fs b/RayTracing/Camera.fs index d737f03..5e45e5a 100644 --- a/RayTracing/Camera.fs +++ b/RayTracing/Camera.fs @@ -51,5 +51,5 @@ module Camera = View = view ViewportXAxis = xAxis ViewportYAxis = yAxis - SamplesPerPixel = 50 + SamplesPerPixel = 60 } \ No newline at end of file diff --git a/RayTracing/Float.fs b/RayTracing/Float.fs index 98fa36c..92b51cc 100644 --- a/RayTracing/Float.fs +++ b/RayTracing/Float.fs @@ -10,21 +10,36 @@ type Comparison = 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 () - member _.Get () : float = - lock locker (fun () -> - rand.NextDouble () - ) + let generateInt32 () = + let w = + lock locker (fun () -> + let t = x ^^^ (x <<< 11) + x <- y + y <- z + z <- w + w <- w ^^^ (w >>> 19) ^^^ (t ^^^ (t >>> 8)) + w + ) + let highest = (w &&& 0xFF) + let secondHighest = ((w >>> 8) &&& 0xFF) + let thirdHighest = ((w >>> 16) &&& 0xFF) + let lowest = ((w >>> 24) &&& 0xFF) + ((highest <<< 24) ^^^ (secondHighest <<< 16) ^^^ (thirdHighest <<< 8) ^^^ lowest) - member _.GetTwo () : struct(float * float) = - lock locker (fun () -> - rand.NextDouble (), rand.NextDouble() - ) + let generateDouble () = + float (generateInt32 ()) / float Int32.MaxValue + + member _.Get () : float = generateDouble () + + member _.GetTwo () : struct(float * float) = generateDouble (), generateDouble () member _.GetThree () : struct(float * float * float) = - lock locker (fun () -> - rand.NextDouble (), rand.NextDouble(), rand.NextDouble() - ) + generateDouble (), generateDouble (), generateDouble () [] @@ -40,8 +55,8 @@ module Float = let inline positive (a : float) : bool = a > tolerance - let inline compare (a : float) (b : float) : Comparison = - if abs (a - b) < tolerance then Comparison.Equal + let inline compare<[] 'a> (a : float<'a>) (b : float<'a>) : Comparison = + if abs (a - b) < LanguagePrimitives.FloatWithMeasure tolerance then Comparison.Equal elif a < b then Comparison.Less else Comparison.Greater diff --git a/RayTracing/InfinitePlane.fs b/RayTracing/InfinitePlane.fs index 596773d..5339c38 100644 --- a/RayTracing/InfinitePlane.fs +++ b/RayTracing/InfinitePlane.fs @@ -16,10 +16,9 @@ type InfinitePlane = { Normal : UnitVector Point : Point - /// If an incoming ray has the given colour, and hits the - /// given point (which is guaranteed to be on the surface), + /// 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 : Ray -> Pixel -> Point -> Ray option * Pixel + Reflection : LightRay -> Point -> LightDestination } [] @@ -43,7 +42,7 @@ module InfinitePlane = ValueSome t else ValueNone - let pureOutgoing (strikePoint : Point) (normal : UnitVector) (incomingRay : Ray) : Ray option = + let pureOutgoing (strikePoint : Point) (normal : UnitVector) (incomingRay : Ray) : Ray = let plane = Plane.makeSpannedBy (Ray.make strikePoint normal) incomingRay |> Plane.orthonormalise @@ -52,7 +51,6 @@ module InfinitePlane = // Incoming ray is directly along the normal Ray.flip incomingRay |> Ray.parallelTo strikePoint - |> Some | Some 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 @@ -63,6 +61,8 @@ module InfinitePlane = |> Ray.walkAlong (Ray.make (Ray.walkAlong (Ray.make plane.Point plane.V1) normalComponent) plane.V2) Point.differenceToThenFrom s strikePoint |> Ray.make' strikePoint + // This is definitely safe. It's actually a logic error if this fails. + |> Option.get let newColour (incomingColour : Pixel) albedo colour = Pixel.combine incomingColour colour @@ -72,27 +72,30 @@ module InfinitePlane = (style : InfinitePlaneStyle) (pointOnPlane : Point) (normal : UnitVector) - : Ray -> Pixel -> Point -> Ray option * Pixel + : LightRay -> Point -> LightDestination = - fun incomingRay incomingColour strikePoint -> + fun incomingRay strikePoint -> match style with | InfinitePlaneStyle.LightSource colour -> - None, Pixel.combine incomingColour colour + Absorbs (Pixel.combine incomingRay.Colour colour) | InfinitePlaneStyle.FuzzedReflection (albedo, colour, fuzz, rand) -> - let newColour = newColour incomingColour albedo colour - let pureOutgoing = pureOutgoing strikePoint normal incomingRay - let outgoing = - match pureOutgoing with - | None -> None - | Some outgoing -> - let offset = UnitVector.random rand (Point.dimension pointOnPlane) - let sphereCentre = Ray.walkAlong outgoing 1.0 - let target = Ray.walkAlong (Ray.make sphereCentre offset) (fuzz / 1.0) + let newColour = newColour incomingRay.Colour albedo colour + let pureOutgoing = pureOutgoing strikePoint normal incomingRay.Ray + let mutable outgoing = Unchecked.defaultof<_> + while obj.ReferenceEquals (outgoing, null) do + let offset = UnitVector.random rand (Point.dimension pointOnPlane) + let sphereCentre = Ray.walkAlong pureOutgoing 1.0 + let target = Ray.walkAlong (Ray.make sphereCentre offset) (fuzz / 1.0) + let output = Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint + match output with + | None -> () + | Some output -> + outgoing <- output - outgoing, newColour + Continues { Ray = outgoing ; Colour = newColour } | InfinitePlaneStyle.LambertReflection (albedo, colour, rand) -> let outgoing = @@ -101,14 +104,19 @@ module InfinitePlane = let target = Ray.walkAlong (Ray.make sphereCentre offset) 1.0 Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint + |> Option.get let newColour = - Pixel.combine incomingColour colour + Pixel.combine incomingRay.Colour colour |> Pixel.darken albedo - outgoing, newColour + Continues { Ray = outgoing ; Colour = newColour } | InfinitePlaneStyle.PureReflection (albedo, colour) -> - pureOutgoing strikePoint normal incomingRay, newColour incomingColour albedo colour + { + Ray = pureOutgoing strikePoint normal incomingRay.Ray + Colour = newColour incomingRay.Colour albedo colour + } + |> Continues let make (style : InfinitePlaneStyle) (pointOnPlane : Point) (normal : UnitVector) : InfinitePlane = { @@ -116,4 +124,3 @@ module InfinitePlane = Normal = normal Reflection = reflection style pointOnPlane normal } - diff --git a/RayTracing/LightRay.fs b/RayTracing/LightRay.fs new file mode 100644 index 0000000..b39d623 --- /dev/null +++ b/RayTracing/LightRay.fs @@ -0,0 +1,21 @@ +namespace RayTracing + +/// Index of refraction of this material. +[] +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.) + } + +type LightDestination = + | Continues of LightRay + | Absorbs of Pixel \ No newline at end of file diff --git a/RayTracing/Pixel.fs b/RayTracing/Pixel.fs index 568cd52..b4d14c7 100644 --- a/RayTracing/Pixel.fs +++ b/RayTracing/Pixel.fs @@ -1,11 +1,12 @@ namespace RayTracing open System +open System.Runtime.CompilerServices [] type albedo -[] +[] type Pixel = { Red : byte diff --git a/RayTracing/Point.fs b/RayTracing/Point.fs index 8227109..acb3537 100644 --- a/RayTracing/Point.fs +++ b/RayTracing/Point.fs @@ -1,18 +1,21 @@ namespace RayTracing +open System.Runtime.CompilerServices + /// An n-dimensional point. /// We don't let you compare these for equality, because floats are hard. -[] +[] type Point = private | Point of struct(float * float * float) -[] +[] type Vector = private | Vector of struct(float * float * float) -type UnitVector = UnitVector of Vector +[] +type UnitVector = | UnitVector of Vector [] module Vector = diff --git a/RayTracing/RayTracing.fsproj b/RayTracing/RayTracing.fsproj index 7efe7e4..9355416 100644 --- a/RayTracing/RayTracing.fsproj +++ b/RayTracing/RayTracing.fsproj @@ -12,6 +12,7 @@ + diff --git a/RayTracing/Scene.fs b/RayTracing/Scene.fs index 479edf9..78f04d5 100644 --- a/RayTracing/Scene.fs +++ b/RayTracing/Scene.fs @@ -6,10 +6,10 @@ type Hittable = | Sphere of Sphere | InfinitePlane of InfinitePlane - member this.Reflection (incoming : Ray) (incomingColour : Pixel) (strikePoint : Point) = + member this.Reflection (incoming : LightRay) (strikePoint : Point) = match this with - | Sphere s -> s.Reflection incoming incomingColour strikePoint - | InfinitePlane p -> p.Reflection incoming incomingColour strikePoint + | Sphere s -> s.Reflection incoming strikePoint + | InfinitePlane p -> p.Reflection incoming strikePoint [] module Hittable = @@ -57,34 +57,66 @@ module Scene = if Double.IsNaN bestLength then None else Some (bestIndex, Ray.walkAlong ray bestLength) + let internal traceRayPrinting + (print : string -> unit) + (maxCount : int) + (scene : Scene) + (ray : LightRay) + : Pixel + = + let rec go (bounces : int) (ray : LightRay) : Pixel = + let (Point(x, y, z)) = Ray.origin ray.Ray + let (UnitVector (Vector(a, b, c))) = Ray.vector ray.Ray + print (sprintf "Ray, colour %i,%i,%i\n origin (%f, %f, %f)\n vector (%f, %f, %f)" ray.Colour.Red ray.Colour.Green ray.Colour.Blue x y z a b c) + if bounces > maxCount then Colour.HotPink else + + let thingsWeHit = hitObject scene ray.Ray + match thingsWeHit with + | None -> + print ">>> No object collision; black." + // Ray goes off into the distance and is never heard from again + Colour.Black + | Some (objectNumber, strikePoint) -> + let (Point(x, y, z)) = strikePoint + print (sprintf ">>> collided with object %i at (%f, %f, %f)" objectNumber x y z) + let outgoingRay = scene.Objects.[objectNumber].Reflection ray strikePoint + match outgoingRay with + | Absorbs colour -> + print (sprintf ">>> surface absorbs, yielding colour %i,%i,%i" colour.Red colour.Green colour.Blue) + colour + | Continues outgoingRay -> + print ">>> continuing tracing." + go (bounces + 1) outgoingRay + + go 0 ray + let internal traceRay (maxCount : int) (scene : Scene) - (ray : Ray) - (colour : Pixel) + (ray : LightRay) : Pixel = - let rec go (bounces : int) (ray : Ray) (colour : Pixel) : Pixel = + let rec go (bounces : int) (ray : LightRay) : Pixel = if bounces > maxCount then Colour.HotPink else - let thingsWeHit = hitObject scene ray + let thingsWeHit = hitObject scene ray.Ray match thingsWeHit with | None -> // Ray goes off into the distance and is never heard from again Colour.Black | Some (objectNumber, strikePoint) -> - let outgoingRay, colour = scene.Objects.[objectNumber].Reflection ray colour strikePoint + let outgoingRay = scene.Objects.[objectNumber].Reflection ray strikePoint match outgoingRay with - | None -> + | Absorbs colour -> colour - | Some outgoingRay -> - go (bounces + 1) outgoingRay colour + | Continues outgoingRay -> + go (bounces + 1) outgoingRay - go 0 ray colour + go 0 ray /// Trace a ray to this one pixel, updating the PixelStats with the result. /// n.b. not thread safe - let private traceOnce (scene : Scene) (rand : FloatProducer) (camera : Camera) (maxWidthCoord : int) (maxHeightCoord : int) row col stats = + let private traceOnce (print : string -> unit) (scene : Scene) (rand : FloatProducer) (camera : Camera) (maxWidthCoord : int) (maxHeightCoord : int) row col stats = let struct(rand1, rand2) = rand.GetTwo () let landingPoint = ((float col + rand1) * camera.ViewportWidth) / float maxWidthCoord @@ -99,22 +131,30 @@ module Scene = Ray.make' (Ray.origin camera.View) (Point.differenceToThenFrom endPoint (Ray.origin camera.View)) |> Option.get - let result = traceRay 150 scene ray Colour.White + // Here we've hardcoded that the eye is emitting white light through a medium with refractance 1. + let result = traceRay 150 scene { Ray = ray ; Colour = Colour.White } + //if result = Colour.HotPink then + // print "hi" + // traceRayPrinting print 150 scene { Ray = ray ; Colour = Colour.White ; Refractance = 1.0 } + // |> ignore + // failwith "Stopping." PixelStats.add result stats - let renderPixel (scene : Scene) (rand : FloatProducer) (camera : Camera) maxWidthCoord maxHeightCoord row col = + let renderPixel (print : string -> unit) (scene : Scene) (rand : FloatProducer) (camera : Camera) maxWidthCoord maxHeightCoord row col = // Where does this pixel correspond to, on the imaginary canvas? // For the early prototype, we'll just take the upper right quadrant // from the camera. let stats = PixelStats.empty () - for _ in 1..5 do - traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats + let firstTrial = min 5 (camera.SamplesPerPixel / 2) + + for _ in 0..firstTrial do + traceOnce print scene rand camera maxWidthCoord maxHeightCoord row col stats let oldMean = PixelStats.mean stats - for _ in 1..5 do - traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats + for _ in 1..firstTrial do + traceOnce print scene rand camera maxWidthCoord maxHeightCoord row col stats let newMean = PixelStats.mean stats let difference = Pixel.difference newMean oldMean @@ -125,13 +165,14 @@ module Scene = newMean else - for _ in 1..camera.SamplesPerPixel - 10 do - traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats + for _ in 1..(camera.SamplesPerPixel - 2 * firstTrial - 1) do + traceOnce print scene rand camera maxWidthCoord maxHeightCoord row col stats PixelStats.mean stats let render (progressIncrement : float -> unit) + (print : string -> unit) (maxWidthCoord : int) (maxHeightCoord : int) (camera : Camera) @@ -153,7 +194,7 @@ module Scene = Array.init colsIter (fun col -> let col = col - maxWidthCoord async { - let ret = renderPixel s rand camera maxWidthCoord maxHeightCoord row col + let ret = renderPixel print s rand camera maxWidthCoord maxHeightCoord row col progressIncrement 1.0 return ret } diff --git a/RayTracing/Sphere.fs b/RayTracing/Sphere.fs index dcf2d0c..7557d98 100644 --- a/RayTracing/Sphere.fs +++ b/RayTracing/Sphere.fs @@ -3,10 +3,6 @@ namespace RayTracing [] type fuzz -/// Index of refraction. Must be greater than or equal to 1. -[] -type ior - /// A probability, between 0 and 1. [] type prob @@ -19,7 +15,7 @@ type Sphere = /// 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 : Ray -> Pixel -> Point -> Ray option * Pixel + Reflection : LightRay -> Point -> LightDestination RadiusSquared : float } @@ -39,10 +35,13 @@ type SphereStyle = /// surface is the same regardless of the angle of view. /// Albedo must be between 0 and 1. | LambertReflection of albedo : float * colour : Pixel * FloatProducer - /// A refracting sphere with the given ratio `ior` of its index of refraction with that of the surrounding - /// medium. + /// A refracting sphere with the given ratio `ior` of its index of refraction with that of the medium on + /// the other side of the surface. The convention is such that a solid sphere, with a light ray + /// entering from outside, should have index of refraction greater than 1. /// The probability is the probability that a ray will refract, so 0 yields a perfectly reflecting sphere. - | Dielectric of albedo : float * colour : Pixel * float * reflection : float * FloatProducer + | Dielectric of albedo : float * colour : Pixel * boundaryRefractance : float * refraction : float * FloatProducer + /// A glass material which uses Schlick's approximation for reflectance probability. + | Glass of albedo : float * colour : Pixel * float * FloatProducer type Orientation = | Inside @@ -57,24 +56,22 @@ module Sphere = Ray.make' p (Point.differenceToThenFrom p centre) |> Option.get - let private liesOn' (centre : Point) (radius : float) : Point -> bool = + let private liesOn' (centre : Point) (radius : float) (p : Point) : bool = let rSquared = radius * radius - fun p -> - Float.equal (Vector.normSquared (Point.differenceToThenFrom p centre)) rSquared + Float.equal (Vector.normSquared (Point.differenceToThenFrom p centre)) rSquared let reflection (style : SphereStyle) (centre : Point) (radius : float) - (incomingRay : Ray) - (incomingColour : Pixel) + (incomingLight : LightRay) (strikePoint : Point) - : Ray option * Pixel + : LightDestination = let normal = normal centre strikePoint // If the incoming ray is on the sphere, then we have to be an internal ray. let inside, normal = - match Float.compare (Vector.normSquared (Point.differenceToThenFrom centre (Ray.origin incomingRay))) (radius * radius) with + match Float.compare (Vector.normSquared (Point.differenceToThenFrom centre (Ray.origin incomingLight.Ray))) (radius * radius) with | Equal | Less -> // Point is inside or on the sphere so we are coming from within @@ -82,45 +79,67 @@ module Sphere = | Greater -> false, normal - let fuzzedReflection (colour : Pixel) (albedo : float) (fuzz : (float * FloatProducer) option) = + let fuzzedReflection (fuzz : (float * FloatProducer) option) = let plane = - Plane.makeSpannedBy normal incomingRay + Plane.makeSpannedBy normal incomingLight.Ray |> Plane.orthonormalise let outgoing = match plane with | None -> // Incoming ray is directly along the normal - Ray.flip incomingRay + Ray.flip incomingLight.Ray |> Ray.parallelTo strikePoint - |> Some | Some 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 - let normalComponent = - UnitVector.dot plane.V1 (Ray.vector incomingRay) - let tangentComponent = (UnitVector.dot plane.V2 (Ray.vector incomingRay)) + let normalComponent = - UnitVector.dot plane.V1 (Ray.vector incomingLight.Ray) + let tangentComponent = (UnitVector.dot plane.V2 (Ray.vector incomingLight.Ray)) let dest = Ray.walkAlong (Ray.make (Ray.walkAlong (Ray.make plane.Point plane.V1) normalComponent) plane.V2) tangentComponent Point.differenceToThenFrom dest strikePoint |> Ray.make' strikePoint + // This is safe: it's actually a logic error for this to fail. + |> Option.get - let outgoing = - match outgoing, fuzz with - | None, _ -> None - | Some outgoing, None -> Some outgoing - | Some outgoing, Some (fuzz, rand) -> + match fuzz with + | None -> outgoing + | Some (fuzz, rand) -> + let mutable answer = Unchecked.defaultof<_> + while obj.ReferenceEquals (answer, null) do let offset = UnitVector.random rand (Point.dimension centre) let sphereCentre = Ray.walkAlong outgoing 1.0 let target = Ray.walkAlong (Ray.make sphereCentre offset) (fuzz / 1.0) - Point.differenceToThenFrom target strikePoint - |> Ray.make' strikePoint + let exitPoint = + Point.differenceToThenFrom target strikePoint + |> Ray.make' strikePoint + match exitPoint with + | None -> () + | Some o -> + answer <- o + answer - let darkened = - Pixel.combine incomingColour colour - |> Pixel.darken albedo - outgoing, darkened + 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 incomingSin = sqrt (1.0 - incomingCos * incomingCos) + 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 + + else + let outgoingCos = sqrt (1.0 - outgoingSin * outgoingSin) + let outgoingPoint = + Ray.walkAlong (Ray.make (Ray.walkAlong normal (-outgoingCos)) plane.V2) outgoingSin + + Point.differenceToThenFrom outgoingPoint strikePoint + |> Ray.make' strikePoint + // 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. + |> Option.get match style with | SphereStyle.LightSource colour -> - None, Pixel.combine incomingColour colour + Absorbs (Pixel.combine incomingLight.Colour colour) | SphereStyle.LightSourceCap colour -> let circleCentreZCoord = Point.xCoordinate centre let zCoordLowerBound = circleCentreZCoord + (radius - (radius / 4.0)) @@ -128,55 +147,77 @@ module Sphere = let colour = match Float.compare strikeZCoord zCoordLowerBound with | Greater -> - Pixel.combine colour incomingColour + Pixel.combine colour incomingLight.Colour | _ -> Colour.Black - None, colour + Absorbs colour | SphereStyle.LambertReflection (albedo, colour, rand) -> let outgoing = let sphereCentre = Ray.walkAlong normal 1.0 - let offset = UnitVector.random rand (Point.dimension sphereCentre) - let target = Ray.walkAlong (Ray.make sphereCentre offset) 1.0 - Point.differenceToThenFrom target strikePoint - |> Ray.make' strikePoint + 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 + | Some o -> answer <- o + | None -> () + answer let newColour = - Pixel.combine incomingColour colour + Pixel.combine incomingLight.Colour colour |> Pixel.darken albedo - outgoing, newColour + Continues { Ray = outgoing ; Colour = newColour } | SphereStyle.PureReflection (albedo, colour) -> - fuzzedReflection colour albedo None - | SphereStyle.FuzzedReflection (albedo, colour, fuzz, random) -> - fuzzedReflection colour albedo (Some (fuzz, random)) + let darkened = + Pixel.combine incomingLight.Colour colour + |> Pixel.darken albedo - | SphereStyle.Dielectric (albedo, colour, index, reflectionProb, random) -> + Continues { Ray = fuzzedReflection None ; Colour = darkened } + + | SphereStyle.FuzzedReflection (albedo, colour, fuzz, random) -> + let darkened = + Pixel.combine incomingLight.Colour colour + |> Pixel.darken albedo + + Continues { Ray = fuzzedReflection (Some (fuzz, random)) ; Colour = darkened } + + | SphereStyle.Dielectric (albedo, colour, sphereRefractance, refractionProb, random) -> let newColour = - Pixel.combine incomingColour colour + Pixel.combine incomingLight.Colour colour |> Pixel.darken albedo let rand = random.Get () + + if LanguagePrimitives.FloatWithMeasure rand > refractionProb then + // reflect! + Continues { Ray = fuzzedReflection None ; Colour = newColour } + else + let incomingCos = UnitVector.dot (UnitVector.flip (Ray.vector incomingLight.Ray)) (Ray.vector normal) + Continues { Ray = refract incomingCos sphereRefractance ; Colour = newColour } + + | SphereStyle.Glass (albedo, colour, sphereRefractance, random) -> + let newColour = + Pixel.combine incomingLight.Colour colour + |> Pixel.darken albedo + + let incomingCos = UnitVector.dot (Ray.vector normal) (UnitVector.flip (Ray.vector incomingLight.Ray)) + + let rand = random.Get () + let reflectionProb = + 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 // reflect! - fuzzedReflection colour albedo None + Continues { Ray = fuzzedReflection None ; Colour = newColour } else - let index = if inside then 1.0/index else index / 1.0 - let plane = Plane.makeSpannedBy normal incomingRay - let incomingCos = UnitVector.dot (Ray.vector incomingRay) (Ray.vector normal) - let incomingSin = sqrt (1.0 - incomingCos * incomingCos) - let outgoingSin = index * incomingSin - 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 colour albedo None - - else - let outgoingCos = sqrt (1.0 - outgoingSin * outgoingSin) - let outgoingPoint = - Ray.walkAlong (Ray.make (Ray.walkAlong normal (-outgoingCos)) plane.V2) outgoingSin - let outgoing = Point.differenceToThenFrom outgoingPoint strikePoint |> Ray.make' strikePoint |> Option.get - - Some outgoing, newColour + Continues { Ray = refract incomingCos sphereRefractance ; Colour = newColour } let make (style : SphereStyle) (centre : Point) (radius : float) : Sphere = {