From 35c5edc20b4a6441ddd1aafe34c3fa3a87c80110 Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Thu, 10 Apr 2025 22:49:24 -0700 Subject: [PATCH] moving to project folder --- lisp/attiny.lsp | 53 --------------------- lisp/bels.lsp | 38 --------------- lisp/query.lsp | 89 ----------------------------------- lisp/rtc.lsp | 57 ---------------------- lisp/sync.sh | 22 --------- lisp/tools.lsp | 30 ------------ lisp/ulos.lsp | 26 ---------- picocalc/ulisp-extensions.ino | 64 ++++++++++++------------- 8 files changed, 31 insertions(+), 348 deletions(-) delete mode 100644 lisp/attiny.lsp delete mode 100644 lisp/bels.lsp delete mode 100644 lisp/query.lsp delete mode 100644 lisp/rtc.lsp delete mode 100755 lisp/sync.sh delete mode 100644 lisp/tools.lsp delete mode 100644 lisp/ulos.lsp diff --git a/lisp/attiny.lsp b/lisp/attiny.lsp deleted file mode 100644 index 6f38b32..0000000 --- a/lisp/attiny.lsp +++ /dev/null @@ -1,53 +0,0 @@ -; The ATtiny database v3 - 9th April 2019 -; See http://www.ulisp.com/show?2I60 -; - -(defvar *data* - '((attinyX5 (pins 8) (io 5) (adc 4) (pwm 3) (usi 1) (timer8 2) (crystal) (pll)) - (attiny85 (family attinyx5) (flash 8192) (ram 512) (eeprom 512) (price soic 72) (price pdip 90)) - (attiny45 (family attinyx5) (flash 4096) (ram 256) (eeprom 256) (price soic 77) (price pdip 85)) - (attiny25 (family attinyx5) (flash 2048) (ram 128) (eeprom 128) (price soic 79) (price pdip 83)) - - (attinyX4 (pins 14) (io 11) (adc 8) (pwm 4) (usi 1) (timer8 1) (timer16 1) (crystal)) - (attiny84 (family attinyX4) (flash 8192) (ram 512) (eeprom 512) (price soic 60) (price pdip 87)) - (attiny44 (family attinyX4) (flash 4096) (ram 256) (eeprom 256) (price soic 56) (price pdip 86)) - (attiny24 (family attinyX4) (flash 2048) (ram 128) (eeprom 128) (price soic 52) (price pdip 83)) - - (attinyX313 (pins 20) (io 17) (pwm 3) (uart 1) (usi 1) (timer8 1) (timer16 1) (crystal)) - (attiny4313 (family attinyX313) (flash 4096) (ram 256) (eeprom 256) (price soic 70) (price pdip 98)) - (attiny2313 (family attinyX313) (flash 2048) (ram 128) (eeprom 128) (price soic 82) (price pdip 99)) - - (attinyX41 (pins 14) (io 11) (adc 12) (uart 2) (i2c slave) (timer8 1) (timer16 2) (crystal)) - (attiny841 (family attinyX41) (flash 8192) (ram 512) (eeprom 512) (price soic 78)) - (attiny441 (family attinyX41) (flash 4096) (ram 256) (eeprom 256) (price soic 73)) - - (attinyX61 (pins 20) (io 15) (adc 11) (pwm 3) (usi 1) (timer8 1) (timer16 1) (crystal) (pll)) - (attiny861 (family attinyX61) (flash 8192) (ram 512) (eeprom 512) (price soic 92) (price pdip 110)) - (attiny461 (family attinyX61) (flash 4096) (ram 256) (eeprom 256) (price soic 85) (price pdip 129)) - (attiny261 (family attinyX61) (flash 2048) (ram 128) (eeprom 128) (price soic 83) (price pdip 107)) - - (attinyX7 (pins 20) (io 16) (adc 11) (pwm 3) (uart 1) (usi 1) (timer8 1) (timer16 1) (crystal) (lin)) - (attiny167 (family attinyX7) (flash 16384) (ram 512) (eeprom 512) (price soic 111)) - (attiny87 (family attinyX7) (flash 8192) (ram 512) (eeprom 512) (price soic 124)) - - (attinyX8 (pins 28) (io 27) (adc 8) (pwm 4) (i2c master) (i2c slave) (usi 1) (timer8 1) (timer16 1)) - (attiny88 (family attinyX8) (flash 8192) (ram 512) (eeprom 64) (price tqfp 76) (price pdip 143)) - (attiny48 (family attinyX8) (flash 4096) (ram 256) (eeprom 64) (price tqfp 78) (price pdip 131)) - - (attinyX34 (pins 20) (io 17) (adc 12) (pwm 4) (i2c slave) (uart 2) (usi 1) (timer8 1) (timer16 1) (crystal)) - (attiny1634 (family attinyX34) (flash 16384) (ram 1024) (eeprom 256) (price soic 118)) - - (attinyX28 (pins 32) (io 27) (adc 28) (pwm 4) (i2c slave) (uart 1) (timer8 1) (timer16 1)) - (attiny828 (family attinyX28) (flash 8192) (ram 512) (eeprom 512) (price tqfp 84)) - - (attinyX3 (pins 20) (io 15) (adc 4) (pwm 4) (usi 1) (timer8 1) (timer16 1) (boost)) - (attiny43 (family attinyX3) (flash 4096) (ram 512) (eeprom 64) (price soic 147)) - - (attiny9/10 (pins 6) (io 4) (adc 4) (pwm 2) (timer16 1)) - (attiny4/5 (pins 6) (io 4) (pwm 2) (timer16 1)) - (attiny10 (family attiny9/10) (flash 1024) (ram 32) (price sot 25)) - (attiny9 (family attiny9/10) (flash 512) (ram 32) (price sot 25)) - (attiny5 (family attiny4/5) (flash 1024) (ram 32) (price sot 23)) - (attiny4 (family attiny4/5) (flash 512) (ram 32) (price sot 27)))) - - diff --git a/lisp/bels.lsp b/lisp/bels.lsp deleted file mode 100644 index b5f7e60..0000000 --- a/lisp/bels.lsp +++ /dev/null @@ -1,38 +0,0 @@ -; -; 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/query.lsp b/lisp/query.lsp deleted file mode 100644 index 0b18eea..0000000 --- a/lisp/query.lsp +++ /dev/null @@ -1,89 +0,0 @@ -; uLisp Query Language - 9th April 2019 -; See http://www.ulisp.com/show?2I60 -; - -; Database - -(defvar *rules* nil) - -(defun add (rule) - (unless (assoc (car rule) *rules*) (push (list (car rule)) *rules*)) - (push (cdr rule) (cdr (assoc (car rule) *rules*))) - t) - -; Match - -(defun match (x y &optional binds) - (cond - ((eq x y) (if binds binds '((t)))) - ((assoc x binds) (match (binding x binds) y binds)) - ((assoc y binds) (match x (binding y binds) binds)) - ((var? x) (cons (cons x y) binds)) - ((var? y) (cons (cons y x) binds)) - (t - (when (and (consp x) (consp y)) - (let ((m (match (car x) (car y) binds))) - (when m (match (cdr x) (cdr y) m))))))) - -(defun var? (x) - (and (symbolp x) (eq (char (string x) 0) #\?))) - -(defun binding (x binds) - (let ((b (assoc x binds))) - (when b - (or (binding (cdr b) binds) - (cdr b))))) - -; Inference - -(defun query (expr &optional binds) - (case (car expr) - (and (query-and (reverse (cdr expr)) binds)) - (or (query-or (cdr expr) binds)) - (not (query-not (second expr) binds)) - (test (query-test (second expr) binds)) - (t (lookup (car expr) (cdr expr) binds)))) - -(defun lookup (pred args &optional binds) - (mapcan - (lambda (x) - (let ((m (match args x binds))) - (when m (list m)))) - (cdr (assoc pred *rules*)))) - -(defun query-and (clauses binds) - (if (null clauses) - (list binds) - (mapcan (lambda (b) (query (car clauses) b)) - (query-and (cdr clauses) binds)))) - -(defun query-or (clauses binds) - (apply 'append (mapcar (lambda (c) (query c binds)) clauses))) - -(defun query-not (clause binds) - (unless (query clause binds) - (list binds))) - -(defun subs (lst binds) - (cond - ((null lst) nil) - ((atom lst) (if (assoc lst binds) (cdr (assoc lst binds)) lst)) - (t (cons (subs (car lst) binds) (subs (cdr lst) binds))))) - -(defun query-test (tst binds) - (when (eval (subs tst binds)) - (list binds))) - -(defun answer (expr output) - (dolist (binds (query expr nil)) - (mapc (lambda (p) (princ p) (princ #\space)) (subs output binds)) - (terpri))) - -(defun read-data () - (dolist (rules *data*) - (let ((pred (first rules)) - (data (cdr rules))) - (mapc (lambda (rule) (add (cons (first rule) (cons pred (cdr rule))))) data))) - t) - - diff --git a/lisp/rtc.lsp b/lisp/rtc.lsp deleted file mode 100644 index 3f4d7a5..0000000 --- a/lisp/rtc.lsp +++ /dev/null @@ -1,57 +0,0 @@ -(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 deleted file mode 100755 index dee2379..0000000 --- a/lisp/sync.sh +++ /dev/null @@ -1,22 +0,0 @@ -#!/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 deleted file mode 100644 index c5132f6..0000000 --- a/lisp/tools.lsp +++ /dev/null @@ -1,30 +0,0 @@ -(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/lisp/ulos.lsp b/lisp/ulos.lsp deleted file mode 100644 index b64122a..0000000 --- a/lisp/ulos.lsp +++ /dev/null @@ -1,26 +0,0 @@ -; -; ULOS simple object system -; see http://forum.ulisp.com/t/a-simple-object-system-for-ulisp/622 -; - -; Define an object -(defun object (&optional parent slots) - (let ((obj (when parent (list (cons 'parent parent))))) - (loop - (when (null slots) (return obj)) - (push (cons (first slots) (second slots)) obj) - (setq slots (cddr slots))))) - -; Get the value of a slot in an object or its parents -(defun value (obj slot) - (when (symbolp obj) (setq obj (eval obj))) - (let ((pair (assoc slot obj))) - (if pair (cdr pair) - (let ((p (cdr (assoc 'parent obj)))) - (and p (value p slot)))))) - -; Update a slot in an object -(defun update (obj slot value) - (when (symbolp obj) (setq obj (eval obj))) - (let ((pair (assoc slot obj))) - (when pair (setf (cdr pair) value)))) diff --git a/picocalc/ulisp-extensions.ino b/picocalc/ulisp-extensions.ino index 5fc0eb8..5f95949 100644 --- a/picocalc/ulisp-extensions.ino +++ b/picocalc/ulisp-extensions.ino @@ -34,7 +34,7 @@ bcd_to_dec(uint8_t n) /* * STANDARD DEFINITIONS - * + * * These definitions should be the same on every platform. */ object * @@ -143,17 +143,17 @@ hyperprint(object *form, int lm, pfun_t pfun) } while (form != NULL) { - if (atom(form)) { - pfstring(PSTR(" . "), pfun); + if (atom(form)) { + pfstring(PSTR(" . "), pfun); printobject(form, pfun); pfun(')'); return; - } else if (separate) { + } else if (separate) { pfun('('); separate = false; } else if (special) { pfun(' '); - special--; + special--; } else if (fits) { pfun(' '); } else { @@ -194,6 +194,7 @@ fn_sym_def(object *args, object *env) return bsymbol(NOTHING); } + object * fn_listlibrary2(object *args, object *env) { @@ -288,7 +289,7 @@ fn_searchn(object *args, object *env) object *pattern = first(args); object *target = second(args); - if (cddr(args) != NULL) { + if (cddr(args) != NULL) { object *num = third(args); if (integerp(num)) { @@ -311,7 +312,7 @@ fn_searchn(object *args, object *env) target1 = cdr(target1); } - if (pattern == NULL){ + if (pattern == NULL){ last_index = i; if (matches-- == 0) { @@ -335,7 +336,7 @@ fn_searchn(object *args, object *env) j++; } - if (j == m) { + if (j == m) { last_index = i; if(matches-- == 0){ return number(i); @@ -365,7 +366,7 @@ fn_sd_rename(object *args, object *env) (void) env; char buffer1[BUFFERSIZE]; char buffer2[BUFFERSIZE]; - + object *pathFrom = car(args); if (!stringp(pathFrom)) { @@ -390,7 +391,7 @@ fn_sd_remove(object *args, object *env) { (void) env; char buffer[BUFFERSIZE]; - + object *arg = car(args); if (!SD.remove(MakeFilename(arg, buffer))) { @@ -406,7 +407,7 @@ fn_sd_existsp(object *args, object *env) (void) env; char buffer[BUFFERSIZE]; - + object *arg = car(args); if (!SD.exists(MakeFilename(arg, buffer))) { return nil; @@ -417,15 +418,15 @@ fn_sd_existsp(object *args, object *env) /* (sd-make-dir path) - Create a directory on the SD card. - This will also create any intermediate directories that don’t already exists; + Create a directory on the SD card. + This will also create any intermediate directories that don’t already exists; e.g. SD.mkdir("a/b/c") will create a, b, and c. */ object * fn_sd_mkdir(object *args, object *env) { (void) env; - + char buffer[BUFFERSIZE]; object *arg = car(args); @@ -465,17 +466,17 @@ fn_sd_list(object *args, object *env) { (void) env; - char *sd_path_buf = NULL; + char *sd_path_buf = NULL; SDBegin(); - File root; + File root; object *result = cons(NULL, NULL); object *ptr = result; if (args != NULL) { object *arg1 = checkstring(first(args)); int len = stringlength(arg1) + 2; //make it longer for the initial slash and the null terminator - sd_path_buf = (char*)malloc(len); + sd_path_buf = (char*)malloc(len); if (sd_path_buf != NULL) { cstring(arg1, &sd_path_buf[1], len-1); @@ -700,16 +701,16 @@ touchKeyModEditor(char temp) #if defined (touchscreen) /* t-deck / blackberry keyboard missing symbols missing mapped alt symbol - ` k ' - ~ p @ - % $ - ^ a * - & q # - = o + - < t ( - > y ) - \ u _ - | g / + ` k ' + ~ p @ + % $ + ^ a * + & q # + = o + + < t ( + > y ) + \ u _ + | g / [ alt-t ( ] alt-y ) @@ -853,12 +854,6 @@ const char stringsd_dir[] PROGMEM = "sd-list"; #if defined(PLATFORM_PICOCALC) const char string_get_key[] PROGMEM = "get-key"; -#elif defined(TDECK_PERI_POWERON) -const char string_gettouchpoints[] PROGMEM = "get-touch-points"; -const char stringKeyboardGetKey[] PROGMEM = "keyboard-get-key"; -const char stringKeyboardFlush[] PROGMEM = "keyboard-flush"; -const char stringSearchStr[] PROGMEM = "search-str"; -const char stringsearchn[] PROGMEM = "searchn"; #elif defined(TDECK_PERI_POWERON) const char string_gettouchpoints[] PROGMEM = "get-touch-points"; @@ -866,6 +861,7 @@ const char stringKeyboardGetKey[] PROGMEM = "keyboard-get-key"; const char stringKeyboardFlush[] PROGMEM = "keyboard-flush"; #endif + /* * DOCUMENTATION STRINGS * @@ -974,10 +970,12 @@ const tbl_entry_t lookup_table2[] PROGMEM = { #if defined(PLATFORM_PICOCALC) { string_get_key, fn_get_key, 0200, doc_get_key }, + #elif defined(TDECK_PERI_POWERON) { string_gettouchpoints, fn_get_touch_points, 0200, doc_gettouchpoints }, { stringKeyboardGetKey, fn_KeyboardGetKey, 0201, docKeyboardGetKey }, { stringKeyboardFlush, fn_KeyboardFlush, 0200, docKeyboardFlush }, + #endif };