;; 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)))