Something went wrong. Try again.
Monorepo for Aesthetic.Computer aesthetic.computer
Something went wrong. Try again.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125;;; Framebuffer — foreign-memory pixel buffer for DRM/fbdev
(in-package :ac-native.framebuffer)
(defstruct framebuffer "A 2D pixel buffer backed by CFFI foreign memory (for DRM mmap compat)." (pixels (cffi:null-pointer) :type cffi:foreign-pointer) (width 0 :type fixnum) (height 0 :type fixnum) (stride 0 :type fixnum) ; in pixels (= width for our buffers) (owned t :type boolean)) ; if t, we allocated pixels and must free
(defun fb-create (width height) "Allocate a new framebuffer with WIDTH x HEIGHT pixels (ARGB32)." (let* ((stride width) (nbytes (* stride height 4)) (ptr (cffi:foreign-alloc :uint32 :count (* stride height) :initial-element 0))) (make-framebuffer :pixels ptr :width width :height height :stride stride :owned t)))
(defun fb-destroy (fb) "Free the framebuffer's pixel memory (if we own it)." (when (and fb (framebuffer-owned fb) (not (cffi:null-pointer-p (framebuffer-pixels fb)))) (cffi:foreign-free (framebuffer-pixels fb)) (setf (framebuffer-pixels fb) (cffi:null-pointer))))
(declaim (inline fb-pixel-offset))(defun fb-pixel-offset (fb x y) (declare (optimize (speed 3) (safety 0)) (type fixnum x y) (type framebuffer fb)) (the fixnum (+ x (* y (framebuffer-stride fb)))))
(defun fb-clear (fb color-u32) "Fill the entire framebuffer with a packed ARGB32 color." (declare (optimize (speed 3) (safety 0)) (type (unsigned-byte 32) color-u32)) (let* ((n (* (framebuffer-stride fb) (framebuffer-height fb))) (ptr (framebuffer-pixels fb))) (dotimes (i n) (setf (cffi:mem-aref ptr :uint32 i) color-u32))))
(declaim (inline fb-put-pixel))(defun fb-put-pixel (fb x y color-u32) "Write a pixel (no blending, no bounds check in optimized mode)." (declare (optimize (speed 3) (safety 0)) (type fixnum x y) (type (unsigned-byte 32) color-u32) (type framebuffer fb)) (when (and (>= x 0) (< x (framebuffer-width fb)) (>= y 0) (< y (framebuffer-height fb))) (setf (cffi:mem-aref (framebuffer-pixels fb) :uint32 (fb-pixel-offset fb x y)) color-u32)))
(defun fb-blend-pixel (fb x y src-color) "Alpha-blend a color onto the framebuffer at (x, y)." (declare (optimize (speed 3) (safety 0)) (type fixnum x y)) (when (and (>= x 0) (< x (framebuffer-width fb)) (>= y 0) (< y (framebuffer-height fb))) (let* ((off (fb-pixel-offset fb x y)) (dst-u32 (cffi:mem-aref (framebuffer-pixels fb) :uint32 off)) (dst (make-color :r (ldb (byte 8 16) dst-u32) :g (ldb (byte 8 8) dst-u32) :b (ldb (byte 8 0) dst-u32) :a 255))) (setf (cffi:mem-aref (framebuffer-pixels fb) :uint32 off) (color-blend src-color dst)))))
;;; Convenience aliases matching exported names(defun fb-width (fb) (framebuffer-width fb))(defun fb-height (fb) (framebuffer-height fb))(defun fb-stride (fb) (framebuffer-stride fb))(defun fb-pixels (fb) (framebuffer-pixels fb))
(defun fb-copy-scaled (src dst-ptr dst-w dst-h dst-stride scale) "Copy SRC framebuffer to a foreign memory region at DST-PTR, scaling up by SCALE. Used by DRM present to blit the small render buffer to the display. Optimized: expand each source row into a temp row, then memcpy to fill scale rows." (declare (optimize (speed 3) (safety 0)) (type fixnum dst-w dst-h dst-stride scale) (type framebuffer src)) (let* ((sw (framebuffer-width src)) (sh (framebuffer-height src)) (sp (framebuffer-pixels src)) (row-bytes (* dst-stride 4))) ; bytes per destination row ;; For scale=1, use fast memcpy path (if (= scale 1) (let ((copy-w (min sw dst-w))) (dotimes (y (min sh dst-h)) (cffi:foreign-funcall "memcpy" :pointer (cffi:inc-pointer dst-ptr (* y row-bytes)) :pointer (cffi:inc-pointer sp (* y sw 4)) :unsigned-long (* copy-w 4) :pointer))) ;; General case: expand each source row, then replicate (let* ((expanded-w (min (* sw scale) dst-w)) (expanded-bytes (* expanded-w 4))) ;; Temp buffer for one expanded row (cffi:with-foreign-object (tmp :uint32 expanded-w) (dotimes (sy sh) (let ((dst-y0 (* sy scale))) (when (>= dst-y0 dst-h) (return)) ;; Expand source row: replicate each pixel `scale` times (let ((src-row-offset (* sy sw))) (dotimes (sx sw) (let ((pixel (cffi:mem-aref sp :uint32 (+ src-row-offset sx))) (dx0 (* sx scale))) (when (>= dx0 dst-w) (return)) (dotimes (dx scale) (let ((col (+ dx0 dx))) (when (>= col expanded-w) (return)) (setf (cffi:mem-aref tmp :uint32 col) pixel)))))) ;; Copy expanded row to each of the `scale` destination rows (dotimes (dy scale) (let ((row (+ dst-y0 dy))) (when (>= row dst-h) (return)) (cffi:foreign-funcall "memcpy" :pointer (cffi:inc-pointer dst-ptr (* row row-bytes)) :pointer tmp :unsigned-long expanded-bytes :pointer))))))))))