From a7f2940351751ccd6d7e15b7b52a47450ce8af16 Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Mon, 7 Apr 2025 21:41:44 +0000 Subject: [PATCH] symbol-def (#1) Started branch to add `pform`, ended up pulling in `symbol-def` from the forums. Also adds the editor code from the T-Deck. Reviewed-on: https://git.wntrmute.dev/kyle/ulisp-picocalc/pulls/1 Co-authored-by: Kyle Isom Co-committed-by: Kyle Isom --- .gitignore | 3 ++- lisp/bels.lsp | 38 ++++++++++++++++++++++++++++ lisp/rtc.lsp | 57 ++++++++++++++++++++++++++++++++++++++++++ lisp/sync.sh | 22 ++++++++++++++++ lisp/tools.lsp | 30 ++++++++++++++++++++++ picocalc/ulisp-arm.ino | 1 + 6 files changed, 150 insertions(+), 1 deletion(-) create mode 100644 lisp/bels.lsp create mode 100644 lisp/rtc.lsp create mode 100755 lisp/sync.sh create mode 100644 lisp/tools.lsp diff --git a/.gitignore b/.gitignore index 1aa93c7..e79ee4e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ secrets.lsp */build -**/.uf2 +**/*.uf2 +*/*.patch diff --git a/lisp/bels.lsp b/lisp/bels.lsp new file mode 100644 index 0000000..b5f7e60 --- /dev/null +++ b/lisp/bels.lsp @@ -0,0 +1,38 @@ +; +; Ringing the changes +; see http://www.ulisp.com/show?1G42 +; + +(defvar *bell-pin* 3) + +(defun fnd (x lst) + (cond + ((null lst) nil) + ((< x (car lst)) (car lst)) + (t (fnd x (cdr lst))))) + +(defun sub (new old lst) + (cond + ((null lst) nil) + ((eq old (car lst)) (cons new (cdr lst))) + (t (cons (car lst) (sub new old (cdr lst)))))) + +(defun nxt (lst) + (cond + ((not (apply > (cdr lst))) (cons (car lst) (nxt (cdr lst)))) + ((> (car lst) (cadr lst)) nil) + (t (let* ((rest (reverse (cdr lst))) + (old (fnd (car lst) rest))) + (cons old (sub (car lst) old rest)))))) + +(defun all (fun lst) + (when lst + (funcall fun lst) + (all fun (nxt lst)))) + +(defun bel (lis) + (mapc + (lambda (x) (note *bell-pin* x 4) (delay 500) (note) (delay 125)) + lis) + (delay 500)) + diff --git a/lisp/rtc.lsp b/lisp/rtc.lsp new file mode 100644 index 0000000..3f4d7a5 --- /dev/null +++ b/lisp/rtc.lsp @@ -0,0 +1,57 @@ +(defvar *rtc-port* 0) + +(defun bcd-to-dec (x) + "(bcd-to-dec x) +Convert the BCD-encoded number x to a decimal value." + (+ + (* 10 (ash x -4)) + (logand x #xf))) + +(defun dec-to-bcd (x) + "(dec-to-bcd x) +Converts the decimal value to a BCD-encoded number. +Number must be in the range 0 to 99." + (+ + (ash (floor x 10) 4) + (logand (rem x 10) #xf))) + +(defun rtc-p () + "(rtc-p) +Returns t if the RTC is connected." + (with-i2c (str *rtc-port* #x68) + (streamp str))) + +(defun rtc-set (h m s) + "(rtc-set hr min sec) +Set the time on a DS3231 RTC. Times are in BCD, so use +the appropriate reader macro, e.g. (rtc-set #x12 #x34 #x00) +for 12:34:00." + (let ((h (dec-to-bcd h)) + (m (dec-to-bcd m)) + (s (dec-to-bcd s))) + (with-i2c (str *rtc-port* #x68) + (write-byte 0 str) + (write-byte s str) + (write-byte m str) + (write-byte h str)))) + +(defun rtc-get () + (with-i2c (str *rtc-port* #x68) + (write-byte 0 str) + (restart-i2c str 3) + (mapcar bcd-to-dec + (reverse + (list + (read-byte str) + (read-byte str) + (read-byte str)))))) + +(defun rtc-now () + "(rtc-now) +Set the time using the RTC." + (apply now (rtc-get))) + +(defun now-rtc () + "(now-rtc) +Sets the RTC time using the now function." + (apply rtc-set (now))) diff --git a/lisp/sync.sh b/lisp/sync.sh new file mode 100755 index 0000000..dee2379 --- /dev/null +++ b/lisp/sync.sh @@ -0,0 +1,22 @@ +#!/bin/sh + +if [ "$(uname -s)" = "Linux" ] +then + DEFAULT_MOUNT="/media/kyle/ULISP" +else + DEFAULT_MOUNT="/Volumes/ULISP" +fi + +MEDIA="${1:-${DEFAULT_MOUNT}}" + +if [ ! -d "${MEDIA}" ] +then + echo "[!] ${MEDIA} isn't mounted!" + exit 1 +fi + +echo "[+] transferring lisp files to ${MEDIA}..." +cp *.lsp "$MEDIA" +echo "[+] unmounting ${MEDIA}" +umount "$MEDIA" +echo "[+] transfer complete" diff --git a/lisp/tools.lsp b/lisp/tools.lsp new file mode 100644 index 0000000..c5132f6 --- /dev/null +++ b/lisp/tools.lsp @@ -0,0 +1,30 @@ +(defun pprintf (sym str) + "(pprintf sym str) +Pretty-print the function pointed to by sym to +the stream, which follows the 'format directives." + (let ((form (eval sym))) + (format str "(defun ~a ~a~%~{ ~a~^~%~})" + (string sym) + (cadr form) + (cddr form)))) + +(defun copy-file (source dest) + (with-sd-card (writer dest 2) + (with-sd-card (reader source) + (loop + (let ((data (read-byte reader))) + (when (null data) + (return)) + (write-byte data writer)))))) + +(defun i2c-scan (port) + (dotimes (addr 127) + (with-i2c (str port addr) + (when str (print addr))))) + +(defun i2c-scan2 (port) + (dotimes (addr 127) + (with-i2c (str port addr) + (format t "~2,0'x: " addr) + (if str (print t) + (print nil))))) diff --git a/picocalc/ulisp-arm.ino b/picocalc/ulisp-arm.ino index 0607a67..32ab147 100644 --- a/picocalc/ulisp-arm.ino +++ b/picocalc/ulisp-arm.ino @@ -10498,6 +10498,7 @@ void setup () { initkybd(); #endif pfstring(PSTR("uLisp 4.7b "), pserial); pln(pserial); + loadimage(NULL); } // Read/Evaluate/Print loop