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.

336 lines
15KB

  1. #|
  2. src/models/constructed-deck.lisp
  3. Constructed deck model:
  4. - CONSTRUCTED-DECK
  5. A CONSTRUCTED-DECK is based on a YDK-DECK. The YDK-DECK is built on
  6. the YDK object, which keeps track of synchronizing the stuff in the
  7. Deck Builder App with the database through YDK-SYNC. Since we don't
  8. plan on modifying CONSTRUCTED-DECKs, there is nothing analogous to
  9. YDK-SYNC for CONSTRUCTED-DECKs. I think that's what I'm implementing
  10. right now, the pull logic.
  11. - CONSTRUCTED-DECK-ITEM
  12. Analogous to DECK-ITEM. Nothing fancy here. Extra columns: YGO-SET-ITEM, SELL-PRICE.
  13. - SOLD-DECK
  14. NODO Supposed to represent decks sold in the same way Deck Templates
  15. -> Pulled Decks, Pulled Decks -> Sold Decks.
  16. |#
  17. (in-package #:cl-deck-builder2.models.constructed-decks)
  18. (defparameter +default-constructed-deck-sell-price+ "60.00"
  19. "Default sell price for constructed decks. We have the price for every card set to 0.50 cents. That works out to $35 for a 70 card deck. This is about twice that.")
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. (defclass constructed-deck ()
  22. ((;; The name of this CONSTRUCTED-DECK
  23. name :accessor deck-name-of
  24. :col-type :text
  25. :initarg :name)
  26. (category :accessor deck-category-of :col-type (or category :null))
  27. (created-by :accessor deck-created-by :col-type :text :initarg :created-by)
  28. (;; If the CONSTRUCTED-DECK has a SELL-PRICE, we override the total price of the deck with this price.
  29. sell-price :accessor deck-sell-price-of
  30. :col-type :integer
  31. :initarg :sell-price
  32. :initform +default-constructed-deck-sell-price+
  33. :deflate #'currency-deflate
  34. :inflate #'currency-inflate)
  35. ;; The original ID of the deck, probably from YDK-DECK
  36. (ydk-deck :accessor ydk-deck-of
  37. :col-type ydk-deck
  38. :initarg :ydk-deck)
  39. (sold :accessor deck-sold
  40. :col-type :binary
  41. :initarg :deck-sold
  42. :initform 0))
  43. (:metaclass registered-table-class)
  44. (:documentation "A Constructed deck is just a deck that has been \"pulled.\" That is,
  45. somebody built a deck template, clicked the \"Pull\" button. From
  46. what has been explained to me, we'll only pull decks we have. So
  47. we'll only construct decks with cards we know or think we know we have
  48. or we plan on getting more of. Then the physical cards will need to
  49. be collected and assembled into the deck following the template. This
  50. physical, real, action is what is recorded by the \"Pull\" action.
  51. It's important to note that it is impossible to constrain somebody
  52. from pulling arbitrary decks. A physical security device would need to
  53. be in place and a framework for authentication with it would be
  54. necessary (i.e. it is expected that one will use this tool with
  55. intention, respectfully, and will be trained on how to do so).
  56. Anyway. You don't actually have to physically pull the cards yet. This
  57. is just a record, think an earmark on a page, that these cards from
  58. this deck template have been pulled. YDK-DECK-PULL-FROM-INVENTORY does
  59. all the heavy lifting, and will return a CONSTRUCTED-DECK object if
  60. it was successful.
  61. Then, finally, during the deck construction phase, you will be
  62. prompted to select the variant of card, language, condition, etc.
  63. Once you are happy with your selection the constructed deck will be
  64. marked as \"FOR-SALE\"."))
  65. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  66. (defclass constructed-deck-item ()
  67. (;; The original ID of the CONSTRUCTED-DECK-ITEM, from DECK-ITEM
  68. ;; (passcode :accessor deck-passcode-of :col-type :integer)
  69. ;; (inventory-item :accessor deck-inventory-item-of :col-type inventory-item)
  70. (ygo-card :accessor ygo-card-of
  71. :col-type ygo-card
  72. :initarg :ygo-card)
  73. (deck-id :accessor deck-id-of
  74. :col-type :integer)
  75. (deck-item :accessor deck-item-of
  76. :col-type deck-item
  77. :initarg :deck-item)
  78. (ygo-set-item :accessor deck-set-item-of
  79. :col-type ygo-set-item
  80. :initarg :ygo-set-item))
  81. ;; (variant :accessor deck-item-variant-of
  82. ;; :col-type variant
  83. ;; :initarg :variant)
  84. ;;
  85. ;; Shouldn't inventory items have Qty and not constructed deck items?
  86. ;;
  87. ;; (opt-qty :accessor opt-qty-of
  88. ;; :col-type :integer
  89. ;; :initarg :opt-qty
  90. ;; :initform 0)
  91. ;; (qty :accessor qty-of
  92. ;; :col-type :integer
  93. ;; :initarg :qty
  94. ;; :initform 0)
  95. (:metaclass registered-table-class)
  96. (:documentation "A CONSTRUCTED-DECK-ITEM is pretty much the same as a DECK-ITEM, except it's a \"constructed\" deck.
  97. Same index idea and everything. The table is indexed into by CONSTRUCTED-DECK-ID.
  98. We subclass YGO-SETS for all the card metadata."))
  99. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  100. ;; Analogous to YDK-DECK -- Do we even need this? I just loop over the SET-ITEMS anyway.
  101. (defclass constructed-deck-intermediate ()
  102. ((deck-item :accessor cdi-deck-item
  103. :initarg :deck-item)
  104. (deck-set :accessor cdi-deck-set
  105. :initarg :deck-set)
  106. (set-item :accessor cdi-deck-set-item
  107. :initarg :set-item)
  108. (condition :accessor cdi-deck-condition
  109. :initarg :condition)
  110. (card :accessor cdi-deck-card
  111. :initarg :card)))
  112. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  113. ;; Just want the decks to be marked as sold. Easy.
  114. ;;
  115. ;; (defclass sold-deck (constructed-deck)
  116. ;; (;; Has the deck been sold?
  117. ;; (deck-sold :accessor constructed-deck-sold
  118. ;; :col-type :integer
  119. ;; :initarg :sold
  120. ;; :initform 0)
  121. ;; ;; 60 Doll Hairs
  122. ;; (sell-price :accessor deck-sell-price-of
  123. ;; :col-type :integer
  124. ;; :initarg :sell-price
  125. ;; :initform +default-constructed-deck-sell-price+
  126. ;; :deflate #'currency-deflate
  127. ;; :inflate #'currency-inflate))
  128. ;; (:metaclass registered-table-class))
  129. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  130. ;; I think this got superseded by CDI-PULL-FROM-INVENTORY since we
  131. ;; aren't pulling from YDKs any more but from
  132. ;; CONSTRUCTED-DECK-INTERMEDIATE.
  133. (defmethod ydk-deck-pull-from-inventory ((deck ydk-deck))
  134. "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."
  135. (with-connection (db)
  136. (let ((;; Get the OLD-DECK-ID
  137. old-deck-id (mito:object-id deck))
  138. (;; Create a new DECK based on the old DECK
  139. new (mito:create-dao 'constructed-deck
  140. :name (ydk-name-of deck)
  141. :category (ydk-category-of deck)
  142. :created-by (ydk-created-by deck)
  143. :sell-price +default-constructed-deck-sell-price+
  144. :ydk-deck deck)))
  145. ;; If the new deck was created successfully,
  146. (when new
  147. (let ((;; Get the NEW-DECK-ID
  148. new-deck-id (mito:object-id deck))
  149. (;; Get all the items from the old deck
  150. deck-items (mito:select-dao 'deck-item
  151. (sxql:where (:= :deck-id old-deck-id)))))
  152. (with-transaction
  153. (dolist (deck-item deck-items new)
  154. ;; Create a bunch of CONSTRUCTED-DECK-ITEMs for the
  155. ;; corresponding DECK-ITEMs. from the old DECK.
  156. (create-dao 'constructed-deck-item
  157. :deck-id new-deck-id
  158. :ygo-card-id (deck-passcode-of deck-item)))))))))
  159. ;; (defmethod mark-as-sold ((sold-deck sold-deck))
  160. ;; "Mark a SOLD-DECK as having been sold."
  161. ;; (setf (deck-sold sold-deck) 1)
  162. ;; (update-dao sold-deck))
  163. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  164. ;; This expects a list of CONSTRUCTED-DECK-INTERMEDIATE which has no documented format.
  165. ;;
  166. (defun deck-to-pull-set-items-qty-as-alist (cdi-items)
  167. "Construct an ALIST of PASSCODE . QTY from DECK listing. We use a list of CONSTRUCTED-DECK-INTERMEDIATE objects."
  168. (let ((alist '()))
  169. (dolist (row cdi-items alist)
  170. (push (cons (cdi-deck-set-item row)
  171. (qty-of (cdi-deck-set-item row)))
  172. alist))))
  173. (defun deck-to-pull-desired-qty-as-alist (cdi-items)
  174. "Construct an ALIST of PASSCODE . (COUNT PASSCODE) from DECK listing. We use a list of CONSTRUCTED-DECK-INTERMEDIATE objects."
  175. (let ((alist '()))
  176. (dolist (row cdi-items alist)
  177. (if (assoc (cdi-deck-set-item row) alist :test #'mito:object=)
  178. (incf (cdr (assoc (cdi-deck-set-item row) alist :test #'mito:object=)))
  179. (push (cons (cdi-deck-set-item row) 1) alist)))))
  180. (defun subtract-desired-from-set-item-qty-as-alist (set-items-qty desired-items-qty)
  181. "Perform a DECF on the CDR of the paired elements from (DECK-TO-PULL-SET-ITEMS-QTY-AS-ALIST) using (DECK-TO-PULL-DESIRED-QTY-AS-ALIST) as the source argument."
  182. (dolist (pair desired-items-qty set-items-qty)
  183. (if (assoc (car pair) set-items-qty :test #'mito:object=)
  184. (decf (cdr (assoc (car pair) set-items-qty :test #'mito:object=))
  185. (cdr pair))
  186. (v:info :construct "Invalid ID pair: ~a" (car pair)))))
  187. (defun find-any-invalid-qtys (set-items-qty desired-items-qty)
  188. (with-connection (db)
  189. (with-transaction
  190. (loop for pair in (subtract-desired-from-set-item-qty-as-alist set-items-qty desired-items-qty)
  191. do (when (minusp (cdr pair))
  192. (return (ygo-passcode-of (item-of (car pair)))))))))
  193. (defun valid-pull-p (set-items-qty desired-items-qty)
  194. "Loop over the results of SUBTRACT-DESIRED-FROM-SET-ITEM-QTY-AS-ALIST, looking for any less-than-zero values. If any exist, we took too much out of inventory, and the pull is \"invalid,\" we return NIL. Otherwise, the pull will be successful (we have enough inventory), so return T."
  195. (not (find-any-invalid-qtys set-items-qty desired-items-qty)))
  196. ;; Actually subtract the amounts from the set item
  197. ;; make the CONSTRUCTED-DECK with CONSTRUCTED-DECK-ITEM
  198. ;; Make the view panel
  199. (defun cdi-pull-from-inventory (cdi-list)
  200. "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."
  201. (with-connection (db)
  202. (let* ((;; Get the OLD-DECK-ID
  203. old-deck-id (deck-id-of (cdi-deck-item (car cdi-list))))
  204. (;; Get the OLD DECK
  205. old-deck (mito:find-dao 'ydk-deck :id old-deck-id))
  206. (;; Create a new DECK based on the old DECK
  207. new (mito:create-dao 'constructed-deck
  208. :name (ydk-name-of old-deck)
  209. :category (ydk-category-of old-deck)
  210. :created-by (ydk-created-by old-deck)
  211. :sell-price +default-constructed-deck-sell-price+
  212. :ydk-deck old-deck)))
  213. ;; If the new deck was created successfully,
  214. (when new
  215. ;; Get the NEW-DECK-ID
  216. (let ((new-deck-id (mito:object-id new)))
  217. ;; iterate over all the items from the old deck
  218. (with-transaction
  219. (dolist (row cdi-list new)
  220. ;; Create a bunch of CONSTRUCTED-DECK-ITEMs for the
  221. ;; corresponding DECK-ITEMs. from the old DECK.
  222. (mito:create-dao 'constructed-deck-item
  223. :deck-id new-deck-id
  224. :deck-item-id (mito:object-id (cdi-deck-item row))
  225. :ygo-set-item-id (mito:object-id (cdi-deck-set-item row))
  226. :ygo-card-id (deck-passcode-of (cdi-deck-item row))))))))))
  227. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  228. (defun return-to-inventory (cdi-items)
  229. "Attempt to find inventory stock for every card in this deck, and increment the count by however many we specify in the CDR."
  230. (let ((counts (deck-to-pull-desired-qty-as-alist cdi-items)))
  231. (dolist (row counts)
  232. (incf (qty-of (car row)) (cdr row))
  233. ;; Update each one and save - wrapping this in a transaction causes issues with pulling multiple items.
  234. (save-dao (car row)))))
  235. (defun constructed-deck-as-cdi-list (constructed-deck-id)
  236. (with-connection (db)
  237. (let ((deck
  238. (mito:select-dao 'constructed-deck-item
  239. (mito:includes 'ygo-card 'deck-item 'ygo-set-item)
  240. (sxql:order-by :asc :id)
  241. (sxql:where (:= :deck-id constructed-deck-id))))
  242. (lst '()))
  243. (dolist (row deck (reverse lst))
  244. (let ((deck-set-item (deck-set-item-of row)))
  245. (push (make-instance 'constructed-deck-intermediate
  246. :card (ygo-card-by-passcode (ygo-passcode-of (ygo-card-of row)))
  247. :condition (variant-of deck-set-item)
  248. :deck-item (deck-item-of row)
  249. :deck-set (ygo-set-by-id (mito:object-id (item-of deck-set-item)))
  250. :set-item deck-set-item)
  251. lst))))))
  252. ;; TODO Use STORE-CONSTRUCTED-DECK-AS-CURRENT to load a
  253. ;; CONSTRUCTED-DECK out of the database into
  254. ;; *CURRENT-CONSTRUCTED-DECK* so we can use RETURN-TO-INVENTORY on it.
  255. (defun cdi-return-to-inventory (cdi-list)
  256. (error "TODO"))
  257. ;; Where did this code from? I feel like it got easily superceded by CALCULATE-OPTIMUM-QTY.
  258. ;; I think it was used in CARDS-IN-ALL-DECKS?
  259. (defun unique-constructed-deck-item-passcodes ()
  260. "Select the unique cards in all CONSTRUCTED-DECK-ITEMs"
  261. (let ((deck-items
  262. (with-connection (db)
  263. (mito:select-dao 'constructed-deck-item
  264. (sxql:group-by :passcode)
  265. (sxql:order-by :passcode :desc))))
  266. (ht (make-hash-table)))
  267. (with-connection (db)
  268. (with-transaction
  269. (dolist (deck-item (reverse deck-items) ht)
  270. (pushnew (list :deck-id (deck-id-of deck-item)
  271. :constructed-deck (mito:find-dao 'constructed-deck :id (deck-id-of deck-item))
  272. :ygo-card (mito:find-dao 'ygo-card :id (deck-passcode-of deck-item)))
  273. (gethash (deck-passcode-of deck-item) ht)
  274. :key (lambda (plist) (getf plist :deck-id))))))))
  275. (defun calculate-optimum-qty ()
  276. (with-connection (db)
  277. (let ((count-data
  278. (with-transaction
  279. (mito:retrieve-by-sql
  280. (sxql:select (:passcode (:as (:count :passcode) :count))
  281. (sxql:from :deck_item)
  282. (sxql:group-by :passcode)
  283. (sxql:order-by (:count :passcode) :asc)))))
  284. (lst '()))
  285. (with-transaction
  286. (mapcar #'mito:execute-sql
  287. (dolist (row count-data lst)
  288. (let ((passcode (getf row :passcode))
  289. (opt-qty (getf row :count)))
  290. (push
  291. (sxql:update :ygo_set_item
  292. (sxql:set= :opt_qty (* 5 opt-qty))
  293. (sxql:where (:in :item_id
  294. (sxql:select :id
  295. (sxql:from :ygo_set)
  296. (sxql:where (:= :passcode_id passcode))))))
  297. lst))))))))