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

Perfect reflection, and Lambert, for spheres and planes (#1)

Browse Source
This commit is contained in:
Patrick Stevens
2021-04-06 23:47:30 +01:00
committed by GitHub
parent 301976863f
commit eefaa92d0e
30 changed files with 1625 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

57
RayTracing/SampleImages.fs
View File

@@ -1,5 +1,11 @@
namespace RayTracing
open System
type SampleImages =
| Gradient
| Spheres
[<RequireQualifiedAccess>]
module SampleImages =
@@ -13,10 +19,47 @@ module SampleImages =
256.0<progress>,
async {
return Array.init 256 (fun height ->
let output = Array.init 256 (pixelAt height)
progressIncrement 1.0<progress>
output
)
|> Image
}
return
Array.init
256
(fun height ->
let output = Array.init 256 (pixelAt height)
progressIncrement 1.0<progress>
output
)
|> Image
}
let spheres (progressIncrement : float<progress> -> unit) : float<progress> * Image Async =
let random = Random ()
let aspectRatio = 16.0 / 9.0
let camera =
Camera.makeBasic Num.float 4.0 aspectRatio (Point [| 0.0 ; 0.0 ; 0.0 |])
let pixels = 1800
{
Objects =
[|
Hittable.Sphere (Sphere.make Num.float (SphereStyle.LambertReflection (1.0, { Red = 255uy ; Green = 255uy ; Blue = 0uy }, random)) (Point [| 0.0 ; 0.0 ; 9.0 |]) 1.0)
Hittable.Sphere (Sphere.make Num.float (SphereStyle.PureReflection (1.0, { Red = 0uy ; Green = 255uy ; Blue = 255uy })) (Point [| 1.5 ; 0.5 ; 8.0 |]) 0.5)
Hittable.Sphere (Sphere.make Num.float (SphereStyle.LightSource Colour.Blue) (Point [| -1.5 ; 1.5 ; 8.0 |]) 0.5)
// Side mirror
Hittable.InfinitePlane (InfinitePlane.make Num.float (InfinitePlaneStyle.PureReflection (1.0, { Colour.White with Green = 240uy })) (Point [| 0.1 ; 0.0 ; 16.0 |]) (Vector [| -2.0 ; 0.0 ; -1.0 |]))
// Floor mirror
Hittable.InfinitePlane (InfinitePlane.make Num.float (InfinitePlaneStyle.PureReflection (0.4, Colour.White)) (Point [| 0.0 ; -1.0 ; 0.0 |]) (Vector [| 0.0 ; 1.0 ; 0.0 |]))
// Back plane
Hittable.InfinitePlane (InfinitePlane.make Num.float (InfinitePlaneStyle.PureReflection (0.6, Colour.White)) (Point [| 0.0 ; 0.0 ; 16.0 |]) (Vector [| 0.0 ; 0.0 ; -1.0 |]))
// Light pad behind us
Hittable.InfinitePlane (InfinitePlane.make Num.float (InfinitePlaneStyle.LightSource Colour.White) (Point [| 0.0 ; 1.0 ; -1.0 |]) (Vector [| 0.0 ; -1.0 ; 1.0 |]))
|]
}
|> Scene.render progressIncrement (aspectRatio * (float pixels) |> int) pixels camera
let get (s : SampleImages) : (float<progress> -> unit) -> float<progress> * Image Async =
match s with
| Gradient -> gradient
| Spheres -> spheres