Something went wrong. Try again.
A ray tracer in Coalton
Something went wrong. Try again.
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394(cl:defpackage #:ray/hittable (:use #:coalton #:coalton-prelude) (:local-nicknames (#:r #:ray/ray) (#:v #:ray/vec3) (#:c #:ray/color) (#:m #:ray/material)) (:export #:Surface #:Sphere #:miss-record #:hit-surface-distance? #:hit-surface?))
(cl:in-package #:ray/hittable)
(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 0) (cl:debug 0)))
(coalton-toplevel ;(define-type HitRecord (HitRecord Boolean v:Vec3 v:Vec3 F64 Boolean m:Material)) (define-type Surface (Sphere v:Vec3 F64 m:Material)) (inline) (declare miss-record (Void -> Boolean * v:Vec3 * v:Vec3 * F64 * Boolean * m:Material)) (define (miss-record) (values False (v:v3 0.0d0 0.0d0 0.0d0) (v:v3 0.0d0 0.0d0 0.0d0) 0.0d0 False (m:Lambertian c:black)))
(inline) (declare hit-sphere (v:Vec3 * F64 * m:Material * v:Vec3 * v:Vec3 * F64 * F64 -> Boolean * v:Vec3 * v:Vec3 * F64 * Boolean * m:Material)) (define (hit-sphere center radius material origin direction tmin tmax) (let oc = (v:vec-sub center origin)) (let a = (v:vec-length-squared direction)) (let h = (v:vec-dot direction oc)) (let c = (- (v:vec-length-squared oc) (* radius radius))) (let discriminant = (- (* h h) (* a c))) (cond ((< discriminant 0) (miss-record)) (True (let sqrtd = (sqrt discriminant)) (let minus-root = (/ (- h sqrtd) a)) (let pos-root = (/ (+ h sqrtd) a)) (let root = (if (or (<= minus-root tmin) (<= tmax minus-root)) pos-root minus-root)) (cond ((or (<= root tmin) (<= tmax root)) (miss-record)) (True (let point = (r:ray-at origin direction root)) (let outward-normal = (v:vec-div-scalar (v:vec-sub point center) radius)) (let front-face = (< (v:vec-dot direction outward-normal) 0)) (let normal = (if front-face outward-normal (v:vec-negate outward-normal))) (values True point normal root front-face material)))))) (inline) (declare hit-sphere-distance (v:Vec3 * F64 * v:Vec3 * v:Vec3 * F64 * F64 -> Boolean * F64)) (define (hit-sphere-distance center radius origin direction tmin tmax) (let oc = (v:vec-sub center origin)) (let a = (v:vec-length-squared direction)) (let h = (v:vec-dot direction oc)) (let c = (- (v:vec-length-squared oc) (* radius radius))) (let discriminant = (- (* h h) (* a c))) (cond ((< discriminant 0) (values False 0.0d0)) (True (let sqrtd = (sqrt discriminant)) (let minus-root = (/ (- h sqrtd) a)) (let pos-root = (/ (+ h sqrtd) a)) (let root = (if (or (<= minus-root tmin) (<= tmax minus-root)) pos-root minus-root)) (cond ((or (<= root tmin) (<= tmax root)) (values False 0.0d0)) (True (values True root))))))
(inline) (declare hit-surface? (Surface * v:Vec3 * v:Vec3 * F64 * F64 -> Boolean * v:Vec3 * v:Vec3 * F64 * Boolean * m:Material)) (define (hit-surface? surface origin direction tmin tmax) (match surface ((Sphere center radius material) (hit-sphere center radius material origin direction tmin tmax)))) (inline) (declare hit-surface-distance? (Surface * v:Vec3 * v:Vec3 * F64 * F64 -> Boolean * F64)) (define (hit-surface-distance? surface origin direction tmin tmax) (match surface ((Sphere center radius _) (hit-sphere-distance center radius origin direction tmin tmax)))))