commit fac3a22dfe0edc762f3e04aea9ebf677a56d1552 Author: Kyle Isom Date: Thu Apr 10 15:32:11 2025 -0700 starting beepy diff --git a/beepy.lisp b/beepy.lisp new file mode 100644 index 0000000..a375332 --- /dev/null +++ b/beepy.lisp @@ -0,0 +1,128 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (ql:quickload '(:with-user-abort :uiop :adopt) :silent t)) + + +(defpackage :beepy + (:use :cl) + (:export :toplevel *ui*)) + +(in-package :beepy) + +;;;; Configuration ----------------------------------------------- +(defparameter *sysfs-firmware* #P "/sys/firmware/beepy") + +;;;; Errors ------------------------------------------------------ +(define-condition user-error (error) ()) + +(define-condition bad-path (user-error) () + (:report "sysfs interface doesn't exist")) +;; +;; (define-condition write-error (user-error) () +;; (:report "Writing.")) + + +;;;; Down to business -------------------------------------------- + +(defun write-to-file (pathname val) + () + (with-open-file)) + +(defun beepberry (arg) + (let ((subsystem (car arg)) + (args (cdr arg))) + (case subsystem + ;; turn LED on or off + (:led nil) + + ;; set the color of the LED + (:rgb nil) + + ;; keeb is lit + (:kbl nil) + + ;; battery info + (:batt nil) + + ;; firmware version + (:fw-version nil) + + ;; not handled: + ;; - fw_update + ;; - last_keypress + ;; - rewake_timer + ;; - startup_reason + ) + )) + +#| +battery_percent fw_version led_blue startup_reason +battery_raw keyboard_backlight led_green +battery_volts last_keypress led_red +fw_update led rewake_timer + +|# + + +(defun run (arguments) + (format t "arguments: ~a~%" arguments) +; (map nil #'beepberry arguments) + ) + +;;;; User Interface ---------------------------------------------- +(defmacro exit-on-ctrl-c (&body body) + `(handler-case (with-user-abort:with-user-abort (progn ,@body)) + (with-user-abort:user-abort () (sb-ext:exit :code 130)))) + +(defparameter *option-help* + (adopt:make-option 'help + :help "Display help and exit." + :long "help" + :short #\h + :reduce (constantly t))) + +(defparameter *option-firmware-path* + (adopt:make-option 'sysfs-path + :parameter "STRING" + :help "Look for the sysfs interface at path" + :manual (format nil "~ + This must be a path to a valid beepy sysfs. The default is ~a." + *sysfs-firmware*) + :long "path" + :short #\p + :initial-value *sysfs-firmware* + :key #'make-pathname + :reduce #'adopt:collect)) + +(adopt:define-string *help-text* + "beepy takes commands, each of which is a list. For example, + '(:led t) (:rgb 127 0 0).") + +(adopt:define-string *extra-manual-text* "") + +(defparameter *examples* + '(("Turn the LED on, showing red:" + . "'(:led t) '(:rgb 127") + ("Turn the LED on, showing green (alternate syntax):" + . "'(:led t) '(:rgb :green)") + ("Return the firmware version:" + . "'(:fw-version)"))) + +(defparameter *ui* + (adopt:make-interface + :name "beepy" + :usage "[OPTIONS] commands..." + :summary "interface with beepy's sysfs interface" + :help *help-text* + :manual (format nil "~A~2%~A" *help-text* *extra-manual-text*) + :examples *examples* + :contents (list + *option-help* + *option-firmware-path*))) + +(defun toplevel () + (sb-ext:disable-debugger) + (exit-on-ctrl-c + (multiple-value-bind (arguments options) (adopt:parse-options-or-exit *ui*) + … ; Handle options. + (handler-case (run arguments) + (user-error (e) (adopt:print-error-and-exit e)))))) diff --git a/build-binary.sh b/build-binary.sh new file mode 100755 index 0000000..46e7e5b --- /dev/null +++ b/build-binary.sh @@ -0,0 +1,13 @@ +#!/usr/bin/env bash + +set -euo pipefail + +LISP=$1 +NAME=$(basename "$1" .lisp) +shift + +sbcl --load "$LISP" \ + --eval "(sb-ext:save-lisp-and-die \"$NAME\" + :executable t + :save-runtime-options t + :toplevel '$NAME:toplevel)"