Initial commit

Camera.carp

@@ -0,0 +1,61 @@
+(deftype (Camera f)
+    [origin (Vector3 f)
+     u (Vector3 f)
+     v (Vector3 f)
+     w (Vector3 f)
+     lower-left (Vector3 f)
+     horizontal (Vector3 f)
+     vertical (Vector3 f)
+     lens-radius f
+     ])
+
+
+(defmodule Camera
+(with Generics
+  (defn create [look-from look-at vup vfov-degrees aspect aperture focus-dist]
+    (let [theta (Geometry.degree-to-radians vfov-degrees)
+          half-height (tan (halved theta))
+          half-width (* aspect half-height)
+	  dir (Vector3.sub &look-from &look-at)
+          w (Vector3.normalize &dir)
+          u (Vector3.normalize &(Vector3.cross &vup &w))
+          v (Vector3.cross &w &u)
+          hwu (Vector3.mul &u half-width)
+          hhv (Vector3.mul &v half-height)
+          ll (Vector3.sub
+              &look-from
+              &(Vector3.mul
+                &(Vector3.add &(Vector3.add &hwu &hhv) &w)
+                focus-dist))
+          tfd (twice focus-dist)
+          hor (Vector3.mul &hwu tfd)
+          ver (Vector3.mul &hhv tfd)
+          ]
+      (Camera.init
+       look-from
+       u
+       v
+       w
+       ll
+       hor
+       ver
+       (halved aperture))))
+
+
+  (defn get-ray [c s t]
+    (let [
+          rd (Vector3.mul &(random-in-unit-disc) @(lens-radius c))
+          offset (Vector3.add
+                  &(Vector3.mul (u c) @(Vector3.x &rd))
+                  &(Vector3.mul (v c) @(Vector3.y &rd)))
+          ori (Vector3.add (origin c) &offset)
+          dir (Vector3.add
+               (lower-left c)
+               &(Vector3.sub
+                 &(Vector3.add
+                   &(Vector3.mul (horizontal c) s)
+                   &(Vector3.mul (vertical c) t))
+                 &ori))
+      ]
+      (Ray.init ori dir)))
+  ))

Dielectric.carp

@@ -0,0 +1,43 @@
+(with Generics
+(defn refract [v n ni-over-nt]
+  (let [uv (Vector3.normalize v)
+        dt (Vector3.dot &uv n)
+        discriminant (- (one) (* (squared ni-over-nt) (- (one) (squared dt))))
+        ]
+    (if (> discriminant (zero))
+      (Maybe.Just (Vector3.sub &(Vector3.mul
+                                 &(Vector3.sub &uv &(Vector3.mul n dt))
+                                 ni-over-nt)
+                               &(Vector3.mul n (sqrt discriminant))))
+      (Maybe.Nothing))))
+
+(defn schlick [cosine ref-idx]
+  (let [r0 (squared (/ (- (one) ref-idx)
+                       (+ (one) ref-idx)))
+        ]
+    (+ r0 (* (- (one) r0) (pow (- (one) cosine) (five))))))
+
+(defn dielectric [ref-idx]
+  (fn [ray hit]
+    (let [hn (Hit.normal hit)
+          rd (Ray.direction ray)
+          reflected (reflect rd hn)
+          pos (pos? (Vector3.dot rd hn))
+          ddn (/ (Vector3.dot rd hn) (Vector3.mag rd))
+          outward-normal (if pos (Vector3.neg hn) @hn)
+          ni-over-nt (if pos ref-idx (inverse ref-idx))
+          cosine (if pos (* ref-idx ddn) (neg ddn))
+          attenuation (Vector3.init (one) (one) (one))
+          ]
+      (Maybe.Just
+       (Scatter.init
+        attenuation
+        (Ray.init
+         @(Hit.p hit)
+         (match (refract rd &outward-normal ni-over-nt)
+                (Maybe.Just refracted) (if (< (random-0-1) (schlick cosine ref-idx))
+                                         reflected
+                                         refracted)
+                (Maybe.Nothing) reflected)))))))
+
+)

Hittable.carp

@@ -0,0 +1,7 @@
+(deftype (Hit f) [t f
+                  p (Vector3 f)
+                  normal (Vector3 f)
+                  material (Fn [(Ref (Ray f)) (Ref (Hit f))] (Maybe (Scatter f)))
+                  ])
+
+(definterface hit (λ [h (Ref (Ray f)) f f] (Maybe (Hit f))))

Hittables.carp

@@ -0,0 +1,18 @@
+(deftype (Hittables h) [elts (Array h)])
+
+(defmodule Hittables
+  (deftype (CurrentHit f) [hr (Maybe (Hit f))  dist f])
+
+  (defn closest-hit [hs ray t-min t-max]
+    (let [closest (fn [cur h]
+                    (match (hit h ray t-min @(CurrentHit.dist &cur))
+                           (Maybe.Just hr) (let [rt @(Hit.t &hr)]
+                                             (CurrentHit.init (Maybe.Just hr) rt))
+                           (Maybe.Nothing) cur))
+          ]
+      @(CurrentHit.hr
+        &(Array.reduce
+          &closest
+          (CurrentHit.init (Maybe.Nothing) t-max)
+          (Hittables.elts hs)))))
+  )

Lambertian.carp

@@ -0,0 +1,8 @@
+(defn lambertian [albedo]
+  (fn [ray hit]
+    (let [
+          hp (Hit.p hit)
+          target (Vector3.add &(Vector3.add hp (Hit.normal hit)) &(random-in-unit-sphere))
+          rt (Vector3.sub &target hp)
+          ]
+      (Maybe.Just (Scatter.init @&albedo (Ray.init @hp rt))))))

Main.carp

@@ -0,0 +1,186 @@
+(Project.config "compiler" "/usr/bin/clang")
+;(Project.config "compiler" "gcc")
+;(Project.config "compiler" "clang")
+;(Project.config "compiler" "/nix/store/2qf9sxv0znq0wikmbp7zff30knnklr0x-clang-wrapper-8.0.1/bin/clang")
+(add-cflag "-mavx -flto -ffunction-sections -fdata-sections -ffast-math -O3 -fomit-frame-pointer")
+;(add-cflag "-ffast-math -O1 -g")
+;(add-cflag "-mavx -g -O2 -finline -fno-omit-frame-pointer")
+(load "Debug.carp")
+(load "Vector.carp")
+(load "Geometry.carp")
+(load "RandomVec.carp")
+(load "Ray.carp")
+(load "Camera.carp")
+(load "Hittable.carp")
+(load "Material.carp")
+(load "Lambertian.carp")
+(load "Metal.carp")
+(load "Dielectric.carp")
+(load "Hittables.carp")
+(load "Sphere.carp")
+(load "FPE.carp")
+(use Ray)
+(use Maybe)
+
+(deftype RGB [r Char g Char b Char])
+
+
+(defmodule Array
+  (defn cartesian [f a b]
+  (let-do [n (length a)
+           r (allocate (Generics.squared n))
+           ]
+    (for [i 0 n]
+      (let [s (* i n)]
+        (for [j 0 n]
+          (aset-uninitialized! &r
+                               (+ s j)
+                               (~f (nth a i)
+                                (nth a j))))))
+    r))
+  )
+
+(defn color [r world depth]
+  (let [
+        dr (direction r)
+        unit-dir (Vector3.normalize dr)
+        t (Generics.halved (+ @(Vector3.y &unit-dir) (Generics.one)))
+        black (Vector3.init 0.0f 0.0f 0.0f)
+        uxyz (Vector3.init 1.0f 1.0f 1.0f)
+        sky (Vector3.vlerp
+             &(Vector3.init 0.5f 0.7f 1.0f)
+             &uxyz
+             t)
+        ]
+    (match (Hittables.closest-hit world r 0.001f Float.MAX)
+           (Just rec) (if (< depth 50)
+                        (let [mat @(Hit.material &rec)]
+                          (match (mat r &rec)
+                                 (Just sca) (let [at (Scatter.attenuation &sca)
+                                                  sc (Scatter.scattered &sca)
+                                                  ncol (color sc world (inc depth))
+                                                  ]
+                                              (Vector3.cmul &ncol at))
+                                 (Nothing) black))
+                        black)
+           (Nothing) sky)))
+
+(defn random-scene []
+  (let [rng (Array.range -11.0f 11.0f 1.0f)
+        ucenters (Array.cartesian
+                  &(fn [a b]
+                     (Vector3.init (+ @a (* 0.9f (random-0-1)))
+                                   0.2f
+                                   (+ @b (* 0.9f (random-0-1)))))
+                  &rng
+                  &rng)
+        centers (Array.copy-filter
+                 &(fn [c] (> (Vector3.dist &(Vector3.init 4.0f 0.2f 0.0f) c) 0.9f))
+                 &ucenters)
+        mats (Array.repeat
+              (Array.length &centers)
+              &(fn []
+                 (let [choose-mat (random-0-1)
+                       random-sq (fn [] (* (random-0-1) (random-0-1)))
+                       random-05-1 (fn [] (random-between 0.5f 1.0f))
+                       ]
+                   (cond
+                     (< choose-mat 0.8f) (lambertian (Vector3.init
+                                                       (random-sq)
+                                                       (random-sq)
+                                                       (random-sq)))
+                     (< choose-mat 0.95f) (metal (Vector3.init
+                                                   (random-05-1)
+                                                   (random-05-1)
+                                                   (random-05-1))
+                                                 (Generics.halved (random-0-1)))
+                     (dielectric 1.5f)))))
+        spheres (Array.zip &(fn [cen mat] (Sphere.init @cen 0.2f @mat))
+                           &centers
+                           &mats)
+        hardcoded [(Sphere.init (Vector3.init 0.0f -1000.0f 0.0f)
+                                1000.0f
+                                (lambertian (Vector3.init 0.5f 0.5f 0.5f)))
+                   (Sphere.init (Vector3.init 0.0f 1.0f 0.0f)
+                                1.0f
+                                (dielectric 1.5f))
+                   (Sphere.init (Vector3.init -4.0f 1.0f 0.0f)
+                                1.0f
+                                (lambertian (Vector3.init 0.4f 0.2f 0.1f)))
+                   (Sphere.init (Vector3.init 4.0f 1.0f 0.0f)
+                                1.0f
+                                (metal (Vector3.init 0.7f 0.6f 0.5f) 0.0f))
+                   ]
+        ]
+    (Array.concat &[hardcoded spheres])))
+
+
+(defn main2 []
+  (let [
+        nx 600 ; 1200
+        ny 400 ; 800
+        ns 10 ; 100
+        world (Hittables.init (random-scene))
+        xworld (Hittables.init
+               [(Sphere.init (Vector3.init 0.0f 0.0f -1.0f)
+                             0.5f
+                             (lambertian (Vector3.init 0.1f 0.2f 0.5f)))
+                (Sphere.init (Vector3.init 0.0f -100.5f -1.0f)
+                             100.0f
+                             (lambertian (Vector3.init 0.8f 0.8f 0.0f)))
+                (Sphere.init (Vector3.init 1.0f 0.0f -1.0f)
+                             0.5f
+                             (metal (Vector3.init 0.8f 0.6f 0.2f) 0.3f))
+                (Sphere.init (Vector3.init -1.0f 0.0f -1.0f)
+                             0.5f
+                             (dielectric 1.5f))
+                (Sphere.init (Vector3.init -1.0f 0.0f -1.0f)
+                             -0.45f
+                             (dielectric 1.5f))
+                ])
+        look-from (Vector3.init 13.0f 2.0f 3.0f)
+        look-at (Vector3.init 0.0f 0.0f 0.0f)
+        vup (Vector3.init 0.0f 1.0f 0.0f)
+        dist-to-focus 10.0f ; (Vector3.dist &look-from &look-at)
+        aperture 0.1f ; 2.0f
+        cam (Camera.create
+             look-from
+             look-at
+             vup
+             20.0f
+             (/ (from-int nx) (from-int ny))
+             aperture
+             dist-to-focus
+             )
+        ]
+    (do
+      (IO.print &(fmt "P6\n%d %d\n255\n" nx ny))
+      (for [j (- ny 1) -1 -1]
+        (for [i 0 nx]
+          (let-do [
+                   col (Vector3.zero)
+                   comp (fn [x] (from-int (to-int (* 255.99f (sqrt (/ x (from-int ns)))))))
+                ]
+            (for [s 0 ns]
+              (let [u (/ (+ (from-int i) (random-0-1)) (from-int nx))
+                    v (/ (+ (from-int j) (random-0-1)) (from-int ny))
+                    r (Camera.get-ray &cam u v)
+                    ]
+                (set! col (Vector3.add &col &(color &r &world 0)))))
+              (IO.fwrite &(RGB.init
+                           (comp @(Vector3.x &col))
+                           (comp @(Vector3.y &col))
+                           (comp @(Vector3.z &col)))
+                         3
+                         1
+                         IO.stdout)))))))
+
+(defn main []
+  (do
+    ; (with FPE
+    ;       (enable-exceptions (sum*
+    ;                           division-by-zero
+    ;                           invalid
+    ;                           overflow
+    ;                           )))
+    (main2)))

Material.carp

@@ -0,0 +1 @@
+(deftype (Scatter f) [attenuation (Vector3 f)  scattered (Ray f)])

Metal.carp

@@ -0,0 +1,15 @@
+
+(defn reflect [v n]
+  (Vector3.sub v &(Vector3.mul n (Generics.twice (Vector3.dot v n)))))
+
+(defn metal [albedo fuzz]
+  (fn [ray hit]
+    (let [hn (Hit.normal hit)
+          reflected (reflect (Ray.direction ray) hn)
+          d (Vector3.add &reflected &(Vector3.mul &(random-in-unit-sphere) fuzz))
+          ]
+      (if (<= (Vector3.dot &d hn) (zero))
+        (Maybe.Nothing)
+        (Maybe.Just (Scatter.init
+                     @&albedo
+                     (Ray.init @(Hit.p hit) d)))))))

RandomVec.carp

@@ -0,0 +1,17 @@
+(with Generics
+(defn random-in-unit-disc []
+  (let [p (Vector3.init (random--1-1) (random--1-1) (zero))
+        d (Vector3.dot &p &p)
+        ]
+    (if (< d (one))
+      p
+      (random-in-unit-disc))))
+
+(defn random-in-unit-sphere []
+  (let [p (Vector3.init (random--1-1) (random--1-1) (random--1-1))
+        d (Vector3.dot &p &p)
+        ]
+    (if (< d (one))
+      p
+      (random-in-unit-sphere))))
+)

Ray.carp

@@ -0,0 +1,6 @@
+(deftype (Ray f) [origin (Vector3 f)
+                  direction (Vector3 f)
+                  ])
+
+(defn point-at [r t]
+  (Vector3.add (Ray.origin r) &(Vector3.mul (Ray.direction r) t)))