Something went wrong. Try again.
A ray tracer in Coalton
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226(cl:defpackage #:ray/vec3 (:use #:coalton #:coalton-prelude) (:local-nicknames (#:math #:coalton/math) (#:simd #:sb-simd-avx2) (#:util #:ray/util)) (:export #:Vec3 #:v3 #:get-x #:get-y #:get-z #:spread #:random #:random-within #:random-on-hemisphere #:random-unit-vector #:random-in-unit-disk #:reflect #:refract #:near-zero? #:unit-vector #:vec-length #:vec-length-squared #:vec-add #:vec-add-scalar #:vec-sub #:vec-mul #:vec-mul-scalar #:vec-div-scalar #:vec-dot #:vec-cross #:vec-negate))
(cl:in-package #:ray/vec3)
(cl:declaim (cl:optimize (cl:speed 3) (cl:safety 0) (cl:debug 0)))
(coalton-toplevel (repr :native (sb-simd-avx:f64.4)) (define-type Vec3) (inline) (declare v3 (F64 * F64 * F64 -> Vec3)) (define (v3 x y z) (lisp (-> Vec3) (x y z) (simd:make-f64.4 x y z 0.0d0))))
(coalton-toplevel (inline) (declare get-x (Vec3 -> F64)) (define (get-x vec3) (lisp (-> F64) (vec3) (cl:nth-value 0 (simd:f64.4-values vec3))))) (coalton-toplevel (inline) (declare get-y (Vec3 -> F64)) (define (get-y vec3) (lisp (-> F64) (vec3) (cl:nth-value 1 (simd:f64.4-values vec3)))))
(coalton-toplevel (inline) (declare get-z (Vec3 -> F64)) (define (get-z vec3) (lisp (-> F64) (vec3) (cl:nth-value 2 (simd:f64.4-values vec3)))))
(coalton-toplevel (inline) (declare spread (Vec3 -> F64 * F64 * F64)) (define (spread vec) (let (values x y z _) = (lisp (-> F64 * F64 * F64 * F64) (vec) (simd:f64.4-values vec))) (values x y z)))
(coalton-toplevel (inline) (declare random (Void -> Vec3)) (define (random) (v3 (util:rand-f64) (util:rand-f64) (util:rand-f64)))) (coalton-toplevel (inline) (declare random-within (F64 * F64 -> Vec3)) (define (random-within min max) (v3 (util:rand-f64-range min max) (util:rand-f64-range min max) (util:rand-f64-range min max))))
(coalton-toplevel (inline) (declare +a+ F64) (define +a+ 1.0d-8)
(inline) (declare near-zero? (Vec3 -> Boolean)) (define (near-zero? vec) (let (values x y z) = (spread vec)) (and (< x +a+) (< y +a+) (< z +a+)))) (coalton-toplevel (inline) (declare vec-length-squared (Vec3 -> F64)) (define (vec-length-squared vec) (lisp (-> F64) (vec) (simd:f64.4-horizontal+ (simd:f64.4* vec vec))))) (coalton-toplevel (inline) (declare vec-length (Vec3 -> F64)) (define (vec-length vec) (math:sqrt (vec-length-squared vec)))) (coalton-toplevel (inline) (declare vec-add (Vec3 * Vec3 -> Vec3)) (define (vec-add u v) "Adds two vectors together" (lisp (-> Vec3) (u v) (simd:f64.4+ u v)))) (coalton-toplevel (inline) (declare vec-add-scalar (Vec3 * F64 -> Vec3)) (define (vec-add-scalar vec t) "Add a scalar to all fields of a vector" (lisp (-> Vec3) (vec t) (simd:f64.4+ vec t)))) (coalton-toplevel (inline) (declare vec-sub (Vec3 * Vec3 -> Vec3)) (define (vec-sub u v) "Subtract one vector from another" (lisp (-> Vec3) (u v) (simd:f64.4- u v)))) (coalton-toplevel (inline) (declare vec-mul (Vec3 * Vec3 -> Vec3)) (define (vec-mul u v) "Multiply two vectors together" (lisp (-> Vec3) (u v) (simd:f64.4* u v)))) (coalton-toplevel (inline) (declare vec-mul-scalar (Vec3 * F64 -> Vec3)) (define (vec-mul-scalar vec t) "Multiply a vector by a scalar" (lisp (-> Vec3) (vec t) (simd:f64.4* vec t)))) (coalton-toplevel (inline) (declare vec-dot (Vec3 * Vec3 -> F64)) (define (vec-dot u v) "Compute the dot-product of two vectors" (lisp (-> F64) (u v) (simd:f64.4-horizontal+ (simd:f64.4* u v))))) (coalton-toplevel (inline) (declare vec-cross (Vec3 * Vec3 -> Vec3)) (define (vec-cross u v) (let (values ux uy uz) = (spread u)) (let (values vx vy vz) = (spread v)) ;; TODO: I bet I could figure out how to swizzle this (v3 (- (* uy vz) (* uz vy)) (- (* uz vx) (* ux vz)) (- (* ux vy) (* uy vx))))) (coalton-toplevel (inline) (declare vec-div-scalar (Vec3 * F64 -> Vec3)) (define (vec-div-scalar vec t) (vec-mul-scalar vec (/ 1.0d0 t)))) (coalton-toplevel (inline) (declare vec-negate (Vec3 -> Vec3)) (define (vec-negate vec) (lisp (-> Vec3) (vec) (simd:f64.4* vec -1.0d0)))) (coalton-toplevel (inline) (declare unit-vector (Vec3 -> Vec3)) (define (unit-vector v) (vec-div-scalar v (vec-length v))))
(coalton-toplevel (inline) (declare random-unit-vector (Void -> Vec3)) (define (random-unit-vector) (let p = (random-within -1.0d0 1.0d0)) (let lensq = (vec-length-squared p)) (if (and (> lensq 1.0d-160) (<= lensq 1)) (vec-div-scalar p (math:sqrt lensq)) (random-unit-vector))))
(coalton-toplevel (inline) (declare random-on-hemisphere (Vec3 -> Vec3)) (define (random-on-hemisphere normal) (let on-unit-sphere = (random-unit-vector)) (if (> (vec-dot on-unit-sphere normal) 0.0d0) on-unit-sphere (vec-negate on-unit-sphere)))) (coalton-toplevel (inline) (declare random-in-unit-disk (Void -> Vec3)) (define (random-in-unit-disk) (let p = (v3 (util:rand-f64-range -1.0d0 1.0d0) (util:rand-f64-range -1.0d0 1.0d0) 0.0d0)) (if (< (vec-length-squared p) 1.0d0) p (random-in-unit-disk)))) (coalton-toplevel (inline) (declare reflect (Vec3 * Vec3 -> Vec3)) (define (reflect v n) (vec-sub v (vec-mul-scalar n (* (vec-dot v n) 2.0d0))))) (coalton-toplevel (inline) (declare refract (Vec3 * Vec3 * F64 -> Vec3)) (define (refract uv n etai-over-etat) (let cos-theta = (min (vec-dot (vec-negate uv) n) 1.0d0)) (let r-out-perp = (vec-mul-scalar (vec-add uv (vec-mul-scalar n cos-theta)) etai-over-etat)) (let r-out-parallel = (vec-mul-scalar n (negate (math:sqrt (abs (- 1.0d0 (vec-length-squared r-out-perp))))))) (vec-add r-out-perp r-out-parallel)))