patrick/ray-tracing-fsharp
1
0
Fork 0
mirror of https://github.com/Smaug123/ray-tracing-fsharp synced 2025-10-10 06:18:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Use ValueOption instead of Option (#11)

Browse Source
This commit is contained in:
Patrick Stevens
2023-01-07 10:55:49 +00:00
committed by GitHub
parent 1009d7d468
commit a07ff8f852
16 changed files with 87 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
RayTracing.App/SampleImages.fs
View File

@@ -64,7 +64,7 @@ module SampleImages =
2.0 2.0
aspectRatio aspectRatio
origin origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 400 let pixels = 400
@@ -87,7 +87,7 @@ module SampleImages =
InfinitePlane.make InfinitePlane.make
(InfinitePlaneStyle.PureReflection (0.5<albedo>, Colour.White)) (InfinitePlaneStyle.PureReflection (0.5<albedo>, Colour.White))
(Point.make 0.0 -1.0 0.0) (Point.make 0.0 -1.0 0.0)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0 |> Vector.unitise |> ValueOption.get)
) // Floor rug ) // Floor rug
|] |]
|> Scene.make |> Scene.make
@@ -104,7 +104,7 @@ module SampleImages =
2.0 2.0
aspectRatio aspectRatio
origin origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 400 let pixels = 400
@@ -127,7 +127,7 @@ module SampleImages =
InfinitePlane.make InfinitePlane.make
(InfinitePlaneStyle.FuzzedReflection (1.0<albedo>, Colour.White, 0.75<fuzz>, random)) (InfinitePlaneStyle.FuzzedReflection (1.0<albedo>, Colour.White, 0.75<fuzz>, random))
(Point.make 0.0 -1.0 0.0) (Point.make 0.0 -1.0 0.0)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0 |> Vector.unitise |> ValueOption.get)
) // Floor rug ) // Floor rug
|] |]
|> Scene.make |> Scene.make
@@ -146,7 +146,7 @@ module SampleImages =
7.0 7.0
aspectRatio aspectRatio
origin origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 200 let pixels = 200
@@ -215,7 +215,7 @@ module SampleImages =
InfinitePlane.make InfinitePlane.make
(InfinitePlaneStyle.PureReflection (0.8<albedo>, Colour.White)) (InfinitePlaneStyle.PureReflection (0.8<albedo>, Colour.White))
(Point.make 0.0 0.0 12.0) (Point.make 0.0 0.0 12.0)
(Vector.make 1.0 0.0 -1.0 |> Vector.unitise |> Option.get) (Vector.make 1.0 0.0 -1.0 |> Vector.unitise |> ValueOption.get)
) )
// Floor rug // Floor rug
@@ -232,7 +232,7 @@ module SampleImages =
random3 random3
)) ))
(Point.make 0.0 -1.0 0.0) (Point.make 0.0 -1.0 0.0)
(Vector.make 0.0 1.0 0.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 1.0 0.0 |> Vector.unitise |> ValueOption.get)
) )
// Right side mirror // Right side mirror
@@ -240,7 +240,7 @@ module SampleImages =
InfinitePlane.make InfinitePlane.make
(InfinitePlaneStyle.PureReflection (0.95<albedo>, Colour.White)) (InfinitePlaneStyle.PureReflection (0.95<albedo>, Colour.White))
(Point.make 0.0 0.0 12.0) (Point.make 0.0 0.0 12.0)
(Vector.make -1.0 0.0 -1.0 |> Vector.unitise |> Option.get) (Vector.make -1.0 0.0 -1.0 |> Vector.unitise |> ValueOption.get)
) )
// Light pad behind us // Light pad behind us
@@ -255,7 +255,7 @@ module SampleImages =
} }
)) ))
(Point.make 0.0 1.0 -1.0) (Point.make 0.0 1.0 -1.0)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
) )
|] |]
|> Scene.make |> Scene.make
@@ -275,7 +275,7 @@ module SampleImages =
7.0 7.0
aspectRatio aspectRatio
origin origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 1200 let pixels = 1200
@@ -402,7 +402,7 @@ module SampleImages =
} }
)) ))
(Point.make 0.0 0.0 -5.0) (Point.make 0.0 0.0 -5.0)
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
) )
|] |]
|> Scene.make |> Scene.make
@@ -421,7 +421,7 @@ module SampleImages =
1.0 1.0
aspectRatio aspectRatio
origin origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 300 let pixels = 300
@@ -514,7 +514,7 @@ module SampleImages =
1.0 1.0
aspectRatio aspectRatio
origin origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 200 let pixels = 200
@@ -607,7 +607,7 @@ module SampleImages =
1.0 1.0
aspectRatio aspectRatio
origin origin
(Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 200 let pixels = 200
@@ -721,7 +721,7 @@ module SampleImages =
origin origin
(Point.differenceToThenFrom (Point.make -1.0 0.0 1.0) origin (Point.differenceToThenFrom (Point.make -1.0 0.0 1.0) origin
|> Vector.unitise |> Vector.unitise
|> Option.get) |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 300 let pixels = 300
@@ -819,7 +819,7 @@ module SampleImages =
origin origin
(Point.differenceToThenFrom (Point.make 0.0 0.0 0.0) origin (Point.differenceToThenFrom (Point.make 0.0 0.0 0.0) origin
|> Vector.unitise |> Vector.unitise
|> Option.get) |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 800 let pixels = 800
@@ -969,7 +969,7 @@ module SampleImages =
origin origin
(Point.differenceToThenFrom (Point.make 0.0 0.0 0.0) origin (Point.differenceToThenFrom (Point.make 0.0 0.0 0.0) origin
|> Vector.unitise |> Vector.unitise
|> Option.get) |> ValueOption.get)
(Vector.make 0.0 1.0 0.0) (Vector.make 0.0 1.0 0.0)
let pixels = 400 let pixels = 400

10
RayTracing.Test/TestBoundingBox.fs
View File

@@ -21,7 +21,7 @@ module TestBoundingBox =
(Point.make ((if negate then (fun x -> -x) else id) delta) 0.0 0.0) (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.make (if negate then -1.0 else 1.0) 0.0 0.0
|> Vector.unitise |> Vector.unitise
|> Option.get) |> ValueOption.get)
let property let property
(x : NormalFloat) (x : NormalFloat)
@@ -50,7 +50,7 @@ module TestBoundingBox =
(Point.make 0.0 ((if negate then (fun x -> -x) else id) delta) 0.0) (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.make 0.0 (if negate then -1.0 else 1.0) 0.0
|> Vector.unitise |> Vector.unitise
|> Option.get) |> ValueOption.get)
let property let property
(x : NormalFloat) (x : NormalFloat)
@@ -74,7 +74,7 @@ module TestBoundingBox =
[<Test>] [<Test>]
let ``Bounding box forward, ray going backward, case 1`` () = let ``Bounding box forward, ray going backward, case 1`` () =
let ray = let ray =
Ray.make (Point.make 0.0 0.0 delta) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) Ray.make (Point.make 0.0 0.0 delta) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let z1, z2 = sort (-abs 0.0) (-abs 0.0) let z1, z2 = sort (-abs 0.0) (-abs 0.0)
let x1, x2 = sort 0.0 0.0 let x1, x2 = sort 0.0 0.0
@@ -91,7 +91,7 @@ module TestBoundingBox =
(Point.make 0.0 0.0 ((if negate then (fun x -> -x) else id) delta)) (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.make 0.0 0.0 (if negate then -1.0 else 1.0)
|> Vector.unitise |> Vector.unitise
|> Option.get) |> ValueOption.get)
let property let property
(x : NormalFloat) (x : NormalFloat)
@@ -116,7 +116,7 @@ module TestBoundingBox =
[<Test>] [<Test>]
let ``Bounding box forward does intersect ray going forward`` () = let ``Bounding box forward does intersect ray going forward`` () =
let ray = let ray =
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let box = BoundingBox.make (Point.make -1.0 -1.0 -1.0) (Point.make 1.0 1.0 1.0) let box = BoundingBox.make (Point.make -1.0 -1.0 -1.0) (Point.make 1.0 1.0 1.0)

2
RayTracing.Test/TestPlane.fs
View File

@@ -10,7 +10,7 @@ module TestPlane =
[<Test>] [<Test>]
let ``Orthogonalise does make orthogonal vectors`` () = let ``Orthogonalise does make orthogonal vectors`` () =
let property (p : Plane) : bool = let property (p : Plane) : bool =
let orth = Plane.orthonormalise p |> Option.get let orth = Plane.orthonormalise p |> ValueOption.get
let v1, v2 = Plane.basis (Vector.make 0.0 1.0 0.0) orth let v1, v2 = Plane.basis (Vector.make 0.0 1.0 0.0) orth
let dotVectors = UnitVector.dot (Ray.vector v1) (Ray.vector v2) let dotVectors = UnitVector.dot (Ray.vector v1) (Ray.vector v2)
let v1Length = UnitVector.dot (Ray.vector v1) (Ray.vector v1) let v1Length = UnitVector.dot (Ray.vector v1) (Ray.vector v1)

6
RayTracing.Test/TestSphere.fs
View File

@@ -41,7 +41,7 @@ module TestSphere =
let rand = Random () |> FloatProducer let rand = Random () |> FloatProducer
let ray = let ray =
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let strikePoint = Point.make 0.0 0.0 1.0 let strikePoint = Point.make 0.0 0.0 1.0
@@ -72,7 +72,7 @@ module TestSphere =
let rand = Random () |> FloatProducer let rand = Random () |> FloatProducer
let ray = let ray =
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let strikePoint = Point.make 0.0 0.0 1.0 let strikePoint = Point.make 0.0 0.0 1.0
@@ -103,7 +103,7 @@ module TestSphere =
let rand = Random () |> FloatProducer let rand = Random () |> FloatProducer
let ray = let ray =
Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> Option.get) Ray.make (Point.make 0.0 0.0 0.0) (Vector.make 0.0 0.0 1.0 |> Vector.unitise |> ValueOption.get)
let strikePoint = Point.make 0.0 0.0 1.0 let strikePoint = Point.make 0.0 0.0 1.0

2
RayTracing.Test/TestSphereIntersection.fs
View File

@@ -38,7 +38,7 @@ module TestSphereIntersection =
Ray.make' Ray.make'
(Point.make 1.462205539 -4.888279676 7.123293244) (Point.make 1.462205539 -4.888279676 7.123293244)
(Vector.make -9.549697616 4.400018428 10.41024923) (Vector.make -9.549697616 4.400018428 10.41024923)
|> Option.get |> ValueOption.get
let sphere = let sphere =
Sphere.make Sphere.make

2
RayTracing.Test/TestUtils.fs
View File

@@ -37,7 +37,7 @@ module TestUtils =
vectorGen vectorGen
|> Gen.filter (fun i -> Vector.normSquared i > 0.0) |> Gen.filter (fun i -> Vector.normSquared i > 0.0)
|> Gen.map Vector.unitise |> Gen.map Vector.unitise
|> Gen.map Option.get |> Gen.map ValueOption.get
let rayGen : Gen<Ray> = let rayGen : Gen<Ray> =
gen { gen {

6
RayTracing/BoundingBox.fs
View File

@@ -107,8 +107,8 @@ module BoundingBox =
(max (Point.coordinate 2 i.Max) (Point.coordinate 2 j.Max)) (max (Point.coordinate 2 i.Max) (Point.coordinate 2 j.Max))
} }
let merge (boxes : BoundingBox[]) : BoundingBox option = let merge (boxes : BoundingBox[]) : BoundingBox voption =
if boxes.Length = 0 then if boxes.Length = 0 then
None ValueNone
else else
boxes |> Array.reduce mergeTwo |> Some boxes |> Array.reduce mergeTwo |> ValueSome

12
RayTracing/BoundingBoxTree.fs
View File

@@ -6,13 +6,13 @@ type BoundingBoxTree =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module BoundingBoxTree = module BoundingBoxTree =
let make (boxes : (Hittable * BoundingBox) array) : BoundingBoxTree option = let make (boxes : (Hittable * BoundingBox) array) : BoundingBoxTree voption =
if boxes.Length = 0 then if boxes.Length = 0 then
None ValueNone
else else
let rec go (boxes : (Hittable * BoundingBox) array) = let rec go (boxes : (Hittable * BoundingBox) array) =
let boundAll = BoundingBox.merge (boxes |> Array.map snd) |> Option.get let boundAll = BoundingBox.merge (boxes |> Array.map snd) |> ValueOption.get
if boxes.Length = 1 then if boxes.Length = 1 then
Leaf boxes.[0] Leaf boxes.[0]
@@ -27,8 +27,8 @@ module BoundingBoxTree =
let boxes = boxes |> Array.sortBy (fun (_, b) -> Point.coordinate axis b.Min) let boxes = boxes |> Array.sortBy (fun (_, b) -> Point.coordinate axis b.Min)
let leftHalf = boxes.[0 .. boxes.Length / 2] let leftHalf = boxes.[0 .. boxes.Length / 2]
let rightHalf = boxes.[(boxes.Length / 2) + 1 ..] let rightHalf = boxes.[(boxes.Length / 2) + 1 ..]
let leftBound = leftHalf |> Array.map snd |> BoundingBox.merge |> Option.get let leftBound = leftHalf |> Array.map snd |> BoundingBox.merge |> ValueOption.get
let rightBound = rightHalf |> Array.map snd |> BoundingBox.merge |> Option.get let rightBound = rightHalf |> Array.map snd |> BoundingBox.merge |> ValueOption.get
(leftHalf, leftBound), (rightHalf, rightBound) (leftHalf, leftBound), (rightHalf, rightBound)
) )
@@ -40,4 +40,4 @@ module BoundingBoxTree =
Branch (go leftHalf, go rightHalf, boundAll) Branch (go leftHalf, go rightHalf, boundAll)
go boxes |> Some go boxes |> ValueSome

6
RayTracing/Hittable.fs
View File

@@ -11,11 +11,11 @@ type Hittable =
| UnboundedSphere s -> s.Reflection incoming strikePoint | UnboundedSphere s -> s.Reflection incoming strikePoint
| InfinitePlane p -> p.Reflection incoming strikePoint | InfinitePlane p -> p.Reflection incoming strikePoint
member this.BoundingBox : BoundingBox option = member this.BoundingBox : BoundingBox voption =
match this with match this with
| Sphere s -> Sphere.boundingBox s |> Some | Sphere s -> Sphere.boundingBox s |> ValueSome
| UnboundedSphere _ | UnboundedSphere _
| InfinitePlane _ -> None | InfinitePlane _ -> ValueNone
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Hittable = module Hittable =

12
RayTracing/InfinitePlane.fs
View File

@@ -47,10 +47,10 @@ module InfinitePlane =
|> Plane.orthonormalise |> Plane.orthonormalise
match plane with match plane with
| None -> | ValueNone ->
// Incoming ray is directly along the normal // Incoming ray is directly along the normal
Ray.flip incomingRay |> Ray.parallelTo strikePoint Ray.flip incomingRay |> Ray.parallelTo strikePoint
| Some plane -> | ValueSome plane ->
// Incoming ray is (plane1.ray) plane1 + (plane2.ray) plane2 // Incoming ray is (plane1.ray) plane1 + (plane2.ray) plane2
// We want the reflection in the normal, so need (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 normalComponent = -(UnitVector.dot plane.V1 (Ray.vector incomingRay))
@@ -63,7 +63,7 @@ module InfinitePlane =
Point.differenceToThenFrom s strikePoint Point.differenceToThenFrom s strikePoint
|> Ray.make' strikePoint |> Ray.make' strikePoint
// This is definitely safe. It's actually a logic error if this fails. // This is definitely safe. It's actually a logic error if this fails.
|> Option.get |> ValueOption.get
let newColour (incomingColour : Pixel) albedo colour = let newColour (incomingColour : Pixel) albedo colour =
Pixel.combine incomingColour colour |> Pixel.darken albedo Pixel.combine incomingColour colour |> Pixel.darken albedo
@@ -94,8 +94,8 @@ module InfinitePlane =
let output = Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint let output = Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
match output with match output with
| None -> () | ValueNone -> ()
| Some output -> outgoing <- output | ValueSome output -> outgoing <- output
Continues Continues
{ {
@@ -111,7 +111,7 @@ module InfinitePlane =
Point.differenceToThenFrom target strikePoint Point.differenceToThenFrom target strikePoint
|> Ray.make' strikePoint |> Ray.make' strikePoint
|> Option.get |> ValueOption.get
let newColour = Pixel.combine incomingRay.Colour colour |> Pixel.darken albedo let newColour = Pixel.combine incomingRay.Colour colour |> Pixel.darken albedo

18
RayTracing/Plane.fs
View File

@@ -26,8 +26,8 @@ module Plane =
else else
Vector.make 1.0 1.0 ((-x - y) / z) Vector.make 1.0 1.0 ((-x - y) / z)
let v2 = Vector.cross v v1 |> Vector.unitise |> Option.get let v2 = Vector.cross v v1 |> Vector.unitise |> ValueOption.get
let v1 = v1 |> Vector.unitise |> Option.get let v1 = v1 |> Vector.unitise |> ValueOption.get
{ {
Point = point Point = point
@@ -37,7 +37,7 @@ module Plane =
let inline makeNormalTo' (point : Point) (UnitVector v) = makeNormalTo point v let inline makeNormalTo' (point : Point) (UnitVector v) = makeNormalTo point v
let orthonormalise (plane : Plane) : OrthonormalPlane option = let orthonormalise (plane : Plane) : OrthonormalPlane voption =
let coefficient = UnitVector.dot plane.V1 plane.V2 let coefficient = UnitVector.dot plane.V1 plane.V2
let vec2 = let vec2 =
@@ -45,14 +45,14 @@ module Plane =
|> Vector.unitise |> Vector.unitise
match vec2 with match vec2 with
| None -> None | ValueNone -> ValueNone
| Some v2 -> | ValueSome v2 ->
{ {
V1 = plane.V1 V1 = plane.V1
V2 = v2 V2 = v2
Point = plane.Point Point = plane.Point
} }
|> Some |> ValueSome
let makeSpannedBy (r1 : Ray) (r2 : Ray) : Plane = let makeSpannedBy (r1 : Ray) (r2 : Ray) : Plane =
{ {
@@ -63,18 +63,18 @@ module Plane =
/// Construct a basis for this plane, whose second ("up") component is `viewUp` when projected onto the plane. /// Construct a basis for this plane, whose second ("up") component is `viewUp` when projected onto the plane.
let basis (viewUp : Vector) (plane : OrthonormalPlane) : Ray * Ray = let basis (viewUp : Vector) (plane : OrthonormalPlane) : Ray * Ray =
let viewUp = Vector.unitise viewUp |> Option.get let viewUp = Vector.unitise viewUp |> ValueOption.get
let v1Component = UnitVector.dot plane.V1 viewUp let v1Component = UnitVector.dot plane.V1 viewUp
let v2Component = UnitVector.dot plane.V2 viewUp let v2Component = UnitVector.dot plane.V2 viewUp
let v2 = let v2 =
Vector.sum (UnitVector.scale v1Component plane.V1) (UnitVector.scale v2Component plane.V2) Vector.sum (UnitVector.scale v1Component plane.V1) (UnitVector.scale v2Component plane.V2)
|> Vector.unitise |> Vector.unitise
|> Option.get |> ValueOption.get
let v1 = let v1 =
Vector.sum (UnitVector.scale v2Component plane.V1) (UnitVector.scale (-v1Component) plane.V2) Vector.sum (UnitVector.scale v2Component plane.V1) (UnitVector.scale (-v1Component) plane.V2)
|> Vector.unitise |> Vector.unitise
|> Option.get |> ValueOption.get
Ray.make plane.Point v1, Ray.make plane.Point v2 Ray.make plane.Point v1, Ray.make plane.Point v2

10
RayTracing/Point.fs
View File

@@ -25,14 +25,14 @@ module Vector =
let difference (Vector (a, b, c)) (Vector (x, y, z)) : Vector = Vector (a - x, b - y, c - z) let difference (Vector (a, b, c)) (Vector (x, y, z)) : Vector = Vector (a - x, b - y, c - z)
let unitise (vec : Vector) : UnitVector option = let unitise (vec : Vector) : UnitVector voption =
let dot = dot vec vec let dot = dot vec vec
if Float.equal dot 0.0 then if Float.equal dot 0.0 then
None ValueNone
else else
let factor = 1.0 / sqrt dot let factor = 1.0 / sqrt dot
scale factor vec |> UnitVector |> Some scale factor vec |> UnitVector |> ValueSome
let normSquared (vec : Vector) : float = dot vec vec let normSquared (vec : Vector) : float = dot vec vec
@@ -55,8 +55,8 @@ module UnitVector =
Vector.make x y z Vector.make x y z
|> Vector.unitise |> Vector.unitise
|> function |> function
| None -> random floatProducer dimension | ValueNone -> random floatProducer dimension
| Some result -> result | ValueSome result -> result
let inline dot (UnitVector a) (UnitVector b) = Vector.dot a b let inline dot (UnitVector a) (UnitVector b) = Vector.dot a b
let inline dot' (UnitVector a) (b : Vector) = Vector.dot a b let inline dot' (UnitVector a) (b : Vector) = Vector.dot a b

8
RayTracing/Ray.fs
View File

@@ -8,15 +8,15 @@ type Ray =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Ray = module Ray =
let make' (origin : Point) (vector : Vector) : Ray option = let make' (origin : Point) (vector : Vector) : Ray voption =
match Vector.unitise vector with match Vector.unitise vector with
| None -> None | ValueNone -> ValueNone
| Some v -> | ValueSome v ->
{ {
Origin = origin Origin = origin
Vector = v Vector = v
} }
|> Some |> ValueSome
let make (origin : Point) (vector : UnitVector) : Ray = let make (origin : Point) (vector : UnitVector) : Ray =
{ {

2
RayTracing/Ray.fsi
View File

@@ -10,7 +10,7 @@ type Ray =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Ray = module Ray =
val make' : Point -> Vector -> Ray option val make' : Point -> Vector -> Ray voption
val make : Point -> UnitVector -> Ray val make : Point -> UnitVector -> Ray
val walkAlong : Ray -> float -> Point val walkAlong : Ray -> float -> Point

22
RayTracing/Scene.fs
View File

@@ -6,7 +6,7 @@ type Scene =
private private
{ {
UnboundedObjects : Hittable array UnboundedObjects : Hittable array
BoundingBoxes : BoundingBoxTree option BoundingBoxes : BoundingBoxTree voption
} }
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
@@ -16,9 +16,9 @@ module Scene =
let bounded, unbounded = let bounded, unbounded =
objects objects
|> Array.map (fun h -> h, Hittable.boundingBox h) |> Array.map (fun h -> h, Hittable.boundingBox h)
|> Array.partition (snd >> Option.isSome) |> Array.partition (snd >> ValueOption.isSome)
let bounded = bounded |> Array.map (fun (h, box) -> h, Option.get box) let bounded = bounded |> Array.map (fun (h, box) -> h, ValueOption.get box)
let unbounded = unbounded |> Array.map fst let unbounded = unbounded |> Array.map fst
let tree = bounded |> BoundingBoxTree.make let tree = bounded |> BoundingBoxTree.make
@@ -59,14 +59,14 @@ module Scene =
else else
struct (bestFloat, bestObject, bestLength) struct (bestFloat, bestObject, bestLength)
let hitObject (s : Scene) (ray : Ray) : (Hittable * Point) option = let hitObject (s : Scene) (ray : Ray) : (Hittable * Point) voption =
let mutable best = Unchecked.defaultof<_> let mutable best = Unchecked.defaultof<_>
let mutable bestLength = nan let mutable bestLength = nan
let mutable bestFloat = infinity let mutable bestFloat = infinity
match s.BoundingBoxes with match s.BoundingBoxes with
| None -> () | ValueNone -> ()
| Some boundingBoxes -> | ValueSome boundingBoxes ->
let struct (f, o, l) = let struct (f, o, l) =
bestCandidate (BoundingBox.inverseDirections ray) ray bestFloat best bestLength boundingBoxes bestCandidate (BoundingBox.inverseDirections ray) ray bestFloat best bestLength boundingBoxes
@@ -86,9 +86,9 @@ module Scene =
bestLength <- point bestLength <- point
if Double.IsNaN bestLength then if Double.IsNaN bestLength then
None ValueNone
else else
Some (best, Ray.walkAlong ray bestLength) ValueSome (best, Ray.walkAlong ray bestLength)
let internal traceRay (maxCount : int) (scene : Scene) (ray : LightRay) : Pixel = let internal traceRay (maxCount : int) (scene : Scene) (ray : LightRay) : Pixel =
let rec go (bounces : int) (ray : LightRay) : Pixel = let rec go (bounces : int) (ray : LightRay) : Pixel =
@@ -102,10 +102,10 @@ module Scene =
let thingsWeHit = hitObject scene ray.Ray let thingsWeHit = hitObject scene ray.Ray
match thingsWeHit with match thingsWeHit with
| None -> | ValueNone ->
// Ray goes off into the distance and is never heard from again // Ray goes off into the distance and is never heard from again
Colour.Black Colour.Black
| Some (object, strikePoint) -> | ValueSome (object, strikePoint) ->
let outgoingRay = object.Reflection ray strikePoint let outgoingRay = object.Reflection ray strikePoint
match outgoingRay with match outgoingRay with
@@ -140,7 +140,7 @@ module Scene =
let ray = let ray =
Ray.make' (Ray.origin camera.View) (Point.differenceToThenFrom endPoint (Ray.origin camera.View)) Ray.make' (Ray.origin camera.View) (Point.differenceToThenFrom endPoint (Ray.origin camera.View))
|> Option.get |> ValueOption.get
// Here we've hardcoded that the eye is emitting white light through a medium with refractance 1. // Here we've hardcoded that the eye is emitting white light through a medium with refractance 1.
let result = let result =

22
RayTracing/Sphere.fs
View File

@@ -76,7 +76,7 @@ module Sphere =
/// A ray hits the sphere with centre `centre` at point `p`. /// A ray hits the sphere with centre `centre` at point `p`.
/// This function gives the outward-pointing normal. /// This function gives the outward-pointing normal.
let normal (centre : Point) (p : Point) : Ray = let normal (centre : Point) (p : Point) : Ray =
Ray.make' p (Point.differenceToThenFrom p centre) |> Option.get Ray.make' p (Point.differenceToThenFrom p centre) |> ValueOption.get
let private liesOn' (centre : Point) (radius : float) (p : Point) : bool = let private liesOn' (centre : Point) (radius : float) (p : Point) : bool =
let rSquared = radius * radius let rSquared = radius * radius
@@ -120,10 +120,10 @@ module Sphere =
let outgoing = let outgoing =
match plane with match plane with
| None -> | ValueNone ->
// Incoming ray is directly along the normal // Incoming ray is directly along the normal
Ray.flip incomingLight.Ray |> Ray.parallelTo strikePoint Ray.flip incomingLight.Ray |> Ray.parallelTo strikePoint
| Some plane -> | ValueSome plane ->
// Incoming ray is (plane1.ray) plane1 + (plane2.ray) plane2 // Incoming ray is (plane1.ray) plane1 + (plane2.ray) plane2
// We want the reflection in the normal, so need (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 incomingLight.Ray) let normalComponent = -UnitVector.dot plane.V1 (Ray.vector incomingLight.Ray)
@@ -137,7 +137,7 @@ module Sphere =
Point.differenceToThenFrom dest strikePoint Point.differenceToThenFrom dest strikePoint
|> Ray.make' strikePoint |> Ray.make' strikePoint
// This is safe: it's actually a logic error for this to fail. // This is safe: it's actually a logic error for this to fail.
|> Option.get |> ValueOption.get
match fuzz with match fuzz with
| None -> outgoing | None -> outgoing
@@ -153,8 +153,8 @@ module Sphere =
Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
match exitPoint with match exitPoint with
| None -> () | ValueNone -> ()
| Some o -> answer <- o | ValueSome o -> answer <- o
answer answer
@@ -163,10 +163,10 @@ module Sphere =
let plane = Plane.makeSpannedBy normal incomingLight.Ray |> Plane.orthonormalise let plane = Plane.makeSpannedBy normal incomingLight.Ray |> Plane.orthonormalise
match plane with match plane with
| None -> | ValueNone ->
// Incoming ray was parallel to normal; pass straight through // Incoming ray was parallel to normal; pass straight through
Ray.make strikePoint (Ray.vector incomingLight.Ray) Ray.make strikePoint (Ray.vector incomingLight.Ray)
| Some plane -> | ValueSome plane ->
let incomingSin = sqrt (1.0 - incomingCos * incomingCos) let incomingSin = sqrt (1.0 - incomingCos * incomingCos)
let outgoingSin = incomingSin / index let outgoingSin = incomingSin / index
@@ -186,7 +186,7 @@ module Sphere =
|> Ray.make' strikePoint |> Ray.make' strikePoint
// This is safe: it's a logic error for this to fail. It would imply both the // 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. // cos and the sin outgoing components were 0.
|> Option.get |> ValueOption.get
match style with match style with
| SphereStyle.LightSource texture -> | SphereStyle.LightSource texture ->
@@ -219,8 +219,8 @@ module Sphere =
Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint Point.differenceToThenFrom target strikePoint |> Ray.make' strikePoint
match outputPoint with match outputPoint with
| Some o -> answer <- o | ValueSome o -> answer <- o
| None -> () | ValueNone -> ()
answer answer