diff --git a/bench/mandelbrot.clj b/bench/mandelbrot.clj index 7b1dfb4..23c8c23 100644 --- a/bench/mandelbrot.clj +++ b/bench/mandelbrot.clj @@ -7,7 +7,8 @@ ;; ;; Portable Clojure (jolt + JVM Clojure). ;; jolt -m mandelbrot 1000 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1) -(ns mandelbrot) +(ns mandelbrot + (:require [jolt.png :as png])) (defn count-point [cr ci cap] (loop [i 0 zr 0.0 zi 0.0] @@ -31,7 +32,36 @@ (recur (inc y) (+ acc row))) acc)))) -(defn -main [& args] +;; --- PNG demo (jolt.png) -------------------------------------------------- +;; Render a real picture of the set, reusing count-point as the kernel. `render` +;; is a separate -main subcommand so the numeric-arg bench path is untouched. + +(defn- color + "Escape-iteration count -> RGB. In-set points (n>=cap) are black; faster + escapes run through a warm gradient." + [n cap] + (if (>= n cap) + [0 0 0] + (let [t (/ (double n) cap)] + [(int (* 255 (min 1.0 (* 3.0 t)))) + (int (* 255 (min 1.0 (max 0.0 (* 3.0 (- t 0.33)))))) + (int (* 255 (min 1.0 (max 0.0 (* 3.0 (- t 0.66))))))]))) + +(defn render! + "Render a size×size view of the Mandelbrot set to a PNG at path." + [path size] + (let [w size h size cap 1000 + img (png/image w h)] + (doseq [py (range h)] + (doseq [px (range w)] + (let [cr (- (* 3.5 (/ (double px) w)) 2.5) ; real ∈ [-2.5, 1.0] + ci (- (* 2.8 (/ (double py) h)) 1.4) ; imag ∈ [-1.4, 1.4] + [r g b] (color (count-point cr ci cap) cap)] + (png/put! img r g b)))) + (png/write img w h path) + (println "wrote" path (str w "×" h ", cap " cap)))) + +(defn- run-bench [args] (let [n (if (seq args) (Integer/parseInt (first args)) 1000)] (dotimes [_ 2] (run (quot n 2))) ; warmup (let [runs 3 @@ -46,3 +76,9 @@ (println "mandelbrot n" n "result" (second (first times))) (println "runs:" (mapv (fn [t] (/ (Math/round (* t 10.0)) 10.0)) mss)) (println "mean:" (/ (Math/round (* mean 10.0)) 10.0) "ms")))) + +(defn -main [& args] + (if (= (first args) "render") + (render! (or (second args) "mandelbrot.png") + (if (nth args 2 nil) (Integer/parseInt (nth args 2)) 600)) + (run-bench args))) diff --git a/src/jolt/eval_base.janet b/src/jolt/eval_base.janet index 22776b4..18632cc 100644 --- a/src/jolt/eval_base.janet +++ b/src/jolt/eval_base.janet @@ -11,6 +11,10 @@ (use ./reader) (use ./regex) +# Host PNG encoder, exposed to the overlay as `janet.png/encode` / `janet.png/write` +# (resolved through module-load-env below). Pure Janet, no jolt deps. +(import ./png :prefix "png/") + # The env this module was loaded under — proto-chains to the Janet root env; # the janet/* interop bridge falls back to it inside env-less fibers. diff --git a/src/jolt/jolt/png.clj b/src/jolt/jolt/png.clj new file mode 100644 index 0000000..ecb72eb --- /dev/null +++ b/src/jolt/jolt/png.clj @@ -0,0 +1,35 @@ +; Jolt Standard Library: jolt.png +; +; Write PNG images from Clojure. Build an image, push RGB pixels in row-major +; order (top row first), then write to disk: +; +; (require '[jolt.png :as png]) +; (let [img (png/image w h)] +; (doseq [y (range h)] +; (doseq [x (range w)] +; (png/put! img r g b))) ; r g b are ints 0-255 +; (png/write img w h "out.png")) +; +; The byte-level encoding (filtering, stored-DEFLATE/zlib, CRC32) runs in the +; host (the Janet `png` module, reached via the `janet.*` bridge): per-byte work +; in the overlay is far too slow, so the overlay only produces pixels and the +; host encodes them in one pass. +(ns jolt.png) + +(defn image + "A blank w×h RGB pixel sink (a host byte buffer). Push exactly w*h pixels with + put!, in row-major / top-row-first order, then write." + [w h] + (janet.buffer/new (* w h 3))) + +(defn put! + "Append one RGB pixel — each of r g b an int in 0-255 — to the image. Returns + the image so calls can be threaded." + [img r g b] + (janet.buffer/push-byte img r g b) + img) + +(defn write + "Encode the filled w×h image as a PNG and write it to path. Returns path." + [img w h path] + (janet.png/write path w h img)) diff --git a/src/jolt/png.janet b/src/jolt/png.janet new file mode 100644 index 0000000..de45943 --- /dev/null +++ b/src/jolt/png.janet @@ -0,0 +1,104 @@ +# Minimal PNG encoder (the host side of `jolt.png`). 8-bit truecolour RGB +# (colour type 2), no interlace, filter 0 (None), and STORED (uncompressed) +# DEFLATE blocks — a valid zlib stream that needs no compressor. Files are larger +# than a compressed PNG but decode everywhere. +# +# Lives in Janet, not Clojure: jolt's per-op cost makes per-byte work (CRC32 over +# every byte) impractical in the overlay, so the whole encode runs here natively +# and jolt calls `write` once with a raw-RGB buffer. Exposed to jolt as +# `janet.png/...` via eval_base's module-load-env (see eval_base.janet). +# +# Janet's bit ops are 32-bit SIGNED (0xFFFFFFFF overflows), so the 32-bit +# unsigned arithmetic of CRC32/Adler32 is done with plain number ops (doubles +# hold 2^32 exactly) plus byte-level bxor, whose operands are always 0..255. + +(defn- u8 [v] (% v 256)) # low byte +(defn- shr [v n] (math/floor (/ v n))) # logical shift-right by a power of two + +# 32-bit xor via 4 byte-wise xors (each operand 0..255, safely in 32-bit range). +(defn- xor32 [a b] + (var r 0) + (var m 1) + (for i 0 4 + (set r (+ r (* (bxor (% (shr a m) 256) (% (shr b m) 256)) m))) + (set m (* m 256))) + r) + +(def- crc-table + (let [t (array/new-filled 256 0)] + (for n 0 256 + (var c n) + (for _ 0 8 + (set c (if (= 1 (% c 2)) (xor32 0xEDB88320 (shr c 2)) (shr c 2)))) + (put t n c)) + t)) + +(defn- crc32 [buf] + (var c 0xFFFFFFFF) + (def n (length buf)) + (for i 0 n + (set c (xor32 (get crc-table (bxor (% c 256) (get buf i))) (shr c 256)))) + (- 0xFFFFFFFF c)) # final xor with all-ones = complement + +(defn- adler32 [buf] + (var a 1) + (var b 0) + (def n (length buf)) + (for i 0 n + (set a (% (+ a (get buf i)) 65521)) + (set b (% (+ b a) 65521))) + (+ (* b 65536) a)) + +(defn- push-u32be [out v] + (buffer/push-byte out (% (shr v 16777216) 256) (% (shr v 65536) 256) + (% (shr v 256) 256) (% v 256))) + +(defn- push-chunk [out typ data] + (push-u32be out (length data)) + (def tagged (buffer typ data)) # CRC covers type + data + (buffer/push-string out tagged) + (push-u32be out (crc32 tagged))) + +# zlib stream of `raw` as stored DEFLATE blocks (<=65535 bytes each). +(defn- zlib-store [raw] + (def out (buffer/new (+ (length raw) 64))) + (buffer/push-byte out 0x78 0x01) # zlib header: CM=8 CINFO=7, FCHECK ok + (def n (length raw)) + (var pos 0) + (while (< pos n) + (def len (min 65535 (- n pos))) + (def final (if (>= (+ pos len) n) 1 0)) + (def nlen (- 65535 len)) # one's-complement of len in 16 bits + (buffer/push-byte out final (% len 256) (shr len 256) (% nlen 256) (shr nlen 256)) + (buffer/push-string out (buffer/slice raw pos (+ pos len))) + (set pos (+ pos len))) + (push-u32be out (adler32 raw)) + out) + +(defn encode + "Encode a w*h*3 raw-RGB buffer (row-major, top row first) as a PNG buffer." + [w h rgb] + (assert (= (length rgb) (* w h 3)) "png/encode: rgb length != w*h*3") + (def out (buffer/new (+ 64 (* w h 3)))) + (buffer/push-string out "\x89PNG\r\n\x1a\n") + (def ihdr (buffer/new 13)) + (push-u32be ihdr w) + (push-u32be ihdr h) + (buffer/push-byte ihdr 8 2 0 0 0) # bit depth 8, colour type 2 (RGB), … + (push-chunk out "IHDR" ihdr) + # scanlines, each prefixed with filter byte 0 (None) + (def stride (* w 3)) + (def raw (buffer/new (* h (+ 1 stride)))) + (for y 0 h + (buffer/push-byte raw 0) + (def off (* y stride)) + (buffer/push-string raw (buffer/slice rgb off (+ off stride)))) + (push-chunk out "IDAT" (zlib-store raw)) + (push-chunk out "IEND" (buffer/new 0)) + out) + +(defn write + "Encode and write a w*h*3 raw-RGB buffer to `path` as a PNG." + [path w h rgb] + (spit path (encode w h rgb)) + path) diff --git a/test/integration/png-test.janet b/test/integration/png-test.janet new file mode 100644 index 0000000..6dc5664 --- /dev/null +++ b/test/integration/png-test.janet @@ -0,0 +1,46 @@ +# jolt.png: the host PNG encoder (src/jolt/png.janet) + the overlay wrapper +# (src/jolt/jolt/png.clj), reachable as janet.png/* through eval_base's +# module-load-env. Checks the encoder emits a structurally valid PNG (signature, +# IHDR dims, IEND) and that the overlay path writes the same. +(import ../../src/jolt/png :as png) +(import ../../src/jolt/api :as api) + +(print "jolt.png encoder + overlay...") +(var failures 0) +(defn check [label ok] (if ok (print " ok: " label) (do (++ failures) (eprintf " FAIL: %s" label)))) + +(defn- u32 [b o] + (+ (* (get b o) 16777216) (* (get b (+ o 1)) 65536) (* (get b (+ o 2)) 256) (get b (+ o 3)))) + +# --- host encoder --- +(def w 5) +(def h 3) +(def rgb (buffer/new (* w h 3))) +(for i 0 (* w h 3) (buffer/push-byte rgb (% (* i 7) 256))) +(def out (png/encode w h rgb)) +(check "PNG signature" (= (string/slice out 0 8) "\x89PNG\r\n\x1a\n")) +(check "IHDR length is 13" (= 13 (u32 out 8))) +(check "IHDR type" (= "IHDR" (string/slice out 12 16))) +(check "IHDR width" (= w (u32 out 16))) +(check "IHDR height" (= h (u32 out 20))) +(check "8-bit RGB colour type" (and (= 8 (get out 24)) (= 2 (get out 25)))) +(check "ends with an IEND chunk" (string/find "IEND" (string out))) +(check "encode rejects a wrong-sized buffer" + (= false (first (protect (png/encode w h (buffer/new 4)))))) + +# --- overlay (jolt.png from Clojure) writes a valid PNG --- +(def tmp (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-png-overlay-test.png")) +(def ctx (api/init-cached {:compile? true})) +(api/eval-string ctx "(require '[jolt.png :as png])") +(api/eval-string ctx + (string "(let [img (png/image 4 2)]" + " (doseq [_ (range 8)] (png/put! img 10 20 30))" + " (png/write img 4 2 \"" tmp "\"))")) +(def wrote (slurp tmp)) +(check "overlay wrote the PNG signature" (= (string/slice wrote 0 8) "\x89PNG\r\n\x1a\n")) +(check "overlay IHDR dims" (and (= 4 (u32 wrote 16)) (= 2 (u32 wrote 20)))) +(os/rm tmp) + +(if (= 0 failures) + (print "All tests passed.") + (do (eprintf "%d png check(s) failed" failures) (os/exit 1)))