Something went wrong. Try again.
A ray tracer in Coalton
Something went wrong. Try again.
12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273(cl:defpackage #:ray/scene (:use #:coalton #:coalton-prelude) (:local-nicknames (#:trig #:coalton/math/elementary) (#:integ #:coalton/math/integral) (#:it #:coalton/iterator) (#:h #:ray/hittable) (#:m #:ray/material) (#:c #:ray/color) (#:v #:ray/vec3) (#:la #:coalton/lisparray) (#:util #:ray/util)) (:export #:basic-world #:small-world #:complex-world))
(cl:in-package #:ray/scene)
(coalton-toplevel (declare complex-world (la:LispArray h:Surface)) (define complex-world (into (fold (fn (acc i) (let x = (- (integ:mod i 21) 10)) (let z = (- (/ i 21) 6)) (let choose-mat = (util:rand-f64)) (let center = (v:v3 (+ x (* 0.9d0 (util:rand-f64))) 0.2d0 (+ z (* 0.9d0 (util:rand-f64))))) (if (< 0.9d0 (v:vec-length (v:vec-sub center (v:v3 4.0d0 0.2d0 0.0d0)))) (cons (if (< choose-mat 0.8d0) (h:Sphere center 0.2d0 (m:Lambertian (rand-color))) (if (< choose-mat 0.95d0) (h:Sphere center 0.2d0 (m:Metal (rand-color) (util:rand-f64-range 0.0d0 0.5d0))) (h:Sphere center 0.2d0 (m:Dielectric 1.5d0)))) acc) acc)) [ ; Big ass world sphere (h:Sphere (v:v3 0.0d0 -1000.0d0 0.0d0) 1000.0d0 (m:Lambertian (c:make-color 0.5d0 0.5d0 0.5d0))) ; 3 med-big spheres (h:Sphere (v:v3 0.0d0 1.0d0 0.0d0) 1.0d0 (m:Dielectric 1.5d0)) (h:Sphere (v:v3 -4.0d0 1.0d0 0.0d0) 1.0d0 (m:Lambertian (c:make-color 0.4d0 0.2d0 0.1d0))) (h:Sphere (v:v3 4.0d0 1.0d0 0.0d0) 1.0d0 (m:Metal (c:make-color 0.7d0 0.6d0 0.5d0) 0.0d0)) ] (the (List F64) (it:collect! (it:range-increasing 1 1 200)))))) (declare basic-world (List h:Surface)) (define basic-world [ ; Big ass world sphere (h:Sphere (v:v3 0.0d0 -100.5d0 -1.0d0) 100.0d0 (m:Lambertian (c:make-color 0.8d0 0.8d0 0.0d0))) ; Center (h:Sphere (v:v3 0.0d0 0.0d0 -1.2d0) 0.5d0 (m:Lambertian (c:make-color 0.1d0 0.2d0 0.5d0))) ; Left (h:Sphere (v:v3 -1.0d0 0.0d0 -1.0d0) 0.5d0 (m:Dielectric 1.5d0)) ; Bubble (h:Sphere (v:v3 -1.0d0 0.0d0 -1.0d0) 0.4d0 (m:Dielectric (/ 1.0d0 1.5d0))) ; Right (h:Sphere (v:v3 1.0d0 0.0d0 -1.0d0) 0.5d0 (m:Metal (c:make-color 0.8d0 0.6d0 0.2d0) 1.0d0)) ]) (declare R F64) (define R (trig:cos (/ (the F64 trig:pi) 4.0d0))) (declare SMALL-WORLD (List h:Surface)) (define SMALL-WORLD [ (h:Sphere (v:v3 (negate R) 0 -1) R (m:Lambertian (c:make-color 0.0d0 0.0d0 1.0d0))) (h:Sphere (v:v3 R 0 -1) R (m:Lambertian (c:make-color 1.0d0 0.0d0 0.0d0))) ]) (declare rand-color (Void -> c:Color)) (define (rand-color) (c:make-color (util:rand-f64) (util:rand-f64) (util:rand-f64))))