From 268b8f2ee247b4ab060f5417317a77360df43390 Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Wed, 9 Apr 2025 13:15:59 -0700 Subject: [PATCH] updating lisp programs, lisp lib --- LispLibrary.h | 69 ++++++-------------------------------------- lisp/edit.lsp | 45 +++++++++++++++++++++++++++++ lisp/pkg.lsp | 24 +++++++++++++++ ulisp-arm.ino | 28 ++++++++++++++++++ ulisp-extensions.ino | 27 +++++++++++++++++ 5 files changed, 133 insertions(+), 60 deletions(-) create mode 100644 lisp/edit.lsp create mode 100644 lisp/pkg.lsp diff --git a/LispLibrary.h b/LispLibrary.h index 1e0aa33..0cb93ff 100644 --- a/LispLibrary.h +++ b/LispLibrary.h @@ -17,7 +17,7 @@ Open the Lisp file on the SD card and load the contents into the workspace." (loop (let ((form (read str))) (unless form (return)) - (setf lst (cons (quote (second form)) lst)) + (setf lst (cons (second form) lst)) (eval form))) (reverse lst)))) @@ -174,66 +174,15 @@ Returns a list with all items for which tst is true removed from lst." Returns a list with all items for which tst is false removed from lst." (mapcan #'(lambda (x) (when (funcall tst x) (list x))) lst)) +(defun append-to-list (itm lst) + "(append-to-list itm lst) +Appends item to list destructively; lst will be altered with +itm appended to the end of the list." + (nconc lst (list itm))) -(defvar *packages* nil) +(defvar *pkg* nil) -(defun load-package (filename ) - (let* ((filename (concatenate 'string filename ".pkg")) - (forms (load filename))) - (setf *packages* - -(defun save-package (filename lst) - (with-sd-card (str filename 2) - (dolist (f lst) - (symbol-def f str)))) - -(defun add-to-package (filename list) - (with-sd-card (str filename 1) - (dolist (f lst) - (symbol-def f str)))) - -(defun %edit (fun) - (cond - ((null *cmds*) fun) - ((eq (car *cmds*) #\b) (pop *cmds*) fun) - ((eq (car *cmds*) #\e) (pop *cmds*) (%edit (list fun))) - ((eq (car *cmds*) #\h) (pop *cmds*) (%edit (cons 'highlight (list fun)))) - ((consp (car *cmds*)) - (let ((val (cdar *cmds*))) - (case (caar *cmds*) - (#\r (pop *cmds*) (%edit val)) - ((#\c #\i) (pop *cmds*) (%edit (cons val fun))) - (#\f (cond - ((null fun) nil) - ((equal val fun) (pop *cmds*) (%edit fun)) - ((atom fun) fun) - (t (cons (%edit (car fun)) (%edit (cdr fun))))))))) - ((atom fun) (pop *cmds*) (%edit fun)) - ((eq (car *cmds*) #\d) (pop *cmds*) (%edit (cons (car fun) (%edit (cdr fun))))) - ((eq (car *cmds*) #\a) (pop *cmds*) (%edit (cons (%edit (car fun)) (cdr fun)))) - ((eq (car *cmds*) #\x) (pop *cmds*) (%edit (cdr fun))) - (t fun))) - -(defun edit (name) - (let ((fun (eval name)) - cc) - (setq *cmds* nil) - (loop - (write-byte 12) - (setq cc (append cc (list #\h))) - (setq *cmds* cc) - (pprint (%edit fun)) - (setq cc (butlast cc)) - (let ((c (get-key))) - (case c - (#\q (set name fun) (return name)) - (#\s (setq *cmds* cc) (set name (%edit fun)) (return name)) - (#\z (when cc (setq cc (butlast cc)))) - ((#\r #\c #\i #\f #\e) - (write-byte 11) (princ c) (princ #\:) - (setq cc (append cc (list (cons c (read)))))) - ((#\d #\a #\x #\b) - (setq cc (append cc (list c)))) - (t (write-byte 7))))))) +(defun lp () + (setf *pkg* (load "pkg.lsp"))) )lisplibrary"; diff --git a/lisp/edit.lsp b/lisp/edit.lsp new file mode 100644 index 0000000..bb0c6f5 --- /dev/null +++ b/lisp/edit.lsp @@ -0,0 +1,45 @@ +(defvar *cmds* nil) + +(defun %edit (fun) + (cond + ((null *cmds*) fun) + ((eq (car *cmds*) #\b) (pop *cmds*) fun) + ((eq (car *cmds*) #\e) (pop *cmds*) (%edit (list fun))) + ((eq (car *cmds*) #\h) (pop *cmds*) (%edit (cons 'highlight (list fun)))) + ((consp (car *cmds*)) + (let ((val (cdar *cmds*))) + (case (caar *cmds*) + (#\r (pop *cmds*) (%edit val)) + ((#\c #\i) (pop *cmds*) (%edit (cons val fun))) + (#\f (cond + ((null fun) nil) + ((equal val fun) (pop *cmds*) (%edit fun)) + ((atom fun) fun) + (t (cons (%edit (car fun)) (%edit (cdr fun))))))))) + ((atom fun) (pop *cmds*) (%edit fun)) + ((eq (car *cmds*) #\d) (pop *cmds*) (%edit (cons (car fun) (%edit (cdr fun))))) + ((eq (car *cmds*) #\a) (pop *cmds*) (%edit (cons (%edit (car fun)) (cdr fun)))) + ((eq (car *cmds*) #\x) (pop *cmds*) (%edit (cdr fun))) + (t fun))) + +(defun edit (name) + (let ((fun (eval name)) + cc) + (setq *cmds* nil) + (loop + (write-byte 12) + (setq cc (append cc (list #\h))) + (setq *cmds* cc) + (pprint (%edit fun)) + (setq cc (butlast cc)) + (let ((c (get-key))) + (case c + (#\q (set name fun) (return name)) + (#\s (setq *cmds* cc) (set name (%edit fun)) (return name)) + (#\z (when cc (setq cc (butlast cc)))) + ((#\r #\c #\i #\f #\e) + (write-byte 11) (princ c) (princ #\:) + (setq cc (append cc (list (cons c (read)))))) + ((#\d #\a #\x #\b) + (setq cc (append cc (list c)))) + (t (write-byte 7))))))) diff --git a/lisp/pkg.lsp b/lisp/pkg.lsp new file mode 100644 index 0000000..d79ad10 --- /dev/null +++ b/lisp/pkg.lsp @@ -0,0 +1,24 @@ +(defvar *packages* nil) + +(defun load-package (filename) + (let* ((path (concatenate 'string filename ".pkg")) + (forms (load path))) + (setf *packages* (append-to-list + (cons filename forms) + (remove-if (lambda (x) + (string= (car x) filename)) + *packages*))))) + +(defun save-package (filename lst) + (with-sd-card (str filename 2) + (dolist (f lst) + (symbol-def f str)))) + +(defun unload-package (package) + (dolist (sym (cdr (assoc package *packages*))) + (makunbound sym))) + +(defun add-to-package (filename list) + (with-sd-card (str filename 1) + (dolist (f lst) + (symbol-def f str)))) diff --git a/ulisp-arm.ino b/ulisp-arm.ino index a30d512..6e57719 100644 --- a/ulisp-arm.ino +++ b/ulisp-arm.ino @@ -7837,6 +7837,30 @@ object *fn_invertdisplay (object *args, object *env) { return nil; } +char getKey () { + char temp; + + if (pc_kbd.keyCount() > 0) { + do { + const PCKeyboard::KeyEvent key = pc_kbd.keyEvent(); + if (key.state == PCKeyboard::StatePress) { + char temp = key.key; + if ((temp != 0) && (temp !=255) && (temp != 0xA1) && (temp != 0xA2) && (temp != 0xA3) && (temp != 0xA4) && (temp != 0xA5)) { + ProcessKey(temp); + } + } + } while ((temp == 0) || (temp ==255)); + if (temp == '@') temp = '~'; + if (temp == '_') temp = '\\'; + } + return temp; +} + +object *fn_getkey (object *args, object *env) { + (void) env, (void) args; + return character(getKey()); +} + // Built-in symbol names const char string0[] = "nil"; const char string1[] = "t"; @@ -8087,6 +8111,7 @@ const char string245[] = "invert-display"; const char string246[] = ":led-builtin"; const char string247[] = ":high"; const char string248[] = ":low"; +const char string262[] = "get-key"; #if defined(CPU_ATSAMD21) const char string249[] = ":input"; const char string250[] = ":input-pullup"; @@ -8839,6 +8864,8 @@ const char doc244[] = "(set-rotation option)\n" "Sets the display orientation for subsequent graphics commands; values are 0, 1, 2, or 3."; const char doc245[] = "(invert-display boolean)\n" "Mirror-images the display."; +const char doc262[] = "(get-key)\n" +"Get the next key from the keyboard."; // Built-in symbol lookup table const tbl_entry_t lookup_table[] = { @@ -9091,6 +9118,7 @@ const tbl_entry_t lookup_table[] = { { string246, (fn_ptr_type)LED_BUILTIN, 0, NULL }, { string247, (fn_ptr_type)HIGH, DIGITALWRITE, NULL }, { string248, (fn_ptr_type)LOW, DIGITALWRITE, NULL }, + { string262, fn_getkey, 0200, doc262 }, #if defined(CPU_ATSAMD21) { string249, (fn_ptr_type)INPUT, PINMODE, NULL }, { string250, (fn_ptr_type)INPUT_PULLUP, PINMODE, NULL }, diff --git a/ulisp-extensions.ino b/ulisp-extensions.ino index ee14925..3e9618f 100644 --- a/ulisp-extensions.ino +++ b/ulisp-extensions.ino @@ -147,10 +147,32 @@ fn_lambdap(object *arg, object *env) } +object * +fn_backlight(object *args, object *env) +{ + (void) env; + + object *arg = car(args); + + if (arg != nil) { + if (!(floatp(arg))) { + error2(notanumber); + } + + pc_kbd.setBacklight(arg->single_float); + } + + float level = pc_kbd.backlight(); + + return makefloat(level); +} + + // Symbol names const char stringlambdap[] PROGMEM = "lambdap"; const char stringnow[] PROGMEM = "now"; const char string_sym_def[] PROGMEM = "symbol-def"; +const char string_backlight[] PROGMEM = "backlight"; // Documentation strings @@ -170,12 +192,17 @@ const char doc_sym_def[] PROGMEM = "(symbol-def symbol [str])\n" "If str is specified it prints to the specified stream.\n" "It returns no value."; +const char doc_backlight[] PROGMEM = "(backlight level)\n" +"If level is nil, return the current backlight level. Otherwise, set" +"the backlight to the level. Returns the current backlight level."; + // Symbol lookup table const tbl_entry_t lookup_table2[] PROGMEM = { { stringlambdap, fn_lambdap, 0211, doclambdap }, { stringnow, fn_now, 0203, docnow }, { string_sym_def, fn_sym_def, 0212, doc_sym_def }, + { string_backlight, fn_backlight, 0201, doc_backlight }, }; // Table cross-reference functions