1.1--- a/lisp/lib/cli/cli.asd Thu Mar 21 22:42:46 2024 -0400
1.2+++ b/lisp/lib/cli/cli.asd Fri Mar 22 23:41:48 2024 -0400
1.3@@ -5,12 +5,12 @@
1.4 (:file "ansi" :depends-on ("pkg"))
1.5 (:file "env" :depends-on ("pkg"))
1.6 (:file "shell" :depends-on ("env"))
1.7- (:file "clap" :depends-on ("pkg" "shell" "ansi"))
1.8 (:file "progress" :depends-on ("pkg"))
1.9 (:file "spark" :depends-on ("pkg"))
1.10 (:file "repl" :depends-on ("pkg"))
1.11- (:file "prompt" :depends-on ("pkg" "env" "ansi"))
1.12- (:file "ed" :depends-on ("pkg" "env")))
1.13+ (:file "prompt" :depends-on ("env" "ansi"))
1.14+ (:file "ed" :depends-on ("env"))
1.15+ (:file "clap" :depends-on ("shell" "progress" "spark" "repl" "prompt" "ed")))
1.16 :in-order-to ((test-op (test-op "cli/tests"))))
1.17
1.18 (defsystem :cli/tests
2.1--- a/lisp/lib/cli/pkg.lisp Thu Mar 21 22:42:46 2024 -0400
2.2+++ b/lisp/lib/cli/pkg.lisp Fri Mar 22 23:41:48 2024 -0400
2.3@@ -18,8 +18,83 @@
2.4 ;; install-ir, etc.
2.5
2.6 ;;; Code:
2.7-(uiop:define-package :cli
2.8- (:use :cl :std :log :sb-ext)
2.9+(defpackage :cli/shell
2.10+ (:use :cl :std)
2.11+ (:nicknames :shell))
2.12+
2.13+(defpackage :cli/ansi
2.14+ (:use :cl :std)
2.15+ (:nicknames :ansi)
2.16+ (:export
2.17+ ;; ESC sequences
2.18+ :.ris :reset-to-initial-state
2.19+ ;; CSI sequences
2.20+ ;; Cursor control
2.21+ :.cuu :cursor-up
2.22+ :.cud :cursor-down
2.23+ :.cuf :cursor-forward
2.24+ :.cub :cursor-backward
2.25+ :.cnl :cursor-next-line
2.26+ :.cpl :cursor-preceding-line
2.27+ :.cha :cursor-horizontal-absolute
2.28+ :.cup :cursor-position
2.29+ :.vpa :vertical-position-absolute
2.30+ :.vpr :vertical-position-relative
2.31+ :.vpb :vertical-position-backward
2.32+ :.scosc :save-cursor-position
2.33+ :.scorc :restore-cursor-position
2.34+ :.ed :erase-in-display :erase-below :erase-above :erase :erase-saved-lines
2.35+ :.el :erase-in-line :erase-right :erase-left :erase-line
2.36+ :.sgr :select-graphic-rendition
2.37+ :.dsr :device-status-report
2.38+ ;; DEC private mode set and reset
2.39+ :.decset :dec-private-mode-set
2.40+ :.decrst :dec-private-mode-reset
2.41+ :show-cursor :hide-cursor
2.42+ :use-alternate-screen-buffer :use-normal-screen-buffer
2.43+ ;; common
2.44+ :clear
2.45+ :home
2.46+ ;; stty
2.47+ :set-tty-mode))
2.48+
2.49+(defpackage :cli/prompt
2.50+ (:use :cl :std)
2.51+ (:export
2.52+ :completing-read
2.53+ :defprompt))
2.54+
2.55+(defpackage :cli/progress
2.56+ (:use :cl :std)
2.57+ (:export
2.58+ :update-progress
2.59+ :with-progress-bar
2.60+ :*progress-bar*
2.61+ :*progress-bar-enabled*
2.62+ :start-progress-display
2.63+ :finish-progress-display
2.64+ :progress-mutex
2.65+ :uncertain-size-progress-bar
2.66+ :progress-bar))
2.67+
2.68+(defpackage :cli/spark
2.69+ (:use :cl :std)
2.70+ (:export
2.71+ :spark :*ticks*
2.72+ :vspark :*vticks*))
2.73+
2.74+(defpackage :cli/repl
2.75+ (:use :cl :std :cli/progress :cli/spark #+readline :cl-readline)
2.76+ (:export :load-acl-repl :start-rl-repl))
2.77+
2.78+(defpackage :cli/ed
2.79+ (:use :cl :std)
2.80+ (:export :run-emacs :run-emacsclient
2.81+ :org-store-link))
2.82+
2.83+(defpackage :cli/clap
2.84+ (:nicknames :clap)
2.85+ (:use :cl :std :log :sb-ext)
2.86 (:import-from :uiop :println)
2.87 (:import-from :sb-ext :parse-native-namestring)
2.88 (:shadowing-import-from :sb-ext :exit)
2.89@@ -109,76 +184,11 @@
2.90 :cli-version
2.91 :cli-usage))
2.92
2.93-(defpackage :cli/shell
2.94- (:use :cl :std)
2.95- (:nicknames :shell))
2.96+(uiop:define-package :cli
2.97+ (:use :cl :std)
2.98+ (:use-reexport :cli/shell :cli/ansi :cli/prompt
2.99+ :cli/progress :cli/spark :cli/prompt :cli/ed
2.100+ :cli/repl :cli/clap))
2.101
2.102-(defpackage :cli/ansi
2.103- (:use :cl :std)
2.104- (:nicknames :ansi)
2.105- (:export
2.106- ;; ESC sequences
2.107- :.ris :reset-to-initial-state
2.108- ;; CSI sequences
2.109- ;; Cursor control
2.110- :.cuu :cursor-up
2.111- :.cud :cursor-down
2.112- :.cuf :cursor-forward
2.113- :.cub :cursor-backward
2.114- :.cnl :cursor-next-line
2.115- :.cpl :cursor-preceding-line
2.116- :.cha :cursor-horizontal-absolute
2.117- :.cup :cursor-position
2.118- :.vpa :vertical-position-absolute
2.119- :.vpr :vertical-position-relative
2.120- :.vpb :vertical-position-backward
2.121- :.scosc :save-cursor-position
2.122- :.scorc :restore-cursor-position
2.123- :.ed :erase-in-display :erase-below :erase-above :erase :erase-saved-lines
2.124- :.el :erase-in-line :erase-right :erase-left :erase-line
2.125- :.sgr :select-graphic-rendition
2.126- :.dsr :device-status-report
2.127- ;; DEC private mode set and reset
2.128- :.decset :dec-private-mode-set
2.129- :.decrst :dec-private-mode-reset
2.130- :show-cursor :hide-cursor
2.131- :use-alternate-screen-buffer :use-normal-screen-buffer
2.132- ;; common
2.133- :clear
2.134- :home
2.135- ;; stty
2.136- :set-tty-mode))
2.137-
2.138-(defpackage :cli/prompt
2.139- (:use :cl :std)
2.140- (:export
2.141- :completing-read
2.142- :defprompt))
2.143-
2.144-(defpackage :cli/progress
2.145- (:use :cl :std)
2.146- (:export
2.147- :update-progress
2.148- :with-progress-bar
2.149- :*progress-bar*
2.150- :*progress-bar-enabled*
2.151- :start-progress-display
2.152- :finish-progress-display
2.153- :progress-mutex
2.154- :uncertain-size-progress-bar
2.155- :progress-bar))
2.156-
2.157-(defpackage :cli/spark
2.158- (:use :cl :std)
2.159- (:export
2.160- :spark :*ticks*
2.161- :vspark :*vticks*))
2.162-
2.163-(defpackage :cli/repl
2.164- (:use :cl :std :cli :cli/progress :cli/spark #+readline :cl-readline)
2.165- (:export :load-acl-repl :start-rl-repl))
2.166-
2.167-(defpackage :cli/ed
2.168- (:use :cl :std :cli)
2.169- (:export :run-emacs :run-emacsclient
2.170- :org-store-link))
2.171+(defpackage :cli-user
2.172+ (:use :cl :std :cli))
3.1--- a/lisp/lib/dat/dat.asd Thu Mar 21 22:42:46 2024 -0400
3.2+++ b/lisp/lib/dat/dat.asd Fri Mar 22 23:41:48 2024 -0400
3.3@@ -16,6 +16,7 @@
3.4 (:file "fixml")))
3.5 (:file "toml")
3.6 (:file "arff")
3.7+ (:file "midi")
3.8 #+nil (:file "bencode"))
3.9 :in-order-to ((test-op (test-op "dat/tests"))))
3.10
4.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
4.2+++ b/lisp/lib/dat/midi.lisp Fri Mar 22 23:41:48 2024 -0400
4.3@@ -0,0 +1,850 @@
4.4+;;; dat/midi.lisp --- MIDI data
4.5+
4.6+;;; (c) copyright 2003 by Mathieu Chabanne, Camille Constant,
4.7+;;; Emmanuel Necibar and Stephanie Recco
4.8+;;;
4.9+;;; (c) copyright 2003 by Robert Strandh (strandh@labri.fr)
4.10+;;;
4.11+;;; (c) copyright 2007 by David Lewis, Marcus Pearce, Christophe
4.12+;;; Rhodes and contributors
4.13+;;;
4.14+;;; This library is free software; you can redistribute it and/or
4.15+;;; modify it under the terms of version 2 of the GNU Lesser General
4.16+;;; Public License as published by the Free Software Foundation.
4.17+;;;
4.18+;;; This library is distributed in the hope that it will be useful,
4.19+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
4.20+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
4.21+;;; Lesser General Public License for more details.
4.22+;;;
4.23+;;; You should have received a copy of the GNU Lesser General Public
4.24+;;; License along with this library; if not, write to the
4.25+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
4.26+;;; Boston, MA 02111-1307 USA.
4.27+;;;
4.28+;;; This file contains library for MIDI and Midifiles. Messages are
4.29+;;; represented as CLOS class instances in a class hierarchy that
4.30+;;; reflects interesting aspects of the messages themselves.
4.31+(in-package :dat/midi)
4.32+
4.33+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.34+;;;
4.35+;;; Midifile protocol
4.36+
4.37+(defgeneric midifile-format (midifile))
4.38+(defgeneric (setf midifile-format) (format midifile))
4.39+(defgeneric midifile-division (midifile))
4.40+(defgeneric midifile-tracks (midifile))
4.41+
4.42+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.43+;;;
4.44+;;; Message protocol
4.45+
4.46+(defgeneric message-time (message))
4.47+(defgeneric (setf message-time) (time message))
4.48+(defgeneric message-status (message))
4.49+(defgeneric message-channel (message))
4.50+(defgeneric message-key (message))
4.51+(defgeneric message-velocity (message))
4.52+(defgeneric message-tempo (message))
4.53+(defgeneric message-numerator (message))
4.54+(defgeneric message-denominator (message))
4.55+(defgeneric message-sf (message))
4.56+(defgeneric message-mi (message))
4.57+;; added 03-05-07
4.58+(defgeneric message-program (message))
4.59+
4.60+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.61+;;;
4.62+;;; File support
4.63+(eval-when (:compile-toplevel :load-toplevel)
4.64+ (defun string-code (s)
4.65+ "compute the ASCII-based numerical value of the string [warning:
4.66+works only if the chars are coded in ASCII]"
4.67+ (let ((v 0))
4.68+ (loop for i from 0 to (1- (length s))
4.69+ do (setf v (+ (* v 256) (char-code (aref s i)))))
4.70+ v)))
4.71+
4.72+(defconstant +header-mthd+ #.(string-code "MThd"))
4.73+(defconstant +header-mtrk+ #.(string-code "MTrk"))
4.74+(defconstant +header-mthd-length+ 6 "value of the header MThd data's length")
4.75+
4.76+(defparameter *midi-input* nil "stream for reading a Midifile")
4.77+(defparameter *input-buffer* '() "used for unreading bytes from *midi-input")
4.78+(defparameter *midi-output* nil "stream for writing a Midifile")
4.79+
4.80+(define-condition unknown-event ()
4.81+ ((status :initarg :status :reader status)
4.82+ (data-byte :initform "" :initarg :data-byte :reader data-byte))
4.83+ (:documentation "condition when the event does not exist in the library"))
4.84+
4.85+(define-condition header ()
4.86+ ((header-type :initarg :header :reader header-type))
4.87+ (:documentation "condition when the header is not correct"))
4.88+
4.89+(defun read-next-byte ()
4.90+ "read an unsigned 8-bit byte from *midi-input* checking for unread bytes"
4.91+ (if *input-buffer*
4.92+ (pop *input-buffer*)
4.93+ (read-byte *midi-input*)))
4.94+
4.95+(defun unread-byte (byte)
4.96+ "unread a byte from *midi-input*"
4.97+ (push byte *input-buffer*))
4.98+
4.99+(defun write-bytes (&rest bytes)
4.100+ "write an arbitrary number of bytes to *midi-output*"
4.101+ (mapc #'(lambda (byte) (write-byte byte *midi-output*)) bytes))
4.102+
4.103+(defun read-fixed-length-quantity (nb-bytes)
4.104+ "read an unsigned integer of nb-bytes bytes from *midi-input*"
4.105+ (loop with result = 0
4.106+ for i from 1 to nb-bytes
4.107+ do (setf result (logior (ash result 8) (read-next-byte)))
4.108+ finally (return result)))
4.109+
4.110+(defun write-fixed-length-quantity (quantity nb-bytes)
4.111+ "write an unsigned integer of nb-bytes bytes to *midi-output*"
4.112+ (unless (zerop nb-bytes)
4.113+ (write-fixed-length-quantity (ash quantity -8) (1- nb-bytes))
4.114+ (write-bytes (logand quantity #xff))))
4.115+
4.116+(defmacro with-midi-input ((pathname &rest open-args &key &allow-other-keys) &body body)
4.117+ "execute body with *midi-input* assigned to a stream from pathname"
4.118+ `(with-open-file (*midi-input* ,pathname
4.119+ :direction :input :element-type '(unsigned-byte 8)
4.120+ ,@open-args)
4.121+ ,@body))
4.122+
4.123+(defmacro with-midi-output ((pathname &rest open-args &key &allow-other-keys) &body body)
4.124+ "execute body with *midi-output* assigned to a stream from pathname"
4.125+ `(with-open-file (*midi-output* ,pathname
4.126+ :direction :output :element-type '(unsigned-byte 8)
4.127+ ,@open-args)
4.128+ ,@body))
4.129+
4.130+(defun read-variable-length-quantity ()
4.131+ "read a MIDI variable length quantity from *midi-input*"
4.132+ (loop with result = 0
4.133+ with byte
4.134+ do (setf byte (read-next-byte)
4.135+ result (logior (ash result 7) (logand byte #x7f)))
4.136+ until (< byte #x80)
4.137+ finally (return result)))
4.138+
4.139+(defun write-variable-length-quantity (quantity &optional (termination 0))
4.140+ (when (> quantity 127)
4.141+ (write-variable-length-quantity (ash quantity -7) #x80))
4.142+ (write-bytes (logior (logand quantity #x7f) termination)))
4.143+
4.144+(defun length-of-variables-length-quantity (quantity)
4.145+ (1+ (if (< quantity 128)
4.146+ 0
4.147+ (length-of-variables-length-quantity (ash quantity -7)))))
4.148+
4.149+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.150+;;;
4.151+;;; MIDI file representation
4.152+
4.153+(defclass midifile ()
4.154+ ((format :initarg :format :reader midifile-format)
4.155+ (division :initarg :division :reader midifile-division)
4.156+ (tracks :initarg :tracks :reader midifile-tracks))
4.157+ (:documentation "the class that represents a Midifile in core"))
4.158+
4.159+(defparameter *status* nil "the status while reading an event")
4.160+(defparameter *running-status* nil "the running status while reading an event")
4.161+(defparameter *dispatch-table* (make-array 256 :initial-element nil)
4.162+ "given values of status (and perhaps data1), find a class to create")
4.163+
4.164+(defun read-message ()
4.165+ "read a message without time indication from *midi-input*"
4.166+ (let ((classname-or-subtype (aref *dispatch-table* *status*)))
4.167+ (unless classname-or-subtype
4.168+ (error (make-condition 'unknown-event
4.169+ :status *status*)))
4.170+ (if (symbolp classname-or-subtype)
4.171+ (make-instance classname-or-subtype)
4.172+ (let* ((data-byte (read-next-byte))
4.173+ (classname (aref classname-or-subtype data-byte)))
4.174+ (unless classname
4.175+ (error (make-condition 'unknown-event
4.176+ :status *status*
4.177+ :data-byte data-byte)))
4.178+ (unread-byte data-byte)
4.179+ (make-instance classname)))))
4.180+
4.181+(defparameter *time* 0 "accumulated time from the start of the track")
4.182+
4.183+(defun read-timed-message ()
4.184+ "read a message preceded with a delta-time indication"
4.185+ (let ((delta-time (read-variable-length-quantity))
4.186+ (status-or-data (read-next-byte)))
4.187+ (if (>= status-or-data #x80)
4.188+ (progn (setf *status* status-or-data)
4.189+ (when (<= *status* #xef)
4.190+ (setf *running-status* *status*)))
4.191+ (progn (unread-byte status-or-data)
4.192+ (setf *status* *running-status*)))
4.193+ (let ((message (read-message)))
4.194+ (fill-message message)
4.195+ (setf (message-time message) (incf *time* delta-time))
4.196+ message)))
4.197+
4.198+(defun write-timed-message (message)
4.199+ "write a message preceded with a delta-time indication"
4.200+ (write-variable-length-quantity (- (message-time message) *time*))
4.201+ (setf *time* (message-time message))
4.202+ (write-message message))
4.203+
4.204+(defun read-track ()
4.205+ "read a track as a list of timed messages, excluding the end-of-track message"
4.206+ (let ((type (read-fixed-length-quantity 4))
4.207+ (length (read-fixed-length-quantity 4)))
4.208+ (declare (ignore length))
4.209+ (unless (= type +header-mtrk+)
4.210+ (error (make-condition 'header :header "MTrk")))
4.211+ (loop with message = nil
4.212+ do (setf message (read-timed-message))
4.213+ until (typep message 'end-of-track-message)
4.214+ collect message)))
4.215+
4.216+(defun write-track (track)
4.217+ "write a track (which does not contain the end-of-track message"
4.218+ (write-fixed-length-quantity +header-mtrk+ 4)
4.219+ (let ((end-of-track-message (make-instance 'end-of-track-message)))
4.220+ ;; write the length of the track
4.221+ (write-fixed-length-quantity
4.222+ (+ (reduce #'+ track :key #'length-message)
4.223+ (length-message end-of-track-message)
4.224+ (loop with time = *time*
4.225+ for message in track
4.226+ sum (prog1 (length-of-variables-length-quantity
4.227+ (- (message-time message) time))
4.228+ (setf time (message-time message))))
4.229+ 1) ; the delta time of the end-of-track message
4.230+ 4)
4.231+ (dolist (message track)
4.232+ (write-timed-message message))
4.233+ (setf (message-time end-of-track-message) *time*)
4.234+ (write-timed-message end-of-track-message)))
4.235+
4.236+(defun read-midi-file (filename)
4.237+ "read an entire Midifile from the file with name given as argument"
4.238+ (setf *time* 0)
4.239+ (with-midi-input (filename)
4.240+ (let ((type (read-fixed-length-quantity 4))
4.241+ (length (read-fixed-length-quantity 4))
4.242+ (format (read-fixed-length-quantity 2))
4.243+ (nb-tracks (read-fixed-length-quantity 2))
4.244+ (division (read-fixed-length-quantity 2)))
4.245+ (unless (and (= length +header-mthd-length+) (= type +header-mthd+))
4.246+ (error (make-condition 'header :header "MThd")))
4.247+ (make-instance 'midifile
4.248+ :format format
4.249+ :division division
4.250+ :tracks (loop repeat nb-tracks
4.251+ do (when (= format 1) (setf *time* 0))
4.252+ collect (read-track))))))
4.253+
4.254+(defun write-midi-file (midifile filename)
4.255+ (with-midi-output (filename :if-exists :supersede)
4.256+ (write-fixed-length-quantity +header-mthd+ 4)
4.257+ (write-fixed-length-quantity +header-mthd-length+ 4)
4.258+ (with-slots (format division tracks) midifile
4.259+ (write-fixed-length-quantity format 2)
4.260+ (write-fixed-length-quantity (length tracks) 2)
4.261+ (write-fixed-length-quantity division 2)
4.262+ (setf *time* 0)
4.263+ (loop for track in tracks do
4.264+ (write-track track)
4.265+ (when (= (slot-value midifile 'format) 1)
4.266+ (setf *time* 0))))))
4.267+
4.268+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.269+;;;
4.270+;;; Conversion routines
4.271+
4.272+(defun format1-tracks-to-format0-tracks (tracks)
4.273+ (list (reduce (lambda (t1 t2) (merge 'list t1 t2 #'< :key #'message-time))
4.274+ (copy-tree tracks))))
4.275+
4.276+(defun format0-tracks-to-format1-tracks (tracks)
4.277+ (assert (null (cdr tracks)))
4.278+ (let (tempo-map track)
4.279+ (dolist (message (car tracks) (list (nreverse tempo-map) (nreverse track)))
4.280+ (if (typep message 'tempo-map-message)
4.281+ (push message tempo-map)
4.282+ (push message track)))))
4.283+
4.284+(defun change-to-format-0 (midifile)
4.285+ (assert (= (midifile-format midifile) 1))
4.286+ (setf (slot-value midifile 'format) 0
4.287+ (slot-value midifile 'tracks) (format1-tracks-to-format0-tracks (midifile-tracks midifile))))
4.288+
4.289+(defun change-to-format-1 (midifile)
4.290+ (assert (= (midifile-format midifile) 0))
4.291+ (setf (slot-value midifile 'format) 1
4.292+ (slot-value midifile 'tracks) (format0-tracks-to-format1-tracks (midifile-tracks midifile))))
4.293+
4.294+(defmethod (setf midifile-format) (new-value midifile)
4.295+ (cond
4.296+ ((= (midifile-format midifile) new-value) new-value)
4.297+ ((and (= new-value 0) (= (midifile-format midifile) 1))
4.298+ (change-to-format-0 midifile)
4.299+ new-value)
4.300+ ((and (= new-value 1) (= (midifile-format midifile) 0))
4.301+ (change-to-format-1 midifile)
4.302+ new-value)
4.303+ (t (error "Unsupported conversion from format ~S to format ~S"
4.304+ (midifile-format midifile) new-value))))
4.305+
4.306+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.307+;;;
4.308+;;; Macro for defining midi messages
4.309+
4.310+(defparameter *status-min* (make-hash-table :test #'eq)
4.311+ "given a class name, find the minimum status value for the type of message")
4.312+(defparameter *status-max* (make-hash-table :test #'eq)
4.313+ "given a class name, find the maximum status value for the type of message")
4.314+(defparameter *data-min* (make-hash-table :test #'eq)
4.315+ "given a class name, find the minimum data1 value for the type of message")
4.316+(defparameter *data-max* (make-hash-table :test #'eq)
4.317+ "given a class name, find the maximum data1 value for the type of message")
4.318+
4.319+(defun register-class (class superclass status-min status-max data-min data-max)
4.320+ (unless status-min
4.321+ (setf status-min (gethash superclass *status-min*)))
4.322+ (unless status-max
4.323+ (setf status-max (gethash superclass *status-max*)))
4.324+ (unless data-min
4.325+ (setf data-min (gethash superclass *data-min*)))
4.326+ (unless data-max
4.327+ (setf data-max (gethash superclass *data-max*)))
4.328+ ;; set status values for this class
4.329+ (setf (gethash class *status-min*) status-min)
4.330+ (setf (gethash class *status-max*) status-max)
4.331+ (setf (gethash class *data-min*) data-min)
4.332+ (setf (gethash class *data-max*) data-max)
4.333+ ;; update the dispatch table
4.334+ (when status-min
4.335+ (if data-min
4.336+ (progn (unless (arrayp (aref *dispatch-table* status-min))
4.337+ (let ((secondary-dispatch (make-array 256
4.338+ :initial-element nil)))
4.339+ (loop for i from status-min to status-max do
4.340+ (setf (aref *dispatch-table* i) secondary-dispatch))))
4.341+ (loop for i from data-min to data-max do
4.342+ (setf (aref (aref *dispatch-table* status-min) i)
4.343+ class)))
4.344+ (loop for i from status-min to status-max do
4.345+ (setf (aref *dispatch-table* i)
4.346+ class)))))
4.347+
4.348+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.349+;;;
4.350+;;; main filler, length, and writer methods
4.351+
4.352+(defgeneric fill-message (message))
4.353+(defgeneric write-message (message))
4.354+(defgeneric length-message (message)
4.355+ (:method-combination +))
4.356+
4.357+(defmethod fill-message (message)
4.358+ (declare (ignore message))
4.359+ nil)
4.360+
4.361+(defmethod length-message + (message)
4.362+ (declare (ignore message))
4.363+ 0)
4.364+
4.365+(defmethod write-message (message)
4.366+ (declare (ignore message))
4.367+ nil)
4.368+
4.369+(defparameter *midi-channel* 0
4.370+ "Default MIDI channel for midi-messages for which status-min and status-max
4.371+have a difference of 15. When bound to an \(<= 0 integer 15\), the :status
4.372+default value will automatically combine the message's status-min and
4.373+*midi-channel*.")
4.374+
4.375+(defmacro define-midi-message (name superclasses
4.376+ &key slots filler (length 0) writer
4.377+ status-min status-max data-min data-max)
4.378+ `(progn
4.379+
4.380+ (register-class ',name ',(car superclasses)
4.381+ ,status-min ,status-max ,data-min ,data-max)
4.382+
4.383+ (defclass ,name ,superclasses
4.384+ ((status-min :initform ,status-min :allocation :class)
4.385+ (status-max :initform ,status-max :allocation :class)
4.386+ (data-min :initform ,data-min :allocation :class)
4.387+ (data-max :initform ,data-max :allocation :class)
4.388+ ,@slots)
4.389+ ,@(when (and (numberp status-min) (numberp status-max))
4.390+ (cond ((= status-min status-max)
4.391+ `((:default-initargs :status ,status-min)))
4.392+ ((= 15 (- status-max status-min))
4.393+ `((:default-initargs :status (if (and (integerp *midi-channel*)
4.394+ (<= 0 *midi-channel* 15))
4.395+ (logior ,(logand status-min status-max)
4.396+ *midi-channel*)
4.397+ (error "*midi-channel*=~A not supported"
4.398+ *midi-channel*))))))))
4.399+
4.400+ (defmethod fill-message :after ((message ,name))
4.401+ (with-slots ,(mapcar #'car slots) message
4.402+ (symbol-macrolet ((next-byte (read-next-byte)))
4.403+ ,filler)))
4.404+
4.405+ (defmethod length-message + ((message ,name))
4.406+ (with-slots (status-min status-max data-min data-max ,@(mapcar #'car slots))
4.407+ message
4.408+ ,length))
4.409+
4.410+ (defmethod write-message :after ((message ,name))
4.411+ (with-slots (status-min status-max data-min data-max ,@(mapcar #'car slots))
4.412+ message
4.413+ ,writer))))
4.414+
4.415+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.416+;;;
4.417+;;; midi messages
4.418+
4.419+(define-midi-message message ()
4.420+ :slots ((time :initarg :time :accessor message-time)
4.421+ (status :initarg :status :reader message-status :initform 0))
4.422+ :length 1
4.423+ :filler (setf status *status*)
4.424+ :writer (write-bytes status))
4.425+
4.426+(defgeneric print-midi-message (object stream)
4.427+ (:method ((object message) stream)
4.428+ (when (slot-boundp object 'time)
4.429+ (format stream " T=~A" (slot-value object 'time)))
4.430+ (when (slot-boundp object 'status)
4.431+ (format stream " S=~X" (slot-value object 'status))))
4.432+ (:documentation
4.433+ "One PRINT-OBJECT method is defined for the MIDI message class
4.434+\(common ancestor\): that method prints the wrapping, then calls
4.435+the PRINT-MIDI-MESSAGE method to print the slots."))
4.436+
4.437+(defmethod print-object ((obj message) stream)
4.438+ (print-unreadable-object (obj stream :type t :identity t)
4.439+ (print-midi-message obj stream))
4.440+ obj)
4.441+
4.442+(define-midi-message channel-message (message)
4.443+ :slots ((channel :reader message-channel))
4.444+ :filler (setf channel (logand *status* #x0f)))
4.445+
4.446+(defmethod print-midi-message ((object channel-message) stream)
4.447+ (call-next-method)
4.448+ (when (slot-boundp object 'channel)
4.449+ (format stream " C=~X" (slot-value object 'channel))))
4.450+
4.451+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.452+;;;
4.453+;;; voice messages
4.454+
4.455+(define-midi-message voice-message (channel-message))
4.456+
4.457+(define-midi-message note-off-message (voice-message)
4.458+ :status-min #x80 :status-max #x8f
4.459+ :slots ((key :initarg :key :reader message-key)
4.460+ (velocity :initarg :velocity :reader message-velocity))
4.461+ :filler (setf key next-byte
4.462+ velocity next-byte)
4.463+ :length 2
4.464+ :writer (write-bytes key velocity))
4.465+
4.466+(defmethod print-midi-message ((object note-off-message) stream)
4.467+ (call-next-method)
4.468+ (when (slot-boundp object 'key)
4.469+ (format stream " k=~A" (slot-value object 'key)))
4.470+ (when (slot-boundp object 'velocity)
4.471+ (format stream " v=~A" (slot-value object 'velocity))))
4.472+
4.473+(define-midi-message note-on-message (voice-message)
4.474+ :status-min #x90 :status-max #x9f
4.475+ :slots ((key :initarg :key :reader message-key)
4.476+ (velocity :initarg :velocity :reader message-velocity))
4.477+ :filler (setf key next-byte
4.478+ velocity next-byte)
4.479+ :length 2
4.480+ :writer (write-bytes key velocity))
4.481+
4.482+(defmethod print-midi-message ((object note-on-message) stream)
4.483+ (call-next-method)
4.484+ (when (slot-boundp object 'key)
4.485+ (format stream " K=~A" (slot-value object 'key)))
4.486+ (when (slot-boundp object 'velocity)
4.487+ (format stream " V=~A" (slot-value object 'velocity))))
4.488+
4.489+(define-midi-message polyphonic-key-pressure-message (voice-message)
4.490+ :status-min #xa0 :status-max #xaf
4.491+ :slots ((key)
4.492+ (pressure))
4.493+ :filler (setf key next-byte
4.494+ pressure next-byte)
4.495+ :length 2
4.496+ :writer (write-bytes key pressure))
4.497+
4.498+(define-midi-message control-change-message (voice-message)
4.499+ :status-min #xb0 :status-max #xbf
4.500+ :data-min #x00 :data-max #x78
4.501+ :slots ((controller :initarg :controller)
4.502+ (value :initarg value))
4.503+ :filler (setf controller next-byte
4.504+ value next-byte)
4.505+ :length 2
4.506+ :writer (write-bytes controller value))
4.507+
4.508+(define-midi-message program-change-message (voice-message)
4.509+ :status-min #xc0 :status-max #xcf
4.510+ :slots ((program :initarg :program :reader message-program))
4.511+ :filler (setf program next-byte)
4.512+ :length 1
4.513+ :writer (write-bytes program))
4.514+
4.515+(defmethod print-midi-message ((object program-change-message) stream)
4.516+ (call-next-method)
4.517+ (when (slot-boundp object 'program)
4.518+ (format stream " P=~A" (slot-value object 'program))))
4.519+
4.520+(define-midi-message channel-pressure-message (voice-message)
4.521+ :status-min #xd0 :status-max #xdf
4.522+ :slots ((pressure))
4.523+ :filler (setf pressure next-byte)
4.524+ :length 1
4.525+ :writer (write-bytes pressure))
4.526+
4.527+(define-midi-message pitch-bend-message (voice-message)
4.528+ :status-min #xe0 :status-max #xef
4.529+ :slots ((value :initarg :value :reader message-value))
4.530+ :filler (setf value (logior next-byte (ash next-byte 7)))
4.531+ :length 2
4.532+ :writer (write-bytes (logand value #x7f) (logand (ash value -7) #x7f)))
4.533+
4.534+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.535+;;;
4.536+;;; mode messages
4.537+
4.538+(define-midi-message mode-message (channel-message)
4.539+ :filler next-byte) ; consume data byte
4.540+
4.541+(define-midi-message reset-all-controllers-message (mode-message)
4.542+ :status-min #xb0 :status-max #xbf
4.543+ :data-min #x79 :data-max #x79
4.544+ :filler next-byte ; consume unused byte
4.545+ :length 2
4.546+ :writer (write-bytes #x79 0))
4.547+
4.548+(define-midi-message local-control-message (mode-message)
4.549+ :status-min #xb0 :status-max #xbf
4.550+ :data-min #x7a :data-max #x7a
4.551+ :slots ((mode))
4.552+ :filler (setf mode (if (= next-byte 0) :off :on))
4.553+ :length 2
4.554+ :writer (write-bytes #x7a (if (eq mode :off) 0 127)))
4.555+
4.556+(define-midi-message all-notes-off-message (mode-message)
4.557+ :status-min #xb0 :status-max #xbf
4.558+ :data-min #x7b :data-max #x7b
4.559+ :filler next-byte ; consume unused byte
4.560+ :length 2
4.561+ :writer (write-bytes #x7b 0))
4.562+
4.563+(define-midi-message omni-mode-off-message (mode-message)
4.564+ :status-min #xb0 :status-max #xbf
4.565+ :data-min #x7c :data-max #x7c
4.566+ :filler next-byte ; consume unused byte
4.567+ :length 2
4.568+ :writer (write-bytes #x7c 0))
4.569+
4.570+(define-midi-message omni-mode-on-message (mode-message)
4.571+ :status-min #xb0 :status-max #xbf
4.572+ :data-min #x7d :data-max #x7d
4.573+ :filler next-byte ; consume unused byte
4.574+ :length 2
4.575+ :writer (write-bytes #x7d 0))
4.576+
4.577+(define-midi-message mono-mode-on-message (mode-message)
4.578+ :status-min #xb0 :status-max #xbf
4.579+ :data-min #x7e :data-max #x7e
4.580+ :slots ((nb-channels))
4.581+ :filler (setf nb-channels next-byte)
4.582+ :length 2
4.583+ :writer (write-bytes #x7e nb-channels))
4.584+
4.585+(define-midi-message poly-mode-on-message (mode-message)
4.586+ :status-min #xb0 :status-max #xbf
4.587+ :data-min #x7f :data-max #x7f
4.588+ :filler next-byte ; consume unused byte
4.589+ :length 2
4.590+ :writer (write-bytes #x7f 0))
4.591+
4.592+(define-midi-message system-message (message))
4.593+
4.594+(define-midi-message tempo-map-message (message))
4.595+
4.596+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.597+;;;
4.598+;;; system common messages
4.599+
4.600+(define-midi-message common-message (system-message))
4.601+
4.602+(define-midi-message timing-code-message (common-message)
4.603+ :status-min #xf1 :status-max #xf1
4.604+ :slots ((code))
4.605+ :filler (setf code next-byte)
4.606+ :length 1
4.607+ :writer (write-bytes code))
4.608+
4.609+(defmethod print-midi-message ((object timing-code-message) stream)
4.610+ (call-next-method)
4.611+ (when (slot-boundp object 'code)
4.612+ (format stream " code=~A" (slot-value object 'code))))
4.613+
4.614+(define-midi-message song-position-pointer-message (common-message)
4.615+ :status-min #xf2 :status-max #xf2
4.616+ :slots ((pointer))
4.617+ :filler (setf pointer (logior next-byte (ash next-byte 7)))
4.618+ :length 2
4.619+ :writer (write-bytes (logand pointer #x7f) (logand (ash pointer -7) #x7f)))
4.620+
4.621+(define-midi-message song-select-message (common-message)
4.622+ :status-min #xf3 :status-max #xf3
4.623+ :slots ((song))
4.624+ :filler (setf song next-byte)
4.625+ :length 1
4.626+ :writer (write-bytes song))
4.627+
4.628+(define-midi-message tune-request-message (common-message)
4.629+ :status-min #xf6 :status-max #xf6)
4.630+
4.631+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.632+;;;
4.633+;;; system real-time messages
4.634+
4.635+(define-midi-message real-time-message (system-message))
4.636+
4.637+(define-midi-message timing-clock-message (real-time-message)
4.638+ :status-min #xf8 :status-max #xf8)
4.639+
4.640+(define-midi-message start-sequence-message (real-time-message)
4.641+ :status-min #xfa :status-max #xfa)
4.642+
4.643+(define-midi-message continue-sequence-message (real-time-message)
4.644+ :status-min #xfb :status-max #xfb)
4.645+
4.646+(define-midi-message stop-sequence-message (real-time-message)
4.647+ :status-min #xfc :status-max #xfc)
4.648+
4.649+(define-midi-message active-sensing-message (real-time-message)
4.650+ :status-min #xfe :status-max #xfe)
4.651+
4.652+;; (define-midi-message tune-request-message (real-time-message)
4.653+;; :status-min #xf6 :status-max #xf6)
4.654+
4.655+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.656+;;;
4.657+;;; system exclusive messages
4.658+
4.659+(define-midi-message system-exclusive-message (system-message)
4.660+ :status-min #xf0 :status-max #xf0
4.661+ :slots ((data))
4.662+ :filler (loop with len = (read-variable-length-quantity)
4.663+ initially (setf data (make-array
4.664+ len :element-type '(unsigned-byte 8)))
4.665+ for i from 0 below len
4.666+ do (setf (aref data i) next-byte))
4.667+ :length (+ (length-of-variables-length-quantity (length data))
4.668+ (length data))
4.669+ :writer (progn (write-variable-length-quantity (length data))
4.670+ (loop for elem across data do (write-bytes elem))))
4.671+
4.672+(define-midi-message authorization-system-exclusive-message (system-message)
4.673+ :status-min #xf7 :status-max #xf7
4.674+ :slots ((data))
4.675+ :filler (loop with len = (read-variable-length-quantity)
4.676+ initially (setf data (make-array
4.677+ len :element-type '(unsigned-byte 8)))
4.678+ for i from 0 below len
4.679+ do (setf (aref data i) next-byte))
4.680+ :length (+ (length-of-variables-length-quantity (length data))
4.681+ (length data))
4.682+ :writer (progn (write-variable-length-quantity (length data))
4.683+ (loop for elem across data do (write-bytes elem))))
4.684+
4.685+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4.686+;;;
4.687+;;; meta messages
4.688+
4.689+(define-midi-message meta-message (message)
4.690+ :status-min #xff :status-max #xff
4.691+ :length 2 ; the first data byte and the length byte
4.692+ :filler next-byte ; the first data byte which gives the type of meta message
4.693+ :writer (write-bytes data-min))
4.694+
4.695+(define-midi-message sequence-number-message (meta-message tempo-map-message)
4.696+ :data-min #x00 :data-max #x00
4.697+ :slots ((sequence))
4.698+ :filler (let ((data2 next-byte))
4.699+ (setf sequence (if (zerop data2)
4.700+ 0
4.701+ (logior (ash next-byte 8) next-byte))))
4.702+ :length (if (zerop sequence) 0 2)
4.703+ :writer (unless (zerop sequence)
4.704+ (write-bytes (ash sequence -8) (logand sequence #xf))))
4.705+
4.706+(define-midi-message text-message (meta-message)
4.707+ :slots ((text))
4.708+ :filler (setf text (loop with len = next-byte
4.709+ with str = (make-string len)
4.710+ for i from 0 below len
4.711+ do (setf (aref str i)
4.712+ (code-char next-byte))
4.713+ finally (return str)))
4.714+ :length (length text)
4.715+ :writer (progn (write-bytes (length text))
4.716+ (loop for char across text do
4.717+ (write-bytes (char-code char)))))
4.718+
4.719+(defmethod print-midi-message ((object text-message) stream)
4.720+ (call-next-method)
4.721+ (when (slot-boundp object 'text)
4.722+ (format stream " [~A]" (slot-value object 'text))))
4.723+
4.724+(define-midi-message general-text-message (text-message)
4.725+ :data-min #x01 :data-max #x01)
4.726+
4.727+(define-midi-message copyright-message (text-message)
4.728+ :data-min #x02 :data-max #x02)
4.729+
4.730+(define-midi-message sequence/track-name-message (text-message tempo-map-message)
4.731+ :data-min #x03 :data-max #x03)
4.732+
4.733+(define-midi-message instrument-message (text-message)
4.734+ :data-min #x04 :data-max #x04)
4.735+
4.736+(define-midi-message lyric-message (text-message)
4.737+ :data-min #x05 :data-max #x05)
4.738+
4.739+(define-midi-message marker-message (text-message tempo-map-message)
4.740+ :data-min #x06 :data-max #x06)
4.741+
4.742+(define-midi-message cue-point-message (text-message)
4.743+ :data-min #x07 :data-max #x07)
4.744+
4.745+(define-midi-message program-name-message (text-message)
4.746+ :data-min #x08 :data-max #x08)
4.747+
4.748+(define-midi-message device-name-message (text-message)
4.749+ :data-min #x09 :data-max #x09)
4.750+
4.751+(define-midi-message channel-prefix-message (meta-message)
4.752+ :data-min #x20 :data-max #x20
4.753+ :slots ((channel))
4.754+ :length 1
4.755+ :filler (progn next-byte (setf channel next-byte))
4.756+ :writer (write-bytes 1 channel))
4.757+
4.758+(define-midi-message midi-port-message (meta-message)
4.759+ :data-min #x21 :data-max #x21
4.760+ :slots ((port))
4.761+ :length 1
4.762+ :filler (progn next-byte (setf port next-byte))
4.763+ :writer (write-bytes 1 port))
4.764+
4.765+(define-midi-message end-of-track-message (meta-message)
4.766+ :data-min #x2f :data-max #x2f
4.767+ :slots ((status :initform #xff))
4.768+ :filler next-byte
4.769+ :length 0
4.770+ :writer (write-bytes 0))
4.771+
4.772+(define-midi-message tempo-message (meta-message tempo-map-message)
4.773+ :data-min #x51 :data-max #x51
4.774+ :slots ((tempo :initarg :tempo :reader message-tempo))
4.775+ :filler (progn next-byte (setf tempo (read-fixed-length-quantity 3)))
4.776+ :length 3
4.777+ :writer (progn (write-bytes 3) (write-fixed-length-quantity tempo 3)))
4.778+
4.779+(defmethod print-midi-message ((object tempo-message) stream)
4.780+ (call-next-method)
4.781+ (when (slot-boundp object 'tempo)
4.782+ (format stream " tempo=~A" (slot-value object 'tempo))))
4.783+
4.784+(define-midi-message smpte-offset-message (meta-message tempo-map-message)
4.785+ :data-min #x54 :data-max #x54
4.786+ :slots ((hr) (mn) (se) (fr) (ff))
4.787+ :filler (progn next-byte (setf hr next-byte mn next-byte se next-byte
4.788+ fr next-byte ff next-byte))
4.789+ :length 5
4.790+ :writer (write-bytes 5 hr mn se fr ff))
4.791+
4.792+(defmethod print-midi-message ((object smpte-offset-message) stream)
4.793+ (call-next-method)
4.794+ (when (or (slot-boundp object 'hr)
4.795+ (slot-boundp object 'mn)
4.796+ (slot-boundp object 'se)
4.797+ (slot-boundp object 'fr)
4.798+ (slot-boundp object 'ff))
4.799+ (format stream
4.800+ " hmsff=~A/~A/~A/~A/~A"
4.801+ (ignore-errors (slot-value object 'hr))
4.802+ (ignore-errors (slot-value object 'mn))
4.803+ (ignore-errors (slot-value object 'se))
4.804+ (ignore-errors (slot-value object 'fr))
4.805+ (ignore-errors (slot-value object 'ff)))))
4.806+
4.807+(define-midi-message time-signature-message (meta-message tempo-map-message)
4.808+ :data-min #x58 :data-max #x58
4.809+ :slots ((nn :reader message-numerator)
4.810+ (dd :reader message-denominator)
4.811+ (cc) (bb))
4.812+ :filler (progn next-byte (setf nn next-byte dd next-byte
4.813+ cc next-byte bb next-byte))
4.814+ :length 4
4.815+ :writer (write-bytes 4 nn dd cc bb))
4.816+
4.817+(defmethod print-midi-message ((object time-signature-message) stream)
4.818+ (call-next-method)
4.819+ (when (or (slot-boundp object 'nn)
4.820+ (slot-boundp object 'dd)
4.821+ (slot-boundp object 'cc)
4.822+ (slot-boundp object 'bb))
4.823+ (format stream
4.824+ " n/dcb=~A/~A/~A/~A"
4.825+ (ignore-errors (slot-value object 'nn))
4.826+ (ignore-errors (slot-value object 'dd))
4.827+ (ignore-errors (slot-value object 'cc))
4.828+ (ignore-errors (slot-value object 'bb)))))
4.829+
4.830+(define-midi-message key-signature-message (meta-message)
4.831+ :data-min #x59 :data-max #x59
4.832+ :slots ((sf :reader message-sf)
4.833+ (mi :reader message-mi))
4.834+ :filler (progn next-byte (setf sf (let ((temp-sf next-byte))
4.835+ (if (> temp-sf 127)
4.836+ (- temp-sf 256)
4.837+ temp-sf))
4.838+ mi next-byte))
4.839+ :length 2
4.840+ :writer (write-bytes 2 (if (< sf 0) (+ sf 256) sf) mi))
4.841+
4.842+(define-midi-message proprietary-event (meta-message)
4.843+ :data-min #x7f :data-max #x7f
4.844+ :slots ((data))
4.845+ :filler (setf data (loop with len = (read-variable-length-quantity)
4.846+ with vec = (make-array
4.847+ len
4.848+ :element-type '(unsigned-byte 8))
4.849+ for i from 0 below len
4.850+ do (setf (aref vec i) next-byte)
4.851+ finally (return vec)))
4.852+ :writer (map nil (lambda (byte) (write-bytes byte))
4.853+ data)) ; FIXME
5.1--- a/lisp/lib/dat/pkg.lisp Thu Mar 21 22:42:46 2024 -0400
5.2+++ b/lisp/lib/dat/pkg.lisp Fri Mar 22 23:41:48 2024 -0400
5.3@@ -105,5 +105,23 @@
5.4 :bencode-decode
5.5 :*bencode-binary-key-p*))
5.6
5.7+(defpackage :dat/midi
5.8+ (:nicknames :midi)
5.9+ (:use :cl :std :dat/proto)
5.10+ (:export #:read-midi-file #:write-midi-file
5.11+ #:midifile
5.12+ #:midifile-format #:midifile-tracks #:midifile-division
5.13+ #:message #:note-off-message #:note-on-message #:tempo-message
5.14+ #:program-change-message #:pitch-bend-message
5.15+ #:key-signature-message #:time-signature-message
5.16+ #:smpte-offset-message
5.17+ #:sequence/track-name-message
5.18+ #:message-channel #:message-key #:message-time
5.19+ #:message-velocity #:message-numerator #:message-denominator
5.20+ #:message-sf #:message-mi #:message-tempo #:message-program
5.21+ #:message-value
5.22+ #:header #:header-type
5.23+ #:unknown-event #:status #:data-byte #:dd #:bb #:cc #:nn))
5.24+
5.25 (uiop:define-package :dat
5.26 (:use-reexport :dat/proto :dat/csv :dat/arff :dat/toml :dat/json :dat/sxp :dat/xml :dat/bencode))
6.1--- a/lisp/lib/dat/sxp.lisp Thu Mar 21 22:42:46 2024 -0400
6.2+++ b/lisp/lib/dat/sxp.lisp Fri Mar 22 23:41:48 2024 -0400
6.3@@ -132,6 +132,7 @@
6.4 (push methods res)))
6.5 (flatten res)))
6.6
6.7+;; TODO 2024-03-22:
6.8 (defun wrap-object (class form)
6.9 "Given a CLASS prototype and an input FORM, return a new instance of
6.10 CLASS. FORM is assumed to be the finalized lisp object which has
