Yu-Gi-Oh! Deck Building and Card Inventory Management web interface written in Common Lisp, utilizing HTMX.
Você não pode selecionar mais de 25 tópicos
Os tópicos devem começar com uma letra ou um número, podem incluir traços ('-') e podem ter até 35 caracteres.
|
- #|
-
- 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 "<img class=\"card image\" src=\"/public/qr.png?~d\" alt=\"QR Code\">" when))
|