129 lines
4.6 KiB
Common Lisp
129 lines
4.6 KiB
Common Lisp
(in-package :wine-matrix/data-source)
|
|
|
|
(defclass dummy-data-source ()
|
|
((temps :initarg :temperatures
|
|
:type 'list
|
|
:initform '(0)
|
|
:documentation "Temperatures to be shown. This should be a circular list.")
|
|
(temp-unit :initarg :temperature-unit
|
|
:type 'symbol
|
|
:accessor temperature-unit
|
|
:initform 'kelvin
|
|
:documentation "The unit of temperature.")
|
|
(humids :initarg :humidities
|
|
:type 'list
|
|
:initform '(0)
|
|
:documentation "Humidities to be shown. This should be a circular list.")
|
|
(size :initarg :size
|
|
:initform '(1 . 1)
|
|
:type '(cons number number)
|
|
:accessor size
|
|
:documentation "Size of the rack. This is a cons.")
|
|
(rack :initform nil
|
|
:type 'list
|
|
:documentation "The rack itself. This is a list of lists.")
|
|
(last-update :initform nil
|
|
:type '(or null number)
|
|
:accessor last-update
|
|
:documentation "The time the readings where last updated.")
|
|
(update-interval :initarg :update-interval
|
|
:initform 5
|
|
:type 'number
|
|
:accessor update-interval
|
|
:documentation
|
|
"The interval, in seconds, for updating the readings.")))
|
|
|
|
(defmethod initialize-instance :after ((src dummy-data-source) &rest args)
|
|
(declare (ignorable args))
|
|
;; make temps and humids circular (if they aren't already)
|
|
(with-slots (temps humids) src
|
|
(when (list-length temps)
|
|
(let ((copy (copy-list temps)))
|
|
(setf temps (nconc copy copy))))
|
|
(when (list-length humids)
|
|
(let ((copy (copy-list humids)))
|
|
(setf humids (nconc copy copy))))))
|
|
|
|
(defun make-dummy-data-source (&rest args)
|
|
(apply 'make-instance 'dummy-data-source args))
|
|
|
|
(defun create-rack (rows cols)
|
|
"Create a rack with ROWS and COLS. Initialize it randomly."
|
|
(loop repeat rows
|
|
collect
|
|
(loop repeat cols
|
|
collect (= (random 2) 1))))
|
|
|
|
(defun create-or-update-rack (src)
|
|
"Initialize the rack slot of SRC. If it is already initialized, permute a
|
|
random entry."
|
|
(with-slots (size rack) src
|
|
(destructuring-bind (rows . cols) size
|
|
(if rack
|
|
(let ((row (random rows))
|
|
(col (random cols)))
|
|
(setf (nth col (nth row rack)) (not (nth col (nth row rack)))))
|
|
(setf rack (create-rack rows cols))))))
|
|
|
|
(defun maybe-update-readings (src)
|
|
"Update the readings of SRC if they are too out of date."
|
|
(let ((now (/ (get-internal-real-time) internal-time-units-per-second)))
|
|
(with-slots (temps humids last-update update-interval) src
|
|
(when (or (not last-update) (<= update-interval (- now last-update)))
|
|
(create-or-update-rack src)
|
|
(setf temps (cdr temps)
|
|
humids (cdr humids)
|
|
last-update now)))))
|
|
|
|
(defmethod temperature ((src dummy-data-source))
|
|
(maybe-update-readings src)
|
|
(cons (car (slot-value src 'temps))
|
|
(temperature-unit src)))
|
|
|
|
(defmethod humidity ((src dummy-data-source))
|
|
(maybe-update-readings src)
|
|
(cons (car (slot-value src 'humids))
|
|
'percent))
|
|
|
|
(defmethod rack ((src dummy-data-source))
|
|
(maybe-update-readings src)
|
|
(slot-value src 'rack))
|
|
|
|
(defun read-circular-number-list-option (string)
|
|
"Read a list of numbers, separated by spaces, from STR-VAL. If STR-VAL is
|
|
invalid, raise an `error'. Otherwise, return a circular list made of these
|
|
numbers."
|
|
(loop for i = 0 then new-i
|
|
while (< i (length string))
|
|
for (val new-i) = (multiple-value-list
|
|
(parse-integer string :start i :junk-allowed t))
|
|
while val
|
|
collect val into output
|
|
finally
|
|
(if (/= i (length string))
|
|
(error "not an integer ~s" (trim-string (subseq string i)))
|
|
(return (nconc output output)))))
|
|
|
|
(defun read-size-option (string)
|
|
"Read two numbers from STRING and return them as a cons. Raise an `error' if
|
|
something goes wrong."
|
|
(flet ((invalid (start)
|
|
(error "not an integer ~s" (trim-string (subseq string start)))))
|
|
(multiple-value-bind (n1 n2-start) (parse-integer string :junk-allowed t)
|
|
(unless n1
|
|
(invalid 0))
|
|
(let ((n2 (parse-integer string :start n2-start)))
|
|
(unless n2
|
|
(invalid n2-start))
|
|
(cons n1 n2)))))
|
|
|
|
(defmethod user-options ((src dummy-data-source))
|
|
'((temps read-circular-number-list-option "temperatures")
|
|
(humids read-circular-number-list-option "humidity data")
|
|
(size read-size-option "size")
|
|
(update-interval parse-integer "update interval")))
|
|
|
|
;; Local Variables:
|
|
;; jinx-local-words: "Humidities"
|
|
;; End:
|