starting beepy

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))))))

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)"