Monorepo for Aesthetic.Computer
aesthetic.computer
cl: simplify main loop for first boot test (10s color cycle)
+50
-49
+50
-49
fedac/native/cl/main.lisp
+50
-49
fedac/native/cl/main.lisp
···
1
1
;;; Main entry point — AC Native OS (Common Lisp edition)
2
+
;;; First boot: just show a colored screen to prove DRM works
2
3
3
4
(in-package :ac-native)
4
5
···
7
8
(defun compute-pixel-scale (display-w)
8
9
"Compute pixel scale targeting ~300px wide."
9
10
(let ((target (max 1 (min 16 (floor display-w 300)))))
10
-
;; Prefer clean divisors within ±3
11
11
(loop for delta from 0 to 3 do
12
12
(let ((s (+ target delta)))
13
-
(when (and (>= s 1) (<= s 16)
14
-
(zerop (mod display-w s)))
13
+
(when (and (>= s 1) (<= s 16) (zerop (mod display-w s)))
15
14
(return-from compute-pixel-scale s)))
16
15
(let ((s (- target delta)))
17
-
(when (and (>= s 1)
18
-
(zerop (mod display-w s)))
16
+
(when (and (>= s 1) (zerop (mod display-w s)))
19
17
(return-from compute-pixel-scale s))))
20
18
target))
21
19
22
-
(defun mount-minimal-fs ()
23
-
"Mount essential pseudo-filesystems (PID 1 only)."
24
-
(ac-native.syscalls:sys-mount "proc" "/proc" "proc")
25
-
(ac-native.syscalls:sys-mount "sysfs" "/sys" "sysfs")
26
-
(ac-native.syscalls:sys-mount "devtmpfs" "/dev" "devtmpfs")
27
-
(ac-log "mounted proc, sysfs, devtmpfs~%"))
28
-
29
20
(defun main ()
30
21
"AC Native OS entry point."
31
-
(ac-log "~%═══════════════════════════════════════~%")
32
-
(ac-log " AC Native OS (Common Lisp)~%")
33
-
(ac-log " SBCL ~A~%" (lisp-implementation-version))
34
-
(ac-log "═══════════════════════════════════════~%~%")
35
-
36
-
;; PID 1 duties
37
-
(when (= (ac-native.syscalls:sys-getpid) 1)
38
-
(mount-minimal-fs))
22
+
;; Log to stderr (visible on serial console)
23
+
(format *error-output* "~%════════════════════════════════════~%")
24
+
(format *error-output* " AC Native OS (Common Lisp)~%")
25
+
(format *error-output* " SBCL ~A~%" (lisp-implementation-version))
26
+
(format *error-output* "════════════════════════════════════~%~%")
27
+
(force-output *error-output*)
39
28
40
-
;; Init display
41
-
(let ((display (ac-native.drm:drm-init)))
29
+
;; Try to init display
30
+
(let ((display (handler-case (ac-native.drm:drm-init)
31
+
(error (e)
32
+
(format *error-output* "[cl] DRM init error: ~A~%" e)
33
+
(force-output *error-output*)
34
+
nil))))
42
35
(unless display
43
-
(ac-log "FATAL: no display~%")
36
+
(format *error-output* "[cl] FATAL: no display — sleeping 30s~%")
37
+
(force-output *error-output*)
38
+
(sleep 30)
44
39
(return-from main 1))
45
40
46
41
(let* ((dw (ac-native.drm:display-width display))
···
51
46
(screen (fb-create sw sh))
52
47
(graph (make-graph :fb screen :screen screen)))
53
48
54
-
(ac-log "display: ~Dx~D scale: ~D screen: ~Dx~D~%"
49
+
(format *error-output* "[cl] display: ~Dx~D scale: ~D screen: ~Dx~D~%"
55
50
dw dh scale sw sh)
51
+
(force-output *error-output*)
56
52
57
-
;; Main loop
53
+
;; Main loop — just cycle colors
58
54
(setf *running* t)
59
-
(unwind-protect
60
-
(loop while *running* do
61
-
;; TODO: input-poll
62
-
;; TODO: js-call-act
63
-
;; TODO: js-call-sim
55
+
(let ((frame 0))
56
+
(unwind-protect
57
+
(loop while *running* do
58
+
(incf frame)
59
+
;; Cycle background
60
+
(let* ((t-val (* frame 0.02))
61
+
(r (floor (+ 40 (* 40 (sin t-val)))))
62
+
(g (floor (+ 20 (* 20 (sin (* t-val 1.3))))))
63
+
(b (floor (+ 80 (* 80 (sin (* t-val 0.7)))))))
64
+
(graph-wipe graph (make-color :r r :g g :b b))
65
+
66
+
;; White box in center
67
+
(graph-ink graph (make-color :r 255 :g 255 :b 255 :a 200))
68
+
(graph-box graph (- (floor sw 2) 30) (- (floor sh 2) 30) 60 60)
69
+
70
+
;; Orange circle
71
+
(graph-ink graph (make-color :r 255 :g 140 :b 50))
72
+
(graph-circle graph (floor sw 2) (floor sh 2) 20))
64
73
65
-
;; Demo: cycle background color
66
-
(let* ((t-ms (monotonic-time-ms))
67
-
(r (floor (+ 128 (* 127 (sin (* t-ms 0.001))))))
68
-
(g (floor (+ 128 (* 127 (sin (* t-ms 0.0013))))))
69
-
(b (floor (+ 128 (* 127 (sin (* t-ms 0.0017)))))))
70
-
(graph-wipe graph (make-color :r r :g g :b b))
71
-
;; Draw a box in the center
72
-
(graph-ink graph (make-color :r 255 :g 255 :b 255 :a 200))
73
-
(graph-box graph (- (floor sw 2) 20) (- (floor sh 2) 20) 40 40)
74
-
;; Draw a circle
75
-
(graph-ink graph (make-color :r 255 :g 100 :b 50))
76
-
(graph-circle graph (floor sw 2) (floor sh 2) 15))
74
+
;; Present
75
+
(ac-native.drm:drm-present display screen scale)
76
+
(frame-sync-60fps)
77
77
78
-
;; Present
79
-
(ac-native.drm:drm-present display screen scale)
80
-
(frame-sync-60fps))
78
+
;; Exit after 10 seconds (for testing)
79
+
(when (> frame 600)
80
+
(setf *running* nil)))
81
81
82
-
;; Cleanup
83
-
(fb-destroy screen)
84
-
(ac-native.drm:drm-destroy display)
85
-
(ac-log "shutdown complete~%")))))
82
+
;; Cleanup
83
+
(fb-destroy screen)
84
+
(ac-native.drm:drm-destroy display)
85
+
(format *error-output* "[cl] shutdown~%")
86
+
(force-output *error-output*))))))