#| QR Code Model Constantly fixing their user input was getting janky. DEFCLASS to the rescue! TODO This is still pretty clumbsy. I'm generating HTML in here?? Originally I was using INITIALIZE-INSTANCE but that would clobber the object with the DEFAULT-INITARGS. Now we're overriding REINITIALIZE-INSTANCE, which seems to work exactly as you'd expect. |# (in-package #:cl-deck-builder2.models.qr-code) ;; XXX (defparameter *qr-public-file* #P"~/public/qr.png") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defclass qr-settings () ((string :accessor qr-string :initarg :string) (min-version :accessor qr-min-version :initarg :min-version) (ec-level :accessor qr-ec-level :initarg :ec-level) (encoding-mode :accessor qr-encoding-mode :initarg :encoding-mode) (mask-number :accessor qr-mask-number :initarg :mask-number) (output-path :accessor qr-output-path :initarg :output)) (:default-initargs :ec-level :L :encoding-mode :8-BIT-BYTE :mask-number -1 :min-version 1 :output #P"/tmp/qr.png" :string "Hello World")) (defmethod reinitialize-instance :after ((qr-settings qr-settings) &rest initargs &key content &allow-other-keys) (declare (ignore initargs)) (when content (reinitialize-with-content qr-settings content))) ;; Overwrite existing slots even if they're SLOT-BOUNDP with SLOT-VALUE (defmethod reinitialize-with-content ((qr-settings qr-settings) content) ;; TODO ALIST-PARAMS-to-class? The idea is there... (alexandria:if-let ((string (query-param "string" content))) (setf (qr-string qr-settings) string)) (alexandria:if-let ((min-version (query-param "min-version" content))) (setf (qr-min-version qr-settings) (parse-integer min-version))) (alexandria:if-let ((ec-level (query-param "ec-level" content))) (setf (qr-ec-level qr-settings) (alexandria:make-keyword ec-level))) (alexandria:if-let ((encoding-mode (query-param "encoding-mode" content))) (setf (qr-encoding-mode qr-settings) (alexandria:make-keyword encoding-mode))) (alexandria:if-let ((mask-number (query-param "mask-number" content))) (setf (qr-mask-number qr-settings) (parse-integer mask-number))) qr-settings) ;; TODO %from-plist ;; TODO %from-alist? (defmethod qr-to-plist ((qr-settings qr-settings) &optional html) (let ((params (list :ec-level (qr-ec-level qr-settings) :encoding-mode (qr-encoding-mode qr-settings) :mask-number (qr-mask-number qr-settings) :min-version (qr-min-version qr-settings)))) (when html (setf (getf params :string) (qr-string qr-settings) (getf params :ec-level) (princ-to-string (getf params :ec-level)) (getf params :encoding-mode) (princ-to-string (getf params :encoding-mode)))) params)) (defmethod qr-generate ((qr qr-settings)) (v:info :qr "QR-STRING: ~a" (qr-string qr)) (v:info :qr "UIOP:DELETE-FILE-IF-EXISTS: ~a" (ignore-errors (mapcar #'uiop:delete-file-if-exists '(#P"/tmp/qr.png" #P"~/public/qr.png")))) (v:info :qr "LISPQR:ENCODE->IMAGE: ~a" (ignore-errors (apply #'lispqr:encode->image (qr-string qr) (qr-output-path qr) (qr-to-plist qr)))) (v:info :qr "UIOP:COPY-FILE: ~a" (ignore-errors (uiop:copy-file (qr-output-path qr) *qr-public-file*))) (if (probe-file *qr-public-file*) (qr-format-html (get-universal-time)))) (defun qr-format-html (when) (format nil "\"QR" when))