// 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)
    (loop
      (let ((form  (read str)))
	(unless form (return))
	(print (second form))
	(eval form)))))

(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 rtc-set (hr min)
 "(rtc-set hr min)
Set the time on a DS3231 RTC. Times are in BCD, so use
the appropriate reader macro, e.g. (rtc-set #x12 #x34)
for 12:34. Assumes seconds are zero."
  (with-i2c (str #x68)
    (write-byte 0 str)
    (write-byte 0 str)
    (write-byte min str)
    (write-byte hr str)))

(defun rtc-get ()
  (with-i2c (str #x68)
    (write-byte 0 str)
    (restart-i2c str 3)
    (reverse
      (list
        (read-byte str)
        (read-byte str)
        (read-byte str)))))

(defun rtc-now ()
 "(rtc-now)
Set the time using the RTC."
  (now (rtc-get)))

)lisplibrary";