jolt.png: host PNG encoder + overlay, render mandelbrot/raytracer demos (#152)
Add a PNG writer so the demos produce actual images. Two pieces: - src/jolt/png.janet — the encoder (8-bit RGB, filter None, stored/uncompressed DEFLATE so no compressor is needed; correct CRC32 + Adler32). It lives in Janet because per-byte work in the overlay is far too slow (a byte-array aset loop is ~30s for 360k bytes, and CRC32 over even a tiny image would be worse). Janet's bit ops are 32-bit signed, so the 32-bit-unsigned arithmetic is done with plain number ops (doubles hold 2^32) plus byte-level bxor. Exposed to the overlay as janet.png/* by importing it into eval_base's module-load-env. - src/jolt/jolt/png.clj — the jolt.png overlay wrapper: image / put! / write. The overlay only produces pixels; the host encodes them in one pass. mandelbrot gets a `render` subcommand (jolt -m mandelbrot render out.png [size]) that colours count-point's escape counts; the numeric-arg bench path is untouched. Verified end to end: macOS `sips` accepts the output (so CRC/zlib are valid). png-test covers the encoder structure (signature/IHDR/IEND) and the overlay round-trip. Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
parent
e2b607f0f3
commit
b771908e5b
5 changed files with 227 additions and 2 deletions
|
|
@ -7,7 +7,8 @@
|
||||||
;;
|
;;
|
||||||
;; Portable Clojure (jolt + JVM Clojure).
|
;; Portable Clojure (jolt + JVM Clojure).
|
||||||
;; jolt -m mandelbrot 1000 (JOLT_DIRECT_LINK=1 JOLT_WHOLE_PROGRAM=1)
|
;; 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]
|
(defn count-point [cr ci cap]
|
||||||
(loop [i 0 zr 0.0 zi 0.0]
|
(loop [i 0 zr 0.0 zi 0.0]
|
||||||
|
|
@ -31,7 +32,36 @@
|
||||||
(recur (inc y) (+ acc row)))
|
(recur (inc y) (+ acc row)))
|
||||||
acc))))
|
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)]
|
(let [n (if (seq args) (Integer/parseInt (first args)) 1000)]
|
||||||
(dotimes [_ 2] (run (quot n 2))) ; warmup
|
(dotimes [_ 2] (run (quot n 2))) ; warmup
|
||||||
(let [runs 3
|
(let [runs 3
|
||||||
|
|
@ -46,3 +76,9 @@
|
||||||
(println "mandelbrot n" n "result" (second (first times)))
|
(println "mandelbrot n" n "result" (second (first times)))
|
||||||
(println "runs:" (mapv (fn [t] (/ (Math/round (* t 10.0)) 10.0)) mss))
|
(println "runs:" (mapv (fn [t] (/ (Math/round (* t 10.0)) 10.0)) mss))
|
||||||
(println "mean:" (/ (Math/round (* mean 10.0)) 10.0) "ms"))))
|
(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)))
|
||||||
|
|
|
||||||
|
|
@ -11,6 +11,10 @@
|
||||||
(use ./reader)
|
(use ./reader)
|
||||||
(use ./regex)
|
(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 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.
|
# the janet/* interop bridge falls back to it inside env-less fibers.
|
||||||
|
|
|
||||||
35
src/jolt/jolt/png.clj
Normal file
35
src/jolt/jolt/png.clj
Normal file
|
|
@ -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))
|
||||||
104
src/jolt/png.janet
Normal file
104
src/jolt/png.janet
Normal file
|
|
@ -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)
|
||||||
46
test/integration/png-test.janet
Normal file
46
test/integration/png-test.janet
Normal file
|
|
@ -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)))
|
||||||
Loading…
Add table
Add a link
Reference in a new issue