Something went wrong. Try again.
A ray tracer in Coalton
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869(cl:defpackage #:ray/material (:use #:coalton #:coalton-prelude) (:local-nicknames (#:v #:ray/vec3) (#:r #:ray/ray) (#:c #:ray/color) (#:util #:ray/util) (#:math #:coalton/math)) (:export #:Material #:Lambertian #:Metal #:Dielectric #:scatter))
(cl:in-package #:ray/material)
(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 0) (cl:debug 0)))
(coalton-toplevel (define-type Material (Metal c:Color F64) (Lambertian c:Color) (Dielectric F64)) (declare scatter-lambertian (v:Vec3 * v:Vec3 * c:Color -> Optional r:Ray * c:Color)) (define (scatter-lambertian point normal albedo) (let scatter-direction = (v:vec-add normal (v:random-unit-vector))) (if (v:near-zero? scatter-direction) ; Catch degenerate scatter case (values (Some (r:Ray point normal)) albedo) (values (Some (r:Ray point scatter-direction)) albedo))) (declare scatter-metal (v:Vec3 * v:Vec3 * v:Vec3 * c:Color * F64 -> Optional r:Ray * c:Color)) (define (scatter-metal direction point normal albedo fuzz) (let reflected = (v:reflect direction normal)) (let re-reflected = (v:vec-add (v:unit-vector reflected) (v:vec-mul-scalar (v:random-unit-vector) fuzz))) (if (> (v:vec-dot re-reflected normal) 0) (values (Some (r:Ray point re-reflected)) albedo) (values None c:black))) (declare scatter-dielectric (v:Vec3 * v:Vec3 * v:Vec3 * Boolean * F64 -> Optional r:Ray * c:Color)) (define (scatter-dielectric direction point normal front-face? refraction-index) (let ri = (if front-face? (/ 1.0d0 refraction-index) refraction-index)) (let unit-direction = (v:unit-vector direction)) (let cos-theta = (min (v:vec-dot (v:vec-negate unit-direction) normal) 1.0d0)) (let sin-theta = (math:sqrt (- 1.0d0 (^ cos-theta 2)))) (let cannot-refract = (> (* ri sin-theta) 1.0d0)) ; If the material cannot refract it must reflect (let direction = (if (or cannot-refract (> (reflectance cos-theta ri) (util:rand-f64))) (v:reflect unit-direction normal) (v:refract unit-direction normal ri))) (values (Some (r:Ray point direction)) c:white)) (declare reflectance (F64 * F64 -> F64)) (define (reflectance cosine refraction-index) "Ye olde Schlick approximation for reflectance" (let r0 = (/ (- 1.0d0 refraction-index) (+ 1.0d0 refraction-index))) (let r0-sq = (* r0 r0)) (+ r0-sq (* (- 1.0d0 r0-sq) (^ (- 1.0d0 cosine) 5)))) (declare scatter (r:Ray * v:Vec3 * v:Vec3 * Boolean * Material -> Optional r:Ray * c:Color)) (define (scatter (r:Ray _ direction) point normal front-face? material) (match material ((Lambertian albedo) (scatter-lambertian point normal albedo)) ((Metal albedo fuzz) (scatter-metal direction point normal albedo fuzz)) ((Dielectric refraction-index) (scatter-dielectric direction point normal front-face? refraction-index)))))