From ca98b72d4aedc34c29fd7fc8d1b99136c0243b39 Mon Sep 17 00:00:00 2001 From: Patrick Stevens Date: Sun, 18 Apr 2021 23:11:45 +0100 Subject: [PATCH] Bounding boxes (#5) --- RayTracing.App/SampleImages.fs | 211 ++++++++++++------------- RayTracing.Test/RayTracing.Test.fsproj | 1 + RayTracing.Test/TestBoundingBox.fs | 81 ++++++++++ RayTracing/BoundingBox.fs | 99 ++++++++++++ RayTracing/BoundingBoxTree.fs | 39 +++++ RayTracing/Camera.fs | 3 + RayTracing/Hittable.fs | 38 +++++ RayTracing/Point.fs | 16 +- RayTracing/Ray.fs | 13 +- RayTracing/Ray.fsi | 12 +- RayTracing/RayTracing.fsproj | 3 + RayTracing/Scene.fs | 145 ++++++++--------- RayTracing/Sphere.fs | 8 +- 13 files changed, 466 insertions(+), 203 deletions(-) create mode 100644 RayTracing.Test/TestBoundingBox.fs create mode 100644 RayTracing/BoundingBox.fs create mode 100644 RayTracing/BoundingBoxTree.fs create mode 100644 RayTracing/Hittable.fs diff --git a/RayTracing.App/SampleImages.fs b/RayTracing.App/SampleImages.fs index 6edbf88..a3d70a4 100644 --- a/RayTracing.App/SampleImages.fs +++ b/RayTracing.App/SampleImages.fs @@ -12,6 +12,7 @@ type SampleImages = | TotalRefraction | GlassSphere | MovedCamera + static member Parse (s : string) = match s with | "spheres" -> SampleImages.Spheres @@ -54,13 +55,11 @@ module SampleImages = let camera = 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 = - [| - Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 0uy ; Green = 255uy ; Blue = 255uy }) (Point.make 1.5 0.5 8.0) 0.5) - 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 - |] - } + [| + Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 0uy ; Green = 255uy ; Blue = 255uy }) (Point.make 1.5 0.5 8.0) 0.5) + 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.make |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera let fuzzyPlane (progressIncrement : float -> unit) (log : string -> unit) : float * Image = @@ -70,13 +69,11 @@ module SampleImages = let camera = 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 = - [| - Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 0uy ; Green = 255uy ; Blue = 255uy }) (Point.make 1.5 0.5 8.0) 0.5) - 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 - |] - } + [| + Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Red = 0uy ; Green = 255uy ; Blue = 255uy }) (Point.make 1.5 0.5 8.0) 0.5) + 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.make |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera let spheres (progressIncrement : float -> unit) (log : string -> unit) : float * Image = @@ -88,27 +85,25 @@ module SampleImages = let camera = 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 = - [| - Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.95, { Red = 255uy ; Green = 255uy ; Blue = 0uy }, random1)) (Point.make 0.0 0.0 9.0) 1.0) - Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0, { Red = 0uy ; Green = 255uy ; Blue = 255uy })) (Point.make 1.5 0.5 8.0) 0.5) - Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Colour.White with Red = 200uy ; Green = 220uy } ) (Point.make -1.5 1.0 8.0) 0.5) - Hittable.Sphere (Sphere.make (SphereStyle.FuzzedReflection (1.0, { Red = 255uy ; Green = 100uy ; Blue = 0uy }, 0.2, random2) ) (Point.make -0.4 1.5 10.0) 0.25) + [| + Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.95, { Red = 255uy ; Green = 255uy ; Blue = 0uy }, random1)) (Point.make 0.0 0.0 9.0) 1.0) + Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0, { Red = 0uy ; Green = 255uy ; Blue = 255uy })) (Point.make 1.5 0.5 8.0) 0.5) + Hittable.Sphere (Sphere.make (SphereStyle.LightSource { Colour.White with Red = 200uy ; Green = 220uy } ) (Point.make -1.5 1.0 8.0) 0.5) + Hittable.Sphere (Sphere.make (SphereStyle.FuzzedReflection (1.0, { Red = 255uy ; Green = 100uy ; Blue = 0uy }, 0.2, random2) ) (Point.make -0.4 1.5 10.0) 0.25) - // Left side mirror - Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.PureReflection (0.8, Colour.White)) (Point.make 0.0 0.0 12.0) (Vector.make 1.0 0.0 -1.0 |> Vector.unitise |> Option.get)) + // Left side mirror + Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.PureReflection (0.8, Colour.White)) (Point.make 0.0 0.0 12.0) (Vector.make 1.0 0.0 -1.0 |> Vector.unitise |> Option.get)) - // Floor rug - Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.FuzzedReflection (0.85, { Red = 255uy ; Green = 100uy ; Blue = 100uy }, 0.8, random3)) (Point.make 0.0 -1.0 0.0) (Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get)) + // Floor rug + Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.FuzzedReflection (0.85, { Red = 255uy ; Green = 100uy ; Blue = 100uy }, 0.8, random3)) (Point.make 0.0 -1.0 0.0) (Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get)) - // Right side mirror - Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.PureReflection (0.95, Colour.White)) (Point.make 0.0 0.0 12.0) (Vector.make -1.0 0.0 -1.0 |> Vector.unitise |> Option.get)) + // Right side mirror + Hittable.InfinitePlane (InfinitePlane.make (InfinitePlaneStyle.PureReflection (0.95, Colour.White)) (Point.make 0.0 0.0 12.0) (Vector.make -1.0 0.0 -1.0 |> Vector.unitise |> Option.get)) - // Light pad behind us - 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)) - |] - } + // Light pad behind us + 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.make |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera let insideSphere (progressIncrement : float -> unit) (log : string -> unit) : float * Image = @@ -121,23 +116,20 @@ module SampleImages = let camera = 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 = - [| - Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.95, { Red = 255uy ; Green = 255uy ; Blue = 0uy }, random1)) (Point.make 0.0 0.0 9.0) 1.0) - Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0, { Red = 0uy ; Green = 255uy ; Blue = 255uy })) (Point.make 1.5 0.5 8.0) 0.5) - Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0, { Red = 255uy ; Green = 20uy ; Blue = 20uy })) (Point.make -1.8 0.8 8.0) 0.5) - Hittable.Sphere (Sphere.make (SphereStyle.LightSource Colour.White) (Point.make -10.0 8.0 0.0) 9.0) - Hittable.Sphere (Sphere.make (SphereStyle.FuzzedReflection (1.0, { Red = 255uy ; Green = 100uy ; Blue = 0uy }, 0.2, random2) ) (Point.make 1.4 1.5 10.0) 0.25) - Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (0.9, { Red = 255uy ; Green = 255uy ; Blue = 255uy })) (Point.make 0.0 10.0 20.0) 8.0) + [| + Hittable.Sphere (Sphere.make (SphereStyle.LambertReflection (0.95, { Red = 255uy ; Green = 255uy ; Blue = 0uy }, random1)) (Point.make 0.0 0.0 9.0) 1.0) + Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0, { Red = 0uy ; Green = 255uy ; Blue = 255uy })) (Point.make 1.5 0.5 8.0) 0.5) + Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (1.0, { Red = 255uy ; Green = 20uy ; Blue = 20uy })) (Point.make -1.8 0.8 8.0) 0.5) + Hittable.Sphere (Sphere.make (SphereStyle.LightSource Colour.White) (Point.make -10.0 8.0 0.0) 9.0) + Hittable.Sphere (Sphere.make (SphereStyle.FuzzedReflection (1.0, { Red = 255uy ; Green = 100uy ; Blue = 0uy }, 0.2, random2) ) (Point.make 1.4 1.5 10.0) 0.25) + Hittable.Sphere (Sphere.make (SphereStyle.PureReflection (0.9, { Red = 255uy ; Green = 255uy ; Blue = 255uy })) (Point.make 0.0 10.0 20.0) 8.0) - 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.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)) + |] + |> Scene.make |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera let totalRefraction (progressIncrement : float -> unit) (log : string -> unit) : float * Image = @@ -149,52 +141,47 @@ module SampleImages = 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 = 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) + [| + // 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.Dielectric (1.0, Colour.White, 1.5, 1.0, random3)) (Point.make -1.0 0.0 1.0) 0.5) + // 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.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) - |] - } + // 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.make |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera let glassSphere (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 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, { Red = 204uy ; Green = 204uy ; Blue = 0uy }, random1)) (Point.make 0.0 -100.5 1.0) 100.0) + [| + // Floor + Hittable.UnboundedSphere (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) + // 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) - // 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) - |] - } + // Light around us + Hittable.UnboundedSphere (Sphere.make (SphereStyle.LightSource { Red = 80uy ; Green = 80uy ; Blue = 150uy }) (Point.make 0.0 0.0 0.0) 200.0) + |] + |> Scene.make |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera let movedCamera (progressIncrement : float -> unit) (log : string -> unit) : float * Image = @@ -207,24 +194,22 @@ module SampleImages = let camera = 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 }, random1)) (Point.make 0.0 -100.5 1.0) 100.0) + [| + // 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 (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) + // 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 (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) - |] - } + // 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) + |] + |> Scene.make |> Scene.render progressIncrement log (aspectRatio * (float pixels) |> int) pixels camera let randomSpheres (progressIncrement : float -> unit) (log : string -> unit) : float * Image = @@ -247,42 +232,56 @@ module SampleImages = 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 + yield + Sphere.make (SphereStyle.LambertReflection (albedo, Colour.random rand, floatProducer)) centre 0.2 + |> Hittable.Sphere 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 + yield + Sphere.make (SphereStyle.FuzzedReflection (albedo, Colour.random rand, fuzz, floatProducer)) centre 0.2 + |> Hittable.Sphere else // glass - yield Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.5, floatProducer)) centre 0.2 + yield + Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.5, floatProducer)) centre 0.2 + |> Hittable.Sphere 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 + yield + Sphere.make (SphereStyle.Glass (1.0, Colour.White, 1.5, floatProducer)) (Point.make 0.0 1.0 0.0) 1.0 + |> Hittable.Sphere 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.LambertReflection (1.0, { Red = 80uy ; Green = 40uy ; Blue = 20uy }, floatProducer)) (Point.make -4.0 1.0 0.0) 1.0 + |> Hittable.Sphere - yield Sphere.make (SphereStyle.PureReflection (1.0, { Red = 180uy ; Green = 150uy ; Blue = 128uy })) (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 + |> Hittable.Sphere // Ceiling - yield Sphere.make (SphereStyle.LightSource { Colour.White with Red = 200uy ; Green = 200uy }) (Point.make 0.0 0.0 0.0) 2000.0 + yield + Sphere.make (SphereStyle.LightSource { Colour.White with Red = 200uy ; Green = 200uy }) (Point.make 0.0 0.0 0.0) 2000.0 + |> Hittable.UnboundedSphere // 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 + yield + Sphere.make (SphereStyle.LambertReflection (0.5, Colour.White, floatProducer)) (Point.make 0.0 -1000.0 0.0) 1000.0 + |> Hittable.UnboundedSphere |] - { - Objects = spheres |> Array.map Hittable.Sphere - } + spheres + |> Scene.make |> 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 diff --git a/RayTracing.Test/RayTracing.Test.fsproj b/RayTracing.Test/RayTracing.Test.fsproj index f406e0f..202cb84 100644 --- a/RayTracing.Test/RayTracing.Test.fsproj +++ b/RayTracing.Test/RayTracing.Test.fsproj @@ -14,6 +14,7 @@ + diff --git a/RayTracing.Test/TestBoundingBox.fs b/RayTracing.Test/TestBoundingBox.fs new file mode 100644 index 0000000..cebfde9 --- /dev/null +++ b/RayTracing.Test/TestBoundingBox.fs @@ -0,0 +1,81 @@ +namespace RayTracing.Test + +open FsCheck +open RayTracing +open NUnit.Framework +open FsUnitTyped + +[] +module TestBoundingBox = + + let delta = 0.00000001 + + let sort (x1 : float) (x2 : float) = + min x1 x2, if x1 = x2 then x1 + (delta / 2.0) else max x1 x2 + + [] + [] + let ``Bounding box on the left doesn't intersect ray to the right`` (negate : bool) = + let ray = + Ray.make (Point.make ((if negate then (fun x -> -x) else id) delta) 0.0 0.0) (Vector.make (if negate then -1.0 else 1.0) 0.0 0.0 |> Vector.unitise |> Option.get) + + let property (x : NormalFloat) (y : NormalFloat) (z : NormalFloat) (x' : NormalFloat) (y' : NormalFloat) (z' : NormalFloat) : bool = + let x1, x2 = sort (if negate then abs x.Get else -abs x.Get) (if negate then abs x'.Get else -abs x'.Get) + let y1, y2 = sort y.Get y'.Get + let z1, z2 = sort z.Get z'.Get + let box = BoundingBox.make (Point.make x1 y1 z1) (Point.make x2 y2 z2) + BoundingBox.hits (BoundingBox.inverseDirections ray) ray box = false + + Check.QuickThrowOnFailure property + + [] + [] + let ``Bounding box on the top doesn't intersect ray to the bottom`` (negate : bool) = + let ray = + Ray.make (Point.make 0.0 ((if negate then (fun x -> -x) else id) delta) 0.0) (Vector.make 0.0 (if negate then -1.0 else 1.0) 0.0 |> Vector.unitise |> Option.get) + + let property (x : NormalFloat) (y : NormalFloat) (z : NormalFloat) (x' : NormalFloat) (y' : NormalFloat) (z' : NormalFloat) : bool = + let y1, y2 = sort (if negate then abs y.Get else -abs y.Get) (if negate then abs y'.Get else -abs y'.Get) + let x1, x2 = sort x.Get x'.Get + let z1, z2 = sort z.Get z'.Get + let box = BoundingBox.make (Point.make x1 y1 z1) (Point.make x2 y2 z2) + BoundingBox.hits (BoundingBox.inverseDirections ray) ray box = false + + Check.QuickThrowOnFailure property + + [] + let ``Bounding box forward, ray going backward, case 1`` () = + let ray = + Ray.make (Point.make 0.0 0.0 delta) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) + + let z1, z2 = sort (-abs 0.0) (-abs 0.0) + let x1, x2 = sort 0.0 0.0 + let y1, y2 = sort 0.0 1.0 + let box = BoundingBox.make (Point.make x1 y1 z1) (Point.make x2 y2 z2) + let result = BoundingBox.hits (BoundingBox.inverseDirections ray) ray box + result |> shouldEqual false + + [] + [] + let ``Bounding box forward doesn't intersect ray going backward`` (negate : bool) = + let ray = + Ray.make (Point.make 0.0 0.0 ((if negate then (fun x -> -x) else id) delta)) (Vector.make 0.0 0.0 (if negate then -1.0 else 1.0) |> Vector.unitise |> Option.get) + + let property (x : NormalFloat) (y : NormalFloat) (z : NormalFloat) (x' : NormalFloat) (y' : NormalFloat) (z' : NormalFloat) : bool = + let z1, z2 = sort (if negate then abs z.Get else -abs z.Get) (if negate then abs z'.Get else -abs z'.Get) + let x1, x2 = sort x.Get x'.Get + let y1, y2 = sort y.Get y'.Get + let box = BoundingBox.make (Point.make x1 y1 z1) (Point.make x2 y2 z2) + let result = BoundingBox.hits (BoundingBox.inverseDirections ray) ray box + result = false + + Check.QuickThrowOnFailure property + + [] + let ``Bounding box forward does intersect ray going forward`` () = + 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 box = BoundingBox.make (Point.make -1.0 -1.0 -1.0) (Point.make 1.0 1.0 1.0) + + BoundingBox.hits (BoundingBox.inverseDirections ray) ray box |> shouldEqual true \ No newline at end of file diff --git a/RayTracing/BoundingBox.fs b/RayTracing/BoundingBox.fs new file mode 100644 index 0000000..42acf1b --- /dev/null +++ b/RayTracing/BoundingBox.fs @@ -0,0 +1,99 @@ +namespace RayTracing + +[] +type BoundingBox = + { + Min : Point + Max : Point + } + +[] +module BoundingBox = + + let volume (box : BoundingBox) = + (Point.coordinate 0 box.Max - Point.coordinate 0 box.Min) * + (Point.coordinate 1 box.Max - Point.coordinate 1 box.Min) * + (Point.coordinate 2 box.Max - Point.coordinate 2 box.Min) + + let make (min : Point) (max : Point) = + { + Min = min + Max = max + } + + + let inverseDirections (ray : Ray) = + struct(1.0 / (Ray.vector ray |> UnitVector.coordinate 0), 1.0 / (Ray.vector ray |> UnitVector.coordinate 1), 1.0 / (Ray.vector ray |> UnitVector.coordinate 2)) + + let hits (struct(invX, invY, invZ)) { Ray.Origin = Point (x, y, z) ; Vector = UnitVector (Vector (dx, dy, dz))} (box : BoundingBox) : bool = + // The line is (x, y, z) + t (dx, dy, dz) + // The line goes through the cuboid iff it passes through the interval in each component: + // there is t such that boxMin.X <= x + t dx <= boxMax.X, + // and moreover the acceptable t brackets all overlap. + // That is, + // boxMin.X - x <= t dx <= boxMax.X - x + let mutable tMin = -infinity + let mutable tMax = infinity + + let bailOut = + let mutable t0 = (Point.coordinate 0 box.Min - x) * invX + let mutable t1 = (Point.coordinate 0 box.Max - x) * invX + if invX < 0.0 then + let tmp = t1 + t1 <- t0 + t0 <- tmp + + tMin <- if t0 > tMin then t0 else tMin + tMax <- if t1 < tMax then t1 else tMax + + tMax < tMin || 0.0 >= tMax + + if bailOut then false else + + let bailOut = + let mutable t0 = (Point.coordinate 1 box.Min - y) * invY + let mutable t1 = (Point.coordinate 1 box.Max - y) * invY + + if invY < 0.0 then + let tmp = t1 + t1 <- t0 + t0 <- tmp + + tMin <- if t0 > tMin then t0 else tMin + tMax <- if t1 < tMax then t1 else tMax + + tMax < tMin || 0.0 >= tMax + + if bailOut then false else + + let mutable t0 = (Point.coordinate 2 box.Min - z) * invZ + let mutable t1 = (Point.coordinate 2 box.Max - z) * invZ + + if invZ < 0.0 then + let tmp = t1 + t1 <- t0 + t0 <- tmp + + tMin <- if t0 > tMin then t0 else tMin + tMax <- if t1 < tMax then t1 else tMax + tMax >= tMin && tMax >= 0.0 + + let mergeTwo (i : BoundingBox) (j : BoundingBox) : BoundingBox = + { + Min = + Point.make + (min (Point.coordinate 0 i.Min) (Point.coordinate 0 j.Min)) + (min (Point.coordinate 1 i.Min) (Point.coordinate 1 j.Min)) + (min (Point.coordinate 2 i.Min) (Point.coordinate 2 j.Min)) + Max = + Point.make + (max (Point.coordinate 0 i.Max) (Point.coordinate 0 j.Max)) + (max (Point.coordinate 1 i.Max) (Point.coordinate 1 j.Max)) + (max (Point.coordinate 2 i.Max) (Point.coordinate 2 j.Max)) + } + + let merge (boxes : BoundingBox []) : BoundingBox option = + if boxes.Length = 0 then None else + boxes + |> Array.reduce mergeTwo + |> Some \ No newline at end of file diff --git a/RayTracing/BoundingBoxTree.fs b/RayTracing/BoundingBoxTree.fs new file mode 100644 index 0000000..bc83125 --- /dev/null +++ b/RayTracing/BoundingBoxTree.fs @@ -0,0 +1,39 @@ +namespace RayTracing + +type BoundingBoxTree = + | Leaf of hittable : Hittable * BoundingBox + | Branch of left : BoundingBoxTree * right : BoundingBoxTree * all : BoundingBox + +[] +module BoundingBoxTree = + let make (boxes : (Hittable * BoundingBox) array) : BoundingBoxTree option = + if boxes.Length = 0 then None else + + let rec go (boxes : (Hittable * BoundingBox) array) = + let boundAll = + BoundingBox.merge (boxes |> Array.map snd) |> Option.get + + if boxes.Length = 1 then Leaf boxes.[0] else + if boxes.Length = 2 then Branch (Leaf boxes.[0], Leaf boxes.[1], boundAll) else + + let choices = + Array.init 3 (fun axis -> + let boxes = + boxes + |> Array.sortBy (fun (_, b) -> Point.coordinate axis b.Min) + let leftHalf = boxes.[0..boxes.Length / 2] + let rightHalf = boxes.[(boxes.Length / 2) + 1..] + let leftBound = leftHalf |> Array.map snd |> BoundingBox.merge |> Option.get + let rightBound = rightHalf |> Array.map snd |> BoundingBox.merge |> Option.get + (leftHalf, leftBound), (rightHalf, rightBound) + ) + let (leftHalf, _), (rightHalf, _) = + choices + |> Array.minBy (fun ((_, leftBound), (_, rightBound)) -> + (BoundingBox.volume leftBound) + (BoundingBox.volume rightBound) + ) + + Branch (go leftHalf, go rightHalf, boundAll) + + go boxes + |> Some diff --git a/RayTracing/Camera.fs b/RayTracing/Camera.fs index 48d9b07..a3768d6 100644 --- a/RayTracing/Camera.fs +++ b/RayTracing/Camera.fs @@ -23,6 +23,8 @@ type Camera = FocalLength : float /// How many samples will we take per pixel, for anti-aliasing? SamplesPerPixel : int + /// How many bounces before we consider ourselves to have lost track of a light ray? + BounceDepth : int } [] @@ -53,4 +55,5 @@ module Camera = ViewportXAxis = xAxis ViewportYAxis = yAxis SamplesPerPixel = samplesPerPixel + BounceDepth = 150 } \ No newline at end of file diff --git a/RayTracing/Hittable.fs b/RayTracing/Hittable.fs new file mode 100644 index 0000000..97fde85 --- /dev/null +++ b/RayTracing/Hittable.fs @@ -0,0 +1,38 @@ +namespace RayTracing + +type Hittable = + | Sphere of Sphere + | UnboundedSphere of Sphere + | InfinitePlane of InfinitePlane + + member this.Reflection (incoming : LightRay) (strikePoint : Point) = + match this with + | Sphere s + | UnboundedSphere s -> s.Reflection incoming strikePoint + | InfinitePlane p -> p.Reflection incoming strikePoint + + member this.BoundingBox : BoundingBox option = + match this with + | Sphere s -> Sphere.boundingBox s |> Some + | UnboundedSphere _ + | InfinitePlane _ -> None + +[] +module Hittable = + + let inline boundingBox (h : Hittable) = h.BoundingBox + + /// Returns the distance we must walk along this ray before we first hit an object, the + /// colour the resulting light ray is after the interaction, and the new ray. + let hits + (ray : Ray) + (h : Hittable) + : float voption + = + match h with + | UnboundedSphere s + | Sphere s -> + Sphere.firstIntersection s ray + | InfinitePlane plane -> + InfinitePlane.intersection plane ray + diff --git a/RayTracing/Point.fs b/RayTracing/Point.fs index acb3537..941f050 100644 --- a/RayTracing/Point.fs +++ b/RayTracing/Point.fs @@ -6,12 +6,10 @@ open System.Runtime.CompilerServices /// 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) [] @@ -80,10 +78,22 @@ module UnitVector = Vector (0.0, 0.0, 1.0) |> UnitVector |] + let inline coordinate (i : int) (UnitVector (Vector (a, b, c))) : float = + match i with + | 0 -> a + | 1 -> b + | 2 -> c + | _ -> failwithf "Bad coordinate: %i" i + [] module Point = - let xCoordinate (Point (x, _, _)) = x + let inline coordinate (i : int) (Point (x, y, z)) = + match i with + | 0 -> x + | 1 -> y + | 2 -> z + | _ -> failwithf "Bad coordinate: %i" i let sum (Point (a, b, c)) (Point (x, y, z)) : Point = Point (a + x, b + y, c + z) diff --git a/RayTracing/Ray.fs b/RayTracing/Ray.fs index 98f3f0c..f07db13 100644 --- a/RayTracing/Ray.fs +++ b/RayTracing/Ray.fs @@ -1,11 +1,10 @@ namespace RayTracing type Ray = - private - { - Origin : Point - Vector : UnitVector - } + { + Origin : Point + Vector : UnitVector + } [] module Ray = @@ -47,8 +46,8 @@ module Ray = Float.equal t t3 else false - let vector r = r.Vector - let origin r = r.Origin + let inline vector r = r.Vector + let inline origin r = r.Origin let flip (r : Ray) = { diff --git a/RayTracing/Ray.fsi b/RayTracing/Ray.fsi index 744c69b..f5add64 100644 --- a/RayTracing/Ray.fsi +++ b/RayTracing/Ray.fsi @@ -1,6 +1,12 @@ namespace RayTracing -type Ray +type Ray = + { + /// For performance reasons, this is public, but please don't use it + Origin : Point + /// For performance reasons, this is public, but please don't use it + Vector : UnitVector + } [] module Ray = @@ -13,7 +19,7 @@ module Ray = val liesOn : Point -> Ray -> bool - val vector : Ray -> UnitVector - val origin : Ray -> Point + val inline vector : Ray -> UnitVector + val inline origin : Ray -> Point val flip : Ray -> Ray \ No newline at end of file diff --git a/RayTracing/RayTracing.fsproj b/RayTracing/RayTracing.fsproj index c7c33a2..404f865 100644 --- a/RayTracing/RayTracing.fsproj +++ b/RayTracing/RayTracing.fsproj @@ -13,10 +13,13 @@ + + + diff --git a/RayTracing/Scene.fs b/RayTracing/Scene.fs index 3f3f7f7..16d1632 100644 --- a/RayTracing/Scene.fs +++ b/RayTracing/Scene.fs @@ -2,93 +2,79 @@ namespace RayTracing open System -type Hittable = - | Sphere of Sphere - | InfinitePlane of InfinitePlane - - member this.Reflection (incoming : LightRay) (strikePoint : Point) = - match this with - | Sphere s -> s.Reflection incoming strikePoint - | InfinitePlane p -> p.Reflection incoming strikePoint - -[] -module Hittable = - /// Returns the distance we must walk along this ray before we first hit an object, the - /// colour the resulting light ray is after the interaction, and the new ray. - let hits - (ray : Ray) - (h : Hittable) - : float voption - = - match h with - | Sphere s -> - Sphere.firstIntersection s ray - | InfinitePlane plane -> - InfinitePlane.intersection plane ray - type Scene = - { - Objects : Hittable array - } + private + { + UnboundedObjects : Hittable array + BoundingBoxes : BoundingBoxTree option + } [] module Scene = + let make (objects : Hittable array) = + let bounded, unbounded = + objects + |> Array.map (fun h -> h, Hittable.boundingBox h) + |> Array.partition (snd >> Option.isSome) + let bounded = bounded |> Array.map (fun (h, box) -> h, Option.get box) + let unbounded = unbounded |> Array.map fst + let tree = + bounded + |> BoundingBoxTree.make + { + UnboundedObjects = unbounded + BoundingBoxes = tree + } + + let rec bestCandidate (inverseDirections : struct(float * float * float)) (ray : Ray) (bestFloat : float) (bestObject : Hittable) (bestLength : float) (box : BoundingBoxTree) : struct(float * Hittable * float) = + match box with + | BoundingBoxTree.Leaf (object, box) -> + if BoundingBox.hits inverseDirections ray box then + match Hittable.hits ray object with + | ValueNone -> struct (bestFloat, bestObject, bestLength) + | ValueSome point -> + let a = point * point + if a < bestFloat then + struct (a, object, point) + else + struct (bestFloat, bestObject, bestLength) + else struct (bestFloat, bestObject, bestLength) + | BoundingBoxTree.Branch (left, right, all) -> + if BoundingBox.hits inverseDirections ray all then + let struct (bestFloat, bestObject, bestLength) = bestCandidate inverseDirections ray bestFloat bestObject bestLength left + bestCandidate inverseDirections ray bestFloat bestObject bestLength right + else struct (bestFloat, bestObject, bestLength) + let hitObject (s : Scene) (ray : Ray) - : (int * Point) option + : (Hittable * Point) option = - let mutable bestIndex = -1 + let mutable best = Unchecked.defaultof<_> let mutable bestLength = nan let mutable bestFloat = infinity - for i in 0..s.Objects.Length - 1 do - match Hittable.hits ray s.Objects.[i] with + + match s.BoundingBoxes with + | None -> () + | Some boundingBoxes -> + let struct(f, o, l) = bestCandidate (BoundingBox.inverseDirections ray) ray bestFloat best bestLength boundingBoxes + bestFloat <- f + best <- o + bestLength <- l + + for i in s.UnboundedObjects do + match Hittable.hits ray i with | ValueNone -> () | ValueSome point -> let a = point * point - match Float.compare a bestFloat with - | Less -> + if Float.compare a bestFloat = Less then bestFloat <- a - bestIndex <- i + best <- i bestLength <- point - | _ -> () 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 + Some (best, Ray.walkAlong ray bestLength) let internal traceRay (maxCount : int) @@ -106,8 +92,8 @@ module Scene = | None -> // Ray goes off into the distance and is never heard from again Colour.Black - | Some (objectNumber, strikePoint) -> - let outgoingRay = scene.Objects.[objectNumber].Reflection ray strikePoint + | Some (object, strikePoint) -> + let outgoingRay = object.Reflection ray strikePoint match outgoingRay with | Absorbs colour -> colour @@ -118,7 +104,7 @@ module Scene = /// Trace a ray to this one pixel, updating the PixelStats with the result. /// n.b. not thread safe - let private traceOnce (print : string -> unit) (scene : Scene) (rand : FloatProducer) (camera : Camera) (maxWidthCoord : int) (maxHeightCoord : int) row col stats = + let private traceOnce (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 @@ -134,15 +120,10 @@ module Scene = |> Option.get // 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." + let result = traceRay camera.BounceDepth scene { Ray = ray ; Colour = Colour.White } PixelStats.add result stats - let renderPixel (print : string -> unit) (scene : Scene) (rand : FloatProducer) (camera : Camera) maxWidthCoord maxHeightCoord row col = + let renderPixel (_ : 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. @@ -151,12 +132,12 @@ module Scene = let firstTrial = min 5 (camera.SamplesPerPixel / 2) for _ in 0..firstTrial do - traceOnce print scene rand camera maxWidthCoord maxHeightCoord row col stats + traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats let oldMean = PixelStats.mean stats for _ in 1..firstTrial do - traceOnce print scene rand camera maxWidthCoord maxHeightCoord row col stats + traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats let newMean = PixelStats.mean stats let difference = Pixel.difference newMean oldMean @@ -168,7 +149,7 @@ module Scene = else for _ in 1..(camera.SamplesPerPixel - 2 * firstTrial - 1) do - traceOnce print scene rand camera maxWidthCoord maxHeightCoord row col stats + traceOnce scene rand camera maxWidthCoord maxHeightCoord row col stats PixelStats.mean stats diff --git a/RayTracing/Sphere.fs b/RayTracing/Sphere.fs index 60bbc75..7d47ffe 100644 --- a/RayTracing/Sphere.fs +++ b/RayTracing/Sphere.fs @@ -17,6 +17,7 @@ type Sphere = /// what colour ray does it output and in what direction? Reflection : LightRay -> Point -> LightDestination RadiusSquared : float + BoundingBox : BoundingBox } type SphereStyle = @@ -152,9 +153,9 @@ module Sphere = | SphereStyle.LightSource colour -> Absorbs (Pixel.combine incomingLight.Colour colour) | SphereStyle.LightSourceCap colour -> - let circleCentreZCoord = Point.xCoordinate centre + let circleCentreZCoord = Point.coordinate 0 centre let zCoordLowerBound = circleCentreZCoord + (radius - (radius / 4.0)) - let strikeZCoord = Point.xCoordinate strikePoint + let strikeZCoord = Point.coordinate 0 strikePoint let colour = match Float.compare strikeZCoord zCoordLowerBound with | Greater -> @@ -238,8 +239,11 @@ module Sphere = Radius = radius Reflection = reflection style centre radius radiusSquared (Float.compare radius 0.0 = Less) RadiusSquared = radiusSquared + BoundingBox = BoundingBox.make (Point.sum centre (Point.make -radius -radius -radius)) (Point.sum centre (Point.make radius radius radius)) } + let boundingBox (s : Sphere) = s.BoundingBox + let liesOn (point : Point) (sphere : Sphere) : bool = liesOn' sphere.Centre sphere.Radius point