set up unified lisp library and extensions subsystem.
This commit is contained in:
@@ -1,215 +0,0 @@
|
||||
// Library of additional Lisp functions with integral documentation
|
||||
// LispLibrary.h - Version 2 - 5th November 2023
|
||||
|
||||
const char LispLibrary[] PROGMEM = R"lisplibrary(
|
||||
|
||||
(defun every (tst lst)
|
||||
"(every tst lst)
|
||||
Returns t if tst is true for every item in lst, or nil on the first false item."
|
||||
(if (null lst) t
|
||||
(and (funcall tst (car lst)) (every tst (cdr lst)))))
|
||||
|
||||
(defun load (filename)
|
||||
"(load filename)
|
||||
Open the Lisp file on the SD card and load the contents into the workspace."
|
||||
(with-sd-card (str filename)
|
||||
(let ((lst nil))
|
||||
(loop
|
||||
(let ((form (read str)))
|
||||
(unless form (return))
|
||||
(setf lst (cons (second form) lst))
|
||||
(eval form)))
|
||||
(reverse lst))))
|
||||
|
||||
(defun rgb (r g b)
|
||||
"(rgb r g b)
|
||||
Define a colour from its RGB components."
|
||||
(logior (ash (logand r #xf8) 8) (ash (logand g #xfc) 3) (ash b -3)))
|
||||
|
||||
(defun hsv (h s v)
|
||||
"(hsv h s v)
|
||||
Specify colours in the alternative HSV colour system."
|
||||
(let* ((chroma (* v s))
|
||||
(x (* chroma (- 1 (abs (- (mod (/ h 60) 2) 1)))))
|
||||
(m (- v chroma))
|
||||
(i (truncate h 60))
|
||||
(params (list chroma x 0 0 x chroma))
|
||||
(r (+ m (nth i params)))
|
||||
(g (+ m (nth (mod (+ i 4) 6) params)))
|
||||
(b (+ m (nth (mod (+ i 2) 6) params))))
|
||||
(rgb (round (* r 255)) (round (* g 255)) (round (* b 255)))))
|
||||
|
||||
(defun col (n)
|
||||
"(col n)
|
||||
Defines a different colour for each value of n from 0 to 7."
|
||||
(rgb (* (logand n 1) 160) (* (logand n 2) 80) (* (logand n 4) 40)))
|
||||
|
||||
(defun butlast (lst)
|
||||
"(butlast lst)
|
||||
Returns all but the last item in lst."
|
||||
(unless (null lst) (subseq lst 0 (1- (length lst)))))
|
||||
|
||||
(defun count (x lst)
|
||||
"(count x lst)
|
||||
Counts the number of items eq to x in lst."
|
||||
(if (null lst) 0
|
||||
(+ (if (eq x (car lst)) 1 0) (count x (cdr lst)))))
|
||||
|
||||
(defun count-if (tst lst)
|
||||
"(count-if tst lst)
|
||||
Counts the number of items in lst for which tst is true."
|
||||
(if (null lst) 0
|
||||
(+ (if (funcall tst (car lst)) 1 0) (count-if tst (cdr lst)))))
|
||||
|
||||
(defun count-if-not (tst lst)
|
||||
"(count-if-not tst lst)
|
||||
Counts the number of items in lst for which tst is false."
|
||||
(if (null lst) 0
|
||||
(+ (if (funcall tst (car lst)) 0 1) (count-if-not tst (cdr lst)))))
|
||||
|
||||
(defun find (x lst)
|
||||
"(find x lst)
|
||||
Returns x if x is in lst, or nil otherwise."
|
||||
(car (member x lst)))
|
||||
|
||||
(defun find-if (tst lst)
|
||||
"(find-if tst lst)
|
||||
Returns the first item in lst for which tst is true, or nil otherwise."
|
||||
(cond
|
||||
((null lst) nil)
|
||||
((funcall tst (car lst)) (car lst))
|
||||
(t (find-if tst (cdr lst)))))
|
||||
|
||||
(defun find-if-not (tst lst)
|
||||
"(find-if-not tst lst)
|
||||
Returns the first item in lst for which tst is false, or nil otherwise."
|
||||
(cond
|
||||
((null lst) nil)
|
||||
((not (funcall tst (car lst))) (car lst))
|
||||
(t (find-if-not tst (cdr lst)))))
|
||||
|
||||
(defun identity (x)
|
||||
"(identity x)
|
||||
Returns its argument."
|
||||
x)
|
||||
|
||||
(defun last (lst)
|
||||
"(last lst)
|
||||
Returns the last cdr of lst."
|
||||
(unless (null lst) (subseq lst (1- (length lst)))))
|
||||
|
||||
(defun mapl (fn lst)
|
||||
"(mapl fn lst)
|
||||
Applies fn to successive cdrs of lst, and returns lst."
|
||||
(mapl2 fn lst)
|
||||
lst)
|
||||
|
||||
(defun mapl2 (fn lst)
|
||||
(cond
|
||||
((null lst) nil)
|
||||
(t (funcall fn lst)
|
||||
(mapl2 fn (cdr lst)))))
|
||||
|
||||
(defun maplist (fn lst)
|
||||
"(maplist fn lst)
|
||||
Applies fn to successive cdrs of lst, and returns a list of the results."
|
||||
(if (null lst) nil
|
||||
(cons (funcall fn lst) (maplist fn (cdr lst)))))
|
||||
|
||||
(defun nconc (&rest lst)
|
||||
"(nconc lst*)
|
||||
Destructively appends its arguments together, which must be lists."
|
||||
(mapcan #'(lambda (x) x) lst))
|
||||
|
||||
(defun nthcdr (n lst)
|
||||
"(nthcdr n lst)
|
||||
Returns the nth cdr of lst."
|
||||
(if (zerop n) lst
|
||||
(nthcdr (1- n) (cdr lst))))
|
||||
|
||||
(defun position (x lst &optional (n 0))
|
||||
"(position x lst)
|
||||
Returns the position of the first x in lst, or nil if it's not found."
|
||||
(cond
|
||||
((null lst) nil)
|
||||
((eq x (car lst)) n)
|
||||
(t (position x (cdr lst) (1+ n)))))
|
||||
|
||||
(defun position-if (tst lst &optional (n 0))
|
||||
"(position-if tst lst)
|
||||
Returns the position of the first item in lst for which tst is true,
|
||||
or nil if none is found."
|
||||
(cond
|
||||
((null lst) nil)
|
||||
((funcall tst (car lst)) n)
|
||||
(t (position-if tst (cdr lst) (1+ n)))))
|
||||
|
||||
(defun position-if-not (tst lst &optional (n 0))
|
||||
"(position-if-not tst lst)
|
||||
Returns the position of the first item in lst for which tst is false,
|
||||
or nil if none is found."
|
||||
(cond
|
||||
((null lst) nil)
|
||||
((not (funcall tst (car lst))) n)
|
||||
(t (position-if-not tst (cdr lst) (1+ n)))))
|
||||
|
||||
(defun reduce (fn lst)
|
||||
"(reduce fn lst)
|
||||
Returns the result of applying fn to successive pairs of items from lst."
|
||||
(if (null (cdr lst)) (car lst)
|
||||
(funcall fn (car lst) (reduce fn (cdr lst)))))
|
||||
|
||||
(defun remove (x lst)
|
||||
"(remove x lst)
|
||||
Returns a list with all occurrences of x removed from lst."
|
||||
(mapcan #'(lambda (y) (unless (eq x y) (list y))) lst))
|
||||
|
||||
(defun remove-if (tst lst)
|
||||
"(remove-if tst lst)
|
||||
Returns a list with all items for which tst is true removed from lst."
|
||||
(mapcan #'(lambda (x) (unless (funcall tst x) (list x))) lst))
|
||||
|
||||
(defun remove-if-not (tst lst)
|
||||
"(remove-if-not tst 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)))
|
||||
|
||||
(defun user-symbols ()
|
||||
"(user-symbols)
|
||||
Returns a list of all the symbols add by a user after boot."
|
||||
(let ((library (list-library2)))
|
||||
(remove-if (lambda (sym) (member sym library)) (globals))))
|
||||
|
||||
(defun reset-user-environment ()
|
||||
"(reset-user-environment)
|
||||
Removes all user-defined symbols."
|
||||
(mapcar 'makunbound (user-symbols)))
|
||||
|
||||
(defun keyword-string (k)
|
||||
"(keyword-string k)
|
||||
Returns the keyword as a string, or nil if the arg isn't a keyword."
|
||||
(when (keywordp k)
|
||||
(subseq (string k) 1)))
|
||||
|
||||
(defun load-platform ()
|
||||
"(load-platform)
|
||||
Load-platform specific code if present, found on the SD card as
|
||||
platform.lsp (e.g. picocalc.lsp)."
|
||||
(let ((platform-file (concatenate 'string (keyword-string (platform)) ".lsp")))
|
||||
(when (sd-exists-p platform-file)
|
||||
(load platform-file))))
|
||||
|
||||
(load-platform)
|
||||
|
||||
(defvar *pkg* nil)
|
||||
|
||||
(defun lp ()
|
||||
(setf *pkg* (load "pkg.lsp")))
|
||||
|
||||
)lisplibrary";
|
||||
Reference in New Issue
Block a user