kyle
/
ulisp
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

updating lisp programs, lisp lib

This commit is contained in:
Kyle Isom 2025-04-09 13:15:59 -07:00
parent 8f2a2be9ab
commit 268b8f2ee2
5 changed files with 133 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
LispLibrary.h
View File

@ -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";

45
lisp/edit.lsp Normal file
View File

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

24
lisp/pkg.lsp Normal file
View File

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

28
ulisp-arm.ino
View File

@ -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 },

27
ulisp-extensions.ino
View File

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