fc9597456f
All checks were successful
Build and Deploy / build-and-deploy (push) Successful in 1m28s
- Add JAX text rendering with font atlas, styled text placement, and typography primitives - Add xector (element-wise/reduction) operations library and sexp effects - Add deferred effect chain fusion for JIT-compiled effect pipelines - Expand drawing primitives with font management, alignment, shadow, and outline - Add interpreter support for function-style define and require - Add GPU persistence mode and hardware decode support to streaming - Add new sexp effects: cell_pattern, halftone, mosaic, and derived definitions - Add path registry for asset resolution - Add integration, primitives, and xector tests Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
207 lines
6.6 KiB
Common Lisp
207 lines
6.6 KiB
Common Lisp
;; Derived Operations
|
|
;;
|
|
;; These are built from true primitives using S-expressions.
|
|
;; Load with: (require "derived")
|
|
|
|
;; =============================================================================
|
|
;; Math Helpers (derivable from where + basic ops)
|
|
;; =============================================================================
|
|
|
|
;; Absolute value
|
|
(define (abs x) (where (< x 0) (- x) x))
|
|
|
|
;; Minimum of two values
|
|
(define (min2 a b) (where (< a b) a b))
|
|
|
|
;; Maximum of two values
|
|
(define (max2 a b) (where (> a b) a b))
|
|
|
|
;; Clamp x to range [lo, hi]
|
|
(define (clamp x lo hi) (max2 lo (min2 hi x)))
|
|
|
|
;; Square of x
|
|
(define (sq x) (* x x))
|
|
|
|
;; Linear interpolation: a*(1-t) + b*t
|
|
(define (lerp a b t) (+ (* a (- 1 t)) (* b t)))
|
|
|
|
;; Smooth interpolation between edges
|
|
(define (smoothstep edge0 edge1 x)
|
|
(let ((t (clamp (/ (- x edge0) (- edge1 edge0)) 0 1)))
|
|
(* t (* t (- 3 (* 2 t))))))
|
|
|
|
;; =============================================================================
|
|
;; Channel Shortcuts (derivable from channel primitive)
|
|
;; =============================================================================
|
|
|
|
;; Extract red channel as xector
|
|
(define (red frame) (channel frame 0))
|
|
|
|
;; Extract green channel as xector
|
|
(define (green frame) (channel frame 1))
|
|
|
|
;; Extract blue channel as xector
|
|
(define (blue frame) (channel frame 2))
|
|
|
|
;; Convert to grayscale xector (ITU-R BT.601)
|
|
(define (gray frame)
|
|
(+ (* (red frame) 0.299)
|
|
(* (green frame) 0.587)
|
|
(* (blue frame) 0.114)))
|
|
|
|
;; Alias for gray
|
|
(define (luminance frame) (gray frame))
|
|
|
|
;; =============================================================================
|
|
;; Coordinate Generators (derivable from iota + repeat/tile)
|
|
;; =============================================================================
|
|
|
|
;; X coordinate for each pixel [0, width)
|
|
(define (x-coords frame) (tile (iota (width frame)) (height frame)))
|
|
|
|
;; Y coordinate for each pixel [0, height)
|
|
(define (y-coords frame) (repeat (iota (height frame)) (width frame)))
|
|
|
|
;; Normalized X coordinate [0, 1]
|
|
(define (x-norm frame) (/ (x-coords frame) (max2 1 (- (width frame) 1))))
|
|
|
|
;; Normalized Y coordinate [0, 1]
|
|
(define (y-norm frame) (/ (y-coords frame) (max2 1 (- (height frame) 1))))
|
|
|
|
;; Distance from frame center for each pixel
|
|
(define (dist-from-center frame)
|
|
(let* ((cx (/ (width frame) 2))
|
|
(cy (/ (height frame) 2))
|
|
(dx (- (x-coords frame) cx))
|
|
(dy (- (y-coords frame) cy)))
|
|
(sqrt (+ (sq dx) (sq dy)))))
|
|
|
|
;; Normalized distance from center [0, ~1]
|
|
(define (dist-norm frame)
|
|
(let ((d (dist-from-center frame)))
|
|
(/ d (max2 1 (βmax d)))))
|
|
|
|
;; =============================================================================
|
|
;; Cell/Grid Operations (derivable from floor + basic math)
|
|
;; =============================================================================
|
|
|
|
;; Cell row index for each pixel
|
|
(define (cell-row frame cell-size) (floor (/ (y-coords frame) cell-size)))
|
|
|
|
;; Cell column index for each pixel
|
|
(define (cell-col frame cell-size) (floor (/ (x-coords frame) cell-size)))
|
|
|
|
;; Number of cell rows
|
|
(define (num-rows frame cell-size) (floor (/ (height frame) cell-size)))
|
|
|
|
;; Number of cell columns
|
|
(define (num-cols frame cell-size) (floor (/ (width frame) cell-size)))
|
|
|
|
;; Flat cell index for each pixel
|
|
(define (cell-indices frame cell-size)
|
|
(+ (* (cell-row frame cell-size) (num-cols frame cell-size))
|
|
(cell-col frame cell-size)))
|
|
|
|
;; Total number of cells
|
|
(define (num-cells frame cell-size)
|
|
(* (num-rows frame cell-size) (num-cols frame cell-size)))
|
|
|
|
;; X position within cell [0, cell-size)
|
|
(define (local-x frame cell-size) (mod (x-coords frame) cell-size))
|
|
|
|
;; Y position within cell [0, cell-size)
|
|
(define (local-y frame cell-size) (mod (y-coords frame) cell-size))
|
|
|
|
;; Normalized X within cell [0, 1]
|
|
(define (local-x-norm frame cell-size)
|
|
(/ (local-x frame cell-size) (max2 1 (- cell-size 1))))
|
|
|
|
;; Normalized Y within cell [0, 1]
|
|
(define (local-y-norm frame cell-size)
|
|
(/ (local-y frame cell-size) (max2 1 (- cell-size 1))))
|
|
|
|
;; =============================================================================
|
|
;; Fill Operations (derivable from iota)
|
|
;; =============================================================================
|
|
|
|
;; Xector of n zeros
|
|
(define (zeros n) (* (iota n) 0))
|
|
|
|
;; Xector of n ones
|
|
(define (ones n) (+ (zeros n) 1))
|
|
|
|
;; Xector of n copies of val
|
|
(define (fill val n) (+ (zeros n) val))
|
|
|
|
;; Xector of zeros matching x's length
|
|
(define (zeros-like x) (* x 0))
|
|
|
|
;; Xector of ones matching x's length
|
|
(define (ones-like x) (+ (zeros-like x) 1))
|
|
|
|
;; =============================================================================
|
|
;; Pooling (derivable from group-reduce)
|
|
;; =============================================================================
|
|
|
|
;; Pool a channel by cell index
|
|
(define (pool-channel chan cell-idx num-cells)
|
|
(group-reduce chan cell-idx num-cells "mean"))
|
|
|
|
;; Pool red channel to cells
|
|
(define (pool-red frame cell-size)
|
|
(pool-channel (red frame)
|
|
(cell-indices frame cell-size)
|
|
(num-cells frame cell-size)))
|
|
|
|
;; Pool green channel to cells
|
|
(define (pool-green frame cell-size)
|
|
(pool-channel (green frame)
|
|
(cell-indices frame cell-size)
|
|
(num-cells frame cell-size)))
|
|
|
|
;; Pool blue channel to cells
|
|
(define (pool-blue frame cell-size)
|
|
(pool-channel (blue frame)
|
|
(cell-indices frame cell-size)
|
|
(num-cells frame cell-size)))
|
|
|
|
;; Pool grayscale to cells
|
|
(define (pool-gray frame cell-size)
|
|
(pool-channel (gray frame)
|
|
(cell-indices frame cell-size)
|
|
(num-cells frame cell-size)))
|
|
|
|
;; =============================================================================
|
|
;; Blending (derivable from math)
|
|
;; =============================================================================
|
|
|
|
;; Additive blend
|
|
(define (blend-add a b) (clamp (+ a b) 0 255))
|
|
|
|
;; Multiply blend (normalized)
|
|
(define (blend-multiply a b) (* (/ a 255) b))
|
|
|
|
;; Screen blend
|
|
(define (blend-screen a b) (- 255 (* (/ (- 255 a) 255) (- 255 b))))
|
|
|
|
;; Overlay blend
|
|
(define (blend-overlay a b)
|
|
(where (< a 128)
|
|
(* 2 (/ (* a b) 255))
|
|
(- 255 (* 2 (/ (* (- 255 a) (- 255 b)) 255)))))
|
|
|
|
;; =============================================================================
|
|
;; Simple Effects (derivable from primitives)
|
|
;; =============================================================================
|
|
|
|
;; Invert a channel (255 - c)
|
|
(define (invert-channel c) (- 255 c))
|
|
|
|
;; Binary threshold
|
|
(define (threshold-channel c thresh) (where (> c thresh) 255 0))
|
|
|
|
;; Reduce to n levels
|
|
(define (posterize-channel c levels)
|
|
(let ((step (/ 255 (- levels 1))))
|
|
(* (round (/ c step)) step)))
|