Bubblegumdrop
/
cl-deck-builder2
1
1
Fork 0
Koodi Ongelmat 0 Pull-pyynnöt 0 Julkaisut 0 Wiki Activity
Yu-Gi-Oh! Deck Building and Card Inventory Management web interface written in Common Lisp, utilizing HTMX.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1 Commit
1 Haara
5.3MB
Puu: fc475a9eec
Branchit Tagit
${ item.name }
Create branch ${ searchTerm }
from 'fc475a9eec'
${ noResults }
cl-deck-builder2/src/web/constructed-decks.lisp

240 lines
11KB
Raaka Blame Historia 

  1. #|

  2. 

  3. src/web/construct-decks.lisp

  4. 

  5. Web Routes For Construct Decks

  6. 

  7. TODO Pick one: /construct/ or /construct/ ?

  8. 

  9. Features Requsted:

  10. 

  11. - DONE Card Names

  12. - DONE Card Prices - I think we'll need to wire this up to the

  13.   YGO-CC-ITEM. That requires rewriting that component to use the new

  14.   YGO-SET instead of the CSV.

  15. - DONE Sort by Price - Honestly having trouble sorting this junk lmao!

  16. - Show only YGO-SET-ITEMS with inventory - see constructed-decks.lisp<models>

  17. 

  18. 

  19. |#

  20. 

  21. (in-package #:cl-deck-builder2.web)

  22. 

  23. (defparameter *current-constructed-deck* nil)

  24. 

  25. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  26. (defun render-construct-deck (id tpl)

  27.   (with-logged-in-user

  28.     (let ((deck (first

  29.                  (select-constructed-decks

  30.                    (sxql:where (:= :id id))))))

  31.       (when deck

  32.         (render-with-env tpl

  33.                          (list :active "/construct"

  34.                                :deck deck

  35.                                :id (mito:object-id deck)

  36.                                :name (cl-deck-builder2.models.constructed-decks::deck-name-of deck)

  37.                                :saved-deck-list (select-constructed-decks)))))))

  38. 

  39. ;; I think this takes a CAR and a CDR pair of YGO-SET ID and VARIANT ID

  40. ;; I'm pretty sure it's supposed to be finding YGO-SET-ITEMs though

  41. (defun selected-sets-to-deck-listing (cards)

  42.   (let ((lst '()))

  43.     (with-connection (db)

  44.       (with-transaction

  45.         (dolist (card cards (reverse lst))

  46.           (destructuring-bind (set variant)

  47.               card

  48.             (let* ((set-id (cdr set))

  49.                    (variant-id (cdr variant))

  50.                    (set-item (first (ygo-select-set-item set-id variant-id)))

  51.                    (set (first (ygo-set (sxql:where (:= :id set-id)))))

  52.                    (variant (mito:find-dao 'variant-condition :id variant-id)))

  53.               (with-slots ((passcode-id cl-deck-builder2.models.ygoprodeck.classes::passcode-id))

  54.                   set

  55.                 (push (list :deck-set set

  56.                             :condition variant

  57.                             :set-item set-item

  58.                             :card (ygo-card-by-passcode passcode-id))

  59.                       lst)))))))))

  60. 

  61. ;; XXX Where does this go? What does this accomplish?

  62. (defun select-deck-as-plist (id)

  63.   (let ((lst '()))

  64.     (dolist (itm (retrieve-dao 'deck-item :deck-id id) (reverse lst))

  65.       (push (list :deck-item itm) lst))))

  66. 

  67. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  68. (defun default-constructed-deck-is-valid-to-pull ()

  69.   (valid-pull-p

  70.    (deck-to-pull-set-items-qty-as-alist *current-constructed-deck*)

  71.    (deck-to-pull-desired-qty-as-alist *current-constructed-deck*)))

  72. 

  73. (defun default-constructed-deck-invalid-qtys ()

  74.   (find-any-invalid-qtys

  75.    (deck-to-pull-set-items-qty-as-alist *current-constructed-deck*)

  76.    (deck-to-pull-desired-qty-as-alist *current-constructed-deck*)))

  77. 

  78. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  79. (defun store-combined-deck-as-current (original-deck selected-listing)

  80.   (setf *current-constructed-deck*

  81.         (loop for original in (reverse original-deck)

  82.               for selected in selected-listing

  83.               collect (apply #'make-instance 'constructed-deck-intermediate (append original selected)))))

  84. 

  85. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  86. ;; We have to actually pull the inventory.

  87. ;; This is the old code but it's written for YDK-DECK object so maybe I'll write one for CONSTRUCTED-DECK-INTERMEDIATE.

  88. (defun pull-from-inventory (cdi-items)

  89.   "Attempt to find inventory stock for every card in this deck, and if we are able to secure it, construct and insert a new PULLED-DECK into the database."

  90.   (let ((counts (deck-to-pull-desired-qty-as-alist cdi-items)))

  91.     (dolist (row counts)

  92.       (decf (qty-of (car row)) (cdr row))

  93.       ;; Update each one and save - wrapping this in a transaction causes issues with pulling multiple items.

  94.       (save-dao (car row)))))

  95. 

  96. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  97. (defroute ("/construct" :method :GET) ()

  98.   "Constructed Deck View Main Route. Login Required."

  99.   (v:info :construct "GET /construct")

  100. 

  101.   (with-logged-in-user

  102.     (render-with-env #P"construct/index.html"

  103.                      (list :active "/construct"

  104.                            :saved-deck-list (select-constructed-decks)))))

  105. 

  106. (defroute ("/construct/:id/view" :method :GET) (&key id)

  107.   "Constructed Deck View deck by ID Route. Login Required."

  108.   (v:info :construct "GET /construct/~d" id)

  109. 

  110.   (with-logged-in-user

  111.     (render-construct-deck id #P"construct/index.html")))

  112. 

  113. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  114. (defroute ("/construct/ygo-set-item" :method :GET) (&key _parsed)

  115.   "Find the YGO-SET-ITEM associated with the |SET-ID| and |VARIANT-ID|

  116. 

  117. TODO This needs a rewrite as it currently actually accepts multiple

  118. CARDs and operates on their component |SET-ID| and |VARIANT-ID| which

  119. is really not optimal. Ideally we should be handling this all in bulk

  120. with better routes."

  121.   (v:info :cards "GET /cards/ygo-set-items ~a" _parsed)

  122. 

  123.   (with-logged-in-user

  124.     (alexandria:if-let ((cards (query-param "cards" _parsed)))

  125.       (dolist (card cards)

  126.         (let ((|set-id| (query-param "set-id" card))

  127.               (|variant-id| (query-param "variant-id" card)))

  128.           (handler-case

  129.               (ratify:with-parsed-forms

  130.                   ((:integer |set-id|)

  131.                    (:integer |variant-id|))

  132.                 (return

  133.                   (render-with-env #P"cards/variant-results.html"

  134.                                    (list :id (gensym)

  135.                                          :item (find |variant-id|

  136.                                                      (select-ygo-cc-item-variants |set-id|)

  137.                                                      :key (alexandria:compose #'mito:object-id #'variant-of))))))

  138.             (ratify:combined-error (e)

  139.               (flash-error (format nil "/cards/ygo-set-items => ~d:~d ~a~%" |set-id| |variant-id| e)))))))))

  140. 

  141. 

  142. (defroute ("/construct/:id/select-sets" :method :GET) (&key id)

  143.   "Select the YDK-SET for the corresponding PASSCODEs. Use Deck ID from the deck builder."

  144.   (v:info :construct "GET /construct/~d/select-sets" id)

  145. 

  146.   (with-logged-in-user

  147.     (with-connection (db)

  148.       (let* ((cards (mito:retrieve-dao 'deck-item :deck-id id))

  149.              (sets (mapcar (alexandria:compose #'ygo-card-sets #'deck-passcode-of) cards))

  150.              (variants (select-variant-condition)))

  151.         (render-with-env #P"construct/select-sets.html"

  152.                          (list :sets (reverse sets)

  153.                                :deck-id id

  154.                                :variants variants))))))

  155. 

  156. (defroute ("/construct/:id/select-sets" :method :POST) (&key id _parsed)

  157.   "Constructed Decks Select Sets POST Route - Attempt to SUBTRACT-DESIRED-FROM-SET-ITEM-QTY-AS-ALIST, and if VALID-PULL-P, call PULL-FROM-INVENTORY. Otherwise, FLASH-ERROR to the user about Insufficient Inventory."

  158.   (v:info :construct "POST /construct/~d/select-sets ~a" id _parsed)

  159. 

  160.   (with-logged-in-user

  161.     (alexandria:if-let ((cards (query-param "cards" _parsed)))

  162.       (let ((original-deck (select-deck-as-plist id))

  163.             (selected-listing (selected-sets-to-deck-listing cards)))

  164. 

  165.         ;; Store the current constructed deck template

  166.         (store-combined-deck-as-current original-deck selected-listing)

  167. 

  168.         ;; See if there are any issues with the current inventory

  169.         (if (default-constructed-deck-is-valid-to-pull)

  170.             (progn

  171.               ;; Decrement the stock from the YGO-SET-ITEM

  172.               (pull-from-inventory *current-constructed-deck*)

  173.               ;; Create a new CONSTRUCTED-DECK  based on *CURRENT-CONSTRUCTED-DECK*

  174.               (cdi-pull-from-inventory *current-constructed-deck*)

  175.               (flash-message (_ "Deck constructed!"))

  176.               (render-with-env #P"construct/constructed-deck-list.html"

  177.                                (list :original-deck original-deck

  178.                                      :deck-id id

  179.                                      :total-price nil

  180.                                      :table *current-constructed-deck*)))

  181.             (let ((err (default-constructed-deck-invalid-qtys)))

  182.               (with-connection (db)

  183.                 (flash-error (format nil (_ "Insufficient Inventory: <a href=\"/cards/by-passcode/~a\" target=\"_blank\">~a</a>")

  184.                                      ;; TODO all this nesting again...

  185.                                      (ygo-passcode-of err)

  186.                                      (ygo-passcode-of err))))

  187.               (redirect (format nil "/construct/~d/select-sets" id))))))))

  188. 

  189. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  190. (defroute ("/construct/:id/deconstruct" :method :POST) (&key id _parsed)

  191.   "Deconstruct deck. That is, increment the QTY of the the contents to of the CONSTRUCTED-DECK-AS-CDI-LIST."

  192.   (v:info :construct "POST /construct/~d/deconstruct ~a" id _parsed)

  193. 

  194.   (with-logged-in-user

  195.     (return-to-inventory

  196.      (constructed-deck-as-cdi-list id)))

  197. 

  198.   (_ "Ok!"))

  199. 

  200. (defroute ("/construct/:id/selected-sets" :method :GET) (&key id _parsed)

  201.   "Query CONSTRUCTED-DECK ID for the YGO-SET-ITEMS it contains. We use CONSTRUCTED-DECK-AS-CDI-LIST again."

  202.   (v:info :construct "GET /construct/~d/selected-sets ~a" id _parsed)

  203. 

  204.   (with-logged-in-user

  205.     (let ((table (constructed-deck-as-cdi-list id)))

  206.       (render-with-env #P"construct/constructed-deck-list.html"

  207.                        (list :table table)))))

  208. 

  209. (defroute ("/construct/:id/update" :method :POST) (&key id |name| |sell-price| |sold| _parsed)

  210.   "Update a  CONSTRUCTED-DECK by ID"

  211.   (v:info :construct "POST /construct/~d/update ~a" id _parsed)

  212. 

  213.   (with-logged-in-user

  214.     (let ((found (find-dao 'constructed-deck :id id)))

  215.       (when found

  216.         (when |name| (setf (deck-name-of found) |name|))

  217.         (when |sell-price| (setf (deck-sell-price-of found) |sell-price|))

  218.         (when (string= |sold| "on") (setf (deck-sold found) 1))

  219.         (update-dao found)

  220.         (flash-message (_ "Deck Updated"))

  221.         (redirect (format nil "/construct/~d/view" id))))))

  222. 

  223. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  224. 

  225. ;; This one looks like: Get all the cards in a deck id 13 and query all the sets using YGO-CARD-SETS

  226. 

  227. ;; (let* ((cards (retrieve-dao 'deck-item :deck-id 13))

  228. ;;        (all-sets (mapcar #'deck-passcode-of cards)))

  229. ;;   (mapcar #'cl-deck-builder2.models.ygoprodeck.methods::ygo-card-sets

  230. ;;           (reverse all-sets)))

  231. 

  232. ;; (with-connection (db)

  233. ;;   (with-transaction

  234. ;;     (let ((v (mito:find-dao 'cl-deck-builder2.models.ygoprodeck.fields::variant-condition :name "Near Mint")))

  235. ;;       (mapcar (lambda (set)

  236. ;;                 (mito:find-dao 'cl-deck-builder2.models.ygoprodeck.classes::ygo-set-item

  237. ;;                                :item set

  238. ;;                                :variant v))

  239. ;;               *))))