Monorepo for Aesthetic.Computer
aesthetic.computer
feat(cl): wire QuickJS bridge into CL main loop
- CFFI callbacks for wipe/ink/line/box/circle/plot/write/synth/jump/poweroff
- main-js: full piece runner — init QuickJS, load .mjs, drive lifecycle
- main dispatches: .mjs arg → QuickJS bridge, else → native CL notepat
- ESC triple-press and power button still work in JS mode
- Swank REPL available alongside JS pieces
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
+265
-5
+142
-4
fedac/native/cl/js-bridge.lisp
+142
-4
fedac/native/cl/js-bridge.lisp
···
18
18
(defvar *has-act* nil)
19
19
(defvar *has-sim* nil)
20
20
21
+
;;; ── CFFI callbacks (called from JS via quickjs-shim) ──
22
+
;;; These use the QuickJS JSCFunction signature:
23
+
;;; JSValue callback(JSContext *ctx, JSValueConst this_val, int argc, JSValueConst *argv)
24
+
25
+
(defvar *jump-target* nil "Piece name to jump to (set by system.jump).")
26
+
(defvar *poweroff-requested* nil "Set to T when JS calls system.poweroff().")
27
+
28
+
(cffi:defcallback cl-wipe :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
29
+
(declare (ignore this))
30
+
(let ((r (ac-native.quickjs:qjs-arg-int ctx argv 0))
31
+
(g (ac-native.quickjs:qjs-arg-int ctx argv 1))
32
+
(b (ac-native.quickjs:qjs-arg-int ctx argv 2)))
33
+
(declare (ignore argc))
34
+
(ac-native.graph:graph-wipe *graph* (ac-native.color:make-color :r r :g g :b b))
35
+
0)) ; JS_UNDEFINED
36
+
37
+
(cffi:defcallback cl-ink :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
38
+
(declare (ignore this))
39
+
(let ((r (ac-native.quickjs:qjs-arg-int ctx argv 0))
40
+
(g (ac-native.quickjs:qjs-arg-int ctx argv 1))
41
+
(b (ac-native.quickjs:qjs-arg-int ctx argv 2))
42
+
(a (if (> argc 3) (ac-native.quickjs:qjs-arg-int ctx argv 3) 255)))
43
+
(ac-native.graph:graph-ink *graph* (ac-native.color:make-color :r r :g g :b b :a a))
44
+
0))
45
+
46
+
(cffi:defcallback cl-line :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
47
+
(declare (ignore this argc))
48
+
(let ((x1 (ac-native.quickjs:qjs-arg-int ctx argv 0))
49
+
(y1 (ac-native.quickjs:qjs-arg-int ctx argv 1))
50
+
(x2 (ac-native.quickjs:qjs-arg-int ctx argv 2))
51
+
(y2 (ac-native.quickjs:qjs-arg-int ctx argv 3)))
52
+
(ac-native.graph:graph-line *graph* x1 y1 x2 y2)
53
+
0))
54
+
55
+
(cffi:defcallback cl-box :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
56
+
(declare (ignore this argc))
57
+
(let ((x (ac-native.quickjs:qjs-arg-int ctx argv 0))
58
+
(y (ac-native.quickjs:qjs-arg-int ctx argv 1))
59
+
(w (ac-native.quickjs:qjs-arg-int ctx argv 2))
60
+
(h (ac-native.quickjs:qjs-arg-int ctx argv 3)))
61
+
(ac-native.graph:graph-box *graph* x y w h)
62
+
0))
63
+
64
+
(cffi:defcallback cl-circle :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
65
+
(declare (ignore this argc))
66
+
(let ((x (ac-native.quickjs:qjs-arg-int ctx argv 0))
67
+
(y (ac-native.quickjs:qjs-arg-int ctx argv 1))
68
+
(r (ac-native.quickjs:qjs-arg-int ctx argv 2)))
69
+
(ac-native.graph:graph-circle *graph* x y r)
70
+
0))
71
+
72
+
(cffi:defcallback cl-plot :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
73
+
(declare (ignore this argc))
74
+
(let ((x (ac-native.quickjs:qjs-arg-int ctx argv 0))
75
+
(y (ac-native.quickjs:qjs-arg-int ctx argv 1)))
76
+
(ac-native.graph:graph-plot *graph* x y)
77
+
0))
78
+
79
+
(cffi:defcallback cl-write :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
80
+
(declare (ignore this argc))
81
+
(let ((text (ac-native.quickjs:qjs-arg-string ctx argv 0))
82
+
(x (ac-native.quickjs:qjs-arg-int ctx argv 1))
83
+
(y (ac-native.quickjs:qjs-arg-int ctx argv 2)))
84
+
(ac-native.font:font-draw *graph* text x y)
85
+
0))
86
+
87
+
(cffi:defcallback cl-screen-w :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
88
+
(declare (ignore ctx this argc argv))
89
+
;; Return screen width as NaN-boxed int — use shim helper instead
90
+
0)
91
+
92
+
(cffi:defcallback cl-screen-h :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
93
+
(declare (ignore ctx this argc argv))
94
+
0)
95
+
96
+
(cffi:defcallback cl-synth :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
97
+
(declare (ignore this argc))
98
+
(when *audio*
99
+
(let ((type (ac-native.quickjs:qjs-arg-int ctx argv 0))
100
+
(freq (ac-native.quickjs:qjs-arg-float ctx argv 1))
101
+
(vol (ac-native.quickjs:qjs-arg-float ctx argv 2))
102
+
(dur (ac-native.quickjs:qjs-arg-float ctx argv 3))
103
+
(attack (ac-native.quickjs:qjs-arg-float ctx argv 4))
104
+
(decay (ac-native.quickjs:qjs-arg-float ctx argv 5))
105
+
(pan (ac-native.quickjs:qjs-arg-float ctx argv 6)))
106
+
(ac-native.audio:audio-synth *audio*
107
+
:type type :tone freq :volume vol
108
+
:duration dur :attack attack :decay decay
109
+
:pan pan)))
110
+
0)
111
+
112
+
(cffi:defcallback cl-synth-kill :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
113
+
(declare (ignore this argc))
114
+
(when *audio*
115
+
(let ((id (ac-native.quickjs:qjs-arg-int ctx argv 0)))
116
+
(ac-native.audio:audio-synth-kill *audio* id)))
117
+
0)
118
+
119
+
(cffi:defcallback cl-log :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
120
+
(declare (ignore this argc))
121
+
(let ((msg (ac-native.quickjs:qjs-arg-string ctx argv 0)))
122
+
(format *error-output* "[js] ~A~%" msg)
123
+
(force-output *error-output*))
124
+
0)
125
+
126
+
(cffi:defcallback cl-jump :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
127
+
(declare (ignore this argc))
128
+
(let ((piece (ac-native.quickjs:qjs-arg-string ctx argv 0)))
129
+
(setf *jump-target* piece)
130
+
(format *error-output* "[js-bridge] jump → ~A~%" piece)
131
+
(force-output *error-output*))
132
+
0)
133
+
134
+
(cffi:defcallback cl-poweroff :uint64 ((ctx :pointer) (this :uint64) (argc :int) (argv :pointer))
135
+
(declare (ignore ctx this argc argv))
136
+
(setf *poweroff-requested* t)
137
+
0)
138
+
21
139
;;; ── Initialize QuickJS and register the API ──
22
140
23
141
(defun js-init (graph fb audio screen-w screen-h)
···
26
144
*fb* fb
27
145
*audio* audio
28
146
*screen-w* screen-w
29
-
*screen-h* screen-h)
147
+
*screen-h* screen-h
148
+
*jump-target* nil
149
+
*poweroff-requested* nil)
30
150
(setf *rt* (ac-native.quickjs:js-new-runtime))
31
151
(setf *ctx* (ac-native.quickjs:js-new-context *rt*))
32
-
;; Register the API bootstrap code
152
+
;; Register native callbacks
153
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_wipe" (cffi:callback cl-wipe) 3)
154
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_ink" (cffi:callback cl-ink) 4)
155
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_line" (cffi:callback cl-line) 4)
156
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_box" (cffi:callback cl-box) 4)
157
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_circle" (cffi:callback cl-circle) 3)
158
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_plot" (cffi:callback cl-plot) 2)
159
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_write" (cffi:callback cl-write) 3)
160
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_screen_w" (cffi:callback cl-screen-w) 0)
161
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_screen_h" (cffi:callback cl-screen-h) 0)
162
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_synth" (cffi:callback cl-synth) 7)
163
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_synth_kill" (cffi:callback cl-synth-kill) 2)
164
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_log" (cffi:callback cl-log) 1)
165
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_jump" (cffi:callback cl-jump) 1)
166
+
(ac-native.quickjs:qjs-register-func *ctx* "__cl_poweroff" (cffi:callback cl-poweroff) 0)
167
+
;; Set screen dimensions
168
+
(ac-native.quickjs:qjs-set-global-int *ctx* "__screen_w" screen-w)
169
+
(ac-native.quickjs:qjs-set-global-int *ctx* "__screen_h" screen-h)
170
+
;; Eval the API bootstrap JS
33
171
(let ((api-code (build-api-js)))
34
172
(ac-native.quickjs:qjs-eval *ctx* api-code (length api-code) "<api-init>" 0))
35
-
(format *error-output* "[js-bridge] QuickJS initialized~%")
173
+
(format *error-output* "[js-bridge] QuickJS initialized (~Dx~D)~%" screen-w screen-h)
36
174
(force-output *error-output*))
37
175
38
176
(defun js-destroy ()
···
164
302
if (opts && typeof opts === 'object') { x = opts.x || 0; y = opts.y || 0; }
165
303
__cl_write(String(text), x, y);
166
304
},
167
-
screen: { get width() { return __cl_screen_w(); }, get height() { return __cl_screen_h(); } },
305
+
screen: { get width() { return __screen_w; }, get height() { return __screen_h; } },
168
306
event: makeEvent(),
169
307
paintCount: 0,
170
308
num: {
+123
-1
fedac/native/cl/main.lisp
+123
-1
fedac/native/cl/main.lisp
···
161
161
((and (>= hour 12) (< hour 17)) "good afternoon")
162
162
(t "good evening"))))
163
163
164
+
;;; ── JS Piece Runner ──
165
+
166
+
(defun main-js (piece-path)
167
+
"Run a .mjs piece via the QuickJS bridge."
168
+
(format *error-output* "~%════════════════════════════════════~%")
169
+
(format *error-output* " AC Native OS (Common Lisp + QuickJS)~%")
170
+
(format *error-output* " SBCL ~A~%" (lisp-implementation-version))
171
+
(format *error-output* " piece: ~A~%" piece-path)
172
+
(format *error-output* "════════════════════════════════════~%~%")
173
+
(force-output *error-output*)
174
+
175
+
(let ((display (handler-case (ac-native.drm:drm-init)
176
+
(error (e)
177
+
(format *error-output* "[js] DRM error: ~A~%" e)
178
+
(force-output *error-output*) nil))))
179
+
(unless display
180
+
(format *error-output* "[js] FATAL: no display~%")
181
+
(force-output *error-output*) (sleep 30) (return-from main-js 1))
182
+
183
+
(let* ((dw (ac-native.drm:display-width display))
184
+
(dh (ac-native.drm:display-height display))
185
+
(scale (compute-pixel-scale dw))
186
+
(sw (floor dw scale))
187
+
(sh (floor dh scale))
188
+
(screen (fb-create sw sh))
189
+
(graph (make-graph :fb screen :screen screen))
190
+
(input (ac-native.input:input-init dw dh scale))
191
+
(audio (ac-native.audio:audio-init))
192
+
(frame 0))
193
+
194
+
(font-init)
195
+
196
+
;; Initialize QuickJS bridge
197
+
(js-init graph screen audio sw sh)
198
+
199
+
;; Load the piece
200
+
(unless (js-load-piece piece-path)
201
+
(format *error-output* "[js] Failed to load piece, falling back to native notepat~%")
202
+
(force-output *error-output*)
203
+
(js-destroy)
204
+
;; Cleanup and fall through to native
205
+
(when audio (audio-destroy audio))
206
+
(ac-native.input:input-destroy input)
207
+
(fb-destroy screen)
208
+
(ac-native.drm:drm-destroy display)
209
+
(return-from main-js (main)))
210
+
211
+
;; Call boot
212
+
(js-boot)
213
+
214
+
;; Start Swank
215
+
(handler-case
216
+
(progn
217
+
(setf swank::*communication-style* :spawn)
218
+
(swank:create-server :port 4005 :dont-close t)
219
+
(format *error-output* "[js] Swank on :4005~%")
220
+
(force-output *error-output*))
221
+
(error (e)
222
+
(format *error-output* "[js] Swank failed: ~A~%" e)
223
+
(force-output *error-output*)))
224
+
225
+
;; Main loop
226
+
(setf *running* t)
227
+
(unwind-protect
228
+
(loop while *running* do
229
+
(incf frame)
230
+
231
+
;; Input → act
232
+
(dolist (ev (ac-native.input:input-poll input))
233
+
(let ((type (ac-native.input:event-type ev))
234
+
(code (ac-native.input:event-code ev))
235
+
(key (ac-native.input:event-key ev)))
236
+
;; ESC triple-press to quit
237
+
(when (and (eq type :key-down) (= code ac-native.input:+key-esc+))
238
+
(when (> (- frame *esc-last-frame*) 90) (setf *esc-count* 0))
239
+
(incf *esc-count*)
240
+
(setf *esc-last-frame* frame)
241
+
(when (>= *esc-count* 3) (setf *running* nil)))
242
+
;; Power button
243
+
(when (and (eq type :key-down) (= code ac-native.input:+key-power+))
244
+
(setf *running* nil))
245
+
;; Pass to JS
246
+
(js-act (if (eq type :key-down) 1 0)
247
+
(or key "") code)))
248
+
249
+
;; sim
250
+
(js-sim)
251
+
252
+
;; paint
253
+
(js-paint frame)
254
+
255
+
;; Check for jump or poweroff from JS
256
+
(when ac-native.js-bridge::*poweroff-requested*
257
+
(setf *running* nil))
258
+
(when ac-native.js-bridge::*jump-target*
259
+
;; TODO: reload piece
260
+
(format *error-output* "[js] jump to ~A (not yet implemented)~%"
261
+
ac-native.js-bridge::*jump-target*)
262
+
(force-output *error-output*)
263
+
(setf ac-native.js-bridge::*jump-target* nil))
264
+
265
+
;; Present
266
+
(ac-native.drm:drm-present display screen scale)
267
+
(frame-sync-60fps))
268
+
269
+
;; Cleanup
270
+
(js-destroy)
271
+
(when audio (audio-destroy audio))
272
+
(ac-native.input:input-destroy input)
273
+
(fb-destroy screen)
274
+
(ac-native.drm:drm-destroy display)
275
+
(format *error-output* "[js] shutdown~%")
276
+
(force-output *error-output*)))))
277
+
164
278
;;; ── Main ──
165
279
166
280
(defun main ()
167
-
"AC Native OS entry point — boots directly into notepat."
281
+
"AC Native OS entry point. Runs .mjs pieces via QuickJS or native CL notepat."
282
+
;; Check command-line args for a .mjs piece path
283
+
(let ((args (uiop:command-line-arguments)))
284
+
(when args
285
+
(let ((piece-path (first args)))
286
+
(when (and piece-path (search ".mjs" piece-path))
287
+
(return-from main (main-js piece-path))))))
288
+
289
+
;; No .mjs piece specified — fall back to native CL notepat
168
290
(format *error-output* "~%════════════════════════════════════~%")
169
291
(format *error-output* " notepat (Common Lisp)~%")
170
292
(format *error-output* " SBCL ~A~%" (lisp-implementation-version))