updating lisp programs, lisp lib

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 )
+(defun lp ()
-  (let* ((filename (concatenate 'string filename ".pkg"))
+  (setf *pkg* (load "pkg.lsp")))
-	 (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)))))))
 
 )lisplibrary";

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

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

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

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