aesthetic.computer
Monorepo for Aesthetic.Computer
aesthetic.computer
1;;; Framebuffer — foreign-memory pixel buffer for DRM/fbdev
2
3(in-package :ac-native.framebuffer)
4
5(defstruct framebuffer
6 "A 2D pixel buffer backed by CFFI foreign memory (for DRM mmap compat)."
7 (pixels (cffi:null-pointer) :type cffi:foreign-pointer)
8 (width 0 :type fixnum)
9 (height 0 :type fixnum)
10 (stride 0 :type fixnum) ; in pixels (= width for our buffers)
11 (owned t :type boolean)) ; if t, we allocated pixels and must free
12
13(defun fb-create (width height)
14 "Allocate a new framebuffer with WIDTH x HEIGHT pixels (ARGB32)."
15 (let* ((stride width)
16 (nbytes (* stride height 4))
17 (ptr (cffi:foreign-alloc :uint32 :count (* stride height) :initial-element 0)))
18 (make-framebuffer :pixels ptr :width width :height height
19 :stride stride :owned t)))
20
21(defun fb-destroy (fb)
22 "Free the framebuffer's pixel memory (if we own it)."
23 (when (and fb (framebuffer-owned fb)
24 (not (cffi:null-pointer-p (framebuffer-pixels fb))))
25 (cffi:foreign-free (framebuffer-pixels fb))
26 (setf (framebuffer-pixels fb) (cffi:null-pointer))))
27
28(declaim (inline fb-pixel-offset))
29(defun fb-pixel-offset (fb x y)
30 (declare (optimize (speed 3) (safety 0))
31 (type fixnum x y)
32 (type framebuffer fb))
33 (the fixnum (+ x (* y (framebuffer-stride fb)))))
34
35(defun fb-clear (fb color-u32)
36 "Fill the entire framebuffer with a packed ARGB32 color."
37 (declare (optimize (speed 3) (safety 0))
38 (type (unsigned-byte 32) color-u32))
39 (let* ((n (* (framebuffer-stride fb) (framebuffer-height fb)))
40 (ptr (framebuffer-pixels fb)))
41 (dotimes (i n)
42 (setf (cffi:mem-aref ptr :uint32 i) color-u32))))
43
44(declaim (inline fb-put-pixel))
45(defun fb-put-pixel (fb x y color-u32)
46 "Write a pixel (no blending, no bounds check in optimized mode)."
47 (declare (optimize (speed 3) (safety 0))
48 (type fixnum x y)
49 (type (unsigned-byte 32) color-u32)
50 (type framebuffer fb))
51 (when (and (>= x 0) (< x (framebuffer-width fb))
52 (>= y 0) (< y (framebuffer-height fb)))
53 (setf (cffi:mem-aref (framebuffer-pixels fb) :uint32
54 (fb-pixel-offset fb x y))
55 color-u32)))
56
57(defun fb-blend-pixel (fb x y src-color)
58 "Alpha-blend a color onto the framebuffer at (x, y)."
59 (declare (optimize (speed 3) (safety 0))
60 (type fixnum x y))
61 (when (and (>= x 0) (< x (framebuffer-width fb))
62 (>= y 0) (< y (framebuffer-height fb)))
63 (let* ((off (fb-pixel-offset fb x y))
64 (dst-u32 (cffi:mem-aref (framebuffer-pixels fb) :uint32 off))
65 (dst (make-color :r (ldb (byte 8 16) dst-u32)
66 :g (ldb (byte 8 8) dst-u32)
67 :b (ldb (byte 8 0) dst-u32)
68 :a 255)))
69 (setf (cffi:mem-aref (framebuffer-pixels fb) :uint32 off)
70 (color-blend src-color dst)))))
71
72;;; Convenience aliases matching exported names
73(defun fb-width (fb) (framebuffer-width fb))
74(defun fb-height (fb) (framebuffer-height fb))
75(defun fb-stride (fb) (framebuffer-stride fb))
76(defun fb-pixels (fb) (framebuffer-pixels fb))
77
78(defun fb-copy-scaled (src dst-ptr dst-w dst-h dst-stride scale)
79 "Copy SRC framebuffer to a foreign memory region at DST-PTR, scaling up by SCALE.
80 Used by DRM present to blit the small render buffer to the display.
81 Optimized: expand each source row into a temp row, then memcpy to fill scale rows."
82 (declare (optimize (speed 3) (safety 0))
83 (type fixnum dst-w dst-h dst-stride scale)
84 (type framebuffer src))
85 (let* ((sw (framebuffer-width src))
86 (sh (framebuffer-height src))
87 (sp (framebuffer-pixels src))
88 (row-bytes (* dst-stride 4))) ; bytes per destination row
89 ;; For scale=1, use fast memcpy path
90 (if (= scale 1)
91 (let ((copy-w (min sw dst-w)))
92 (dotimes (y (min sh dst-h))
93 (cffi:foreign-funcall "memcpy"
94 :pointer (cffi:inc-pointer dst-ptr (* y row-bytes))
95 :pointer (cffi:inc-pointer sp (* y sw 4))
96 :unsigned-long (* copy-w 4)
97 :pointer)))
98 ;; General case: expand each source row, then replicate
99 (let* ((expanded-w (min (* sw scale) dst-w))
100 (expanded-bytes (* expanded-w 4)))
101 ;; Temp buffer for one expanded row
102 (cffi:with-foreign-object (tmp :uint32 expanded-w)
103 (dotimes (sy sh)
104 (let ((dst-y0 (* sy scale)))
105 (when (>= dst-y0 dst-h) (return))
106 ;; Expand source row: replicate each pixel `scale` times
107 (let ((src-row-offset (* sy sw)))
108 (dotimes (sx sw)
109 (let ((pixel (cffi:mem-aref sp :uint32 (+ src-row-offset sx)))
110 (dx0 (* sx scale)))
111 (when (>= dx0 dst-w) (return))
112 (dotimes (dx scale)
113 (let ((col (+ dx0 dx)))
114 (when (>= col expanded-w) (return))
115 (setf (cffi:mem-aref tmp :uint32 col) pixel))))))
116 ;; Copy expanded row to each of the `scale` destination rows
117 (dotimes (dy scale)
118 (let ((row (+ dst-y0 dy)))
119 (when (>= row dst-h) (return))
120 (cffi:foreign-funcall "memcpy"
121 :pointer (cffi:inc-pointer dst-ptr (* row row-bytes))
122 :pointer tmp
123 :unsigned-long expanded-bytes
124 :pointer))))))))))