|
- #|
-
- src/models/ydk/classes.lisp
-
- # YDK
-
- Yu-Gi-Oh! Pro Deck YDK Importer And Models
-
- TODO This can be a stand-alone package CL-YDK + the CL-YDK+MITO mixin probably.
-
- |#
-
- (in-package #:cl-deck-builder2.models.ydk)
-
- (defclass deck-item ()
- (;; 0 => Main Deck
- ;; 1 => Extra Deck
- ;; 2 => Side Deck
- (deck-id :accessor deck-id-of :col-type :integer)
- (kind :accessor deck-kind-of :col-type :integer)
- (passcode :accessor deck-passcode-of :col-type :integer))
- (:metaclass registered-table-class)
- (:documentation "DECK-LIST is a representation of a single card in a YDK deck in
- SQL. Since SQL doesn't have a LIST type, we use a bunch of
- these (60-90 rows generally make up a deck). The ID field supplied by
- MITO:DAO-TABLE-CLASS is the \"Deck ID\" in the builder system."))
-
- (defclass ydk-deck ()
- (;; (id :accessor ydk-id-of :col-type :integer :primary-key t)
- (category :accessor ydk-category-of :col-type (or category :null))
- (created-by :accessor ydk-created-by :col-type :text :initarg :created-by)
- (name :accessor ydk-name-of :col-type :text :initarg :name))
- (:unique-keys name)
- (:metaclass registered-table-class)
- (:documentation "A YDK-DECK is an in-database representation of a deck. It's really actually just an index to keep track of metadata, with the ID field used to key into DECK-ITEM.
-
- SQL doesn't allow us to store anything as a list. We take advantage
- of Mito's INSERT-DAO, SELECT-DAO, etc. being methods which we can
- define :BEFORE :AFTER and :AROUND methods for. The YDK-DECK class is
- an intermediate representation of a deck. Bookeeping for the \"Deck
- ID\", CREATED-BY, and NAME."))
-
- (defclass ydk ()
- ((;; I think this is supposed to be the MITO:OBJECT-ID to keep tabs
- ;; on the SYNC status... Looks like I never wrote it down, but I'm
- ;; pretty sure that was my intention with this SLOT. It's been a
- ;; pain point previously (PPP).
- deck-id :accessor ydk-id-of :initarg :deck-id)
- (created-by :accessor ydk-created-by :initarg :created-by :initform nil)
- (name :accessor ydk-name-of :initarg :name :initform nil)
- (main-deck :accessor ydk-main-deck-of :initarg :main-deck :initform '())
- (extra-deck :accessor ydk-extra-deck-of :initarg :extra-deck :initform '())
- (side-deck :accessor ydk-side-deck-of :initarg :side-deck :initform '()))
- (:documentation "Intermediate YDK representation.
-
- This is what's stored in-memory during program operation, and then gets synced to the database.
-
- Notice this class does not draw from MITO:DAO-TABLE-CLASS."))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Helper functions
- ;;
- ;; TODO maybe I don't have to duplicate this data?
- ;;
- ;; I tried using defparameter but defmacro complained when I tried to
- ;; load it.
- ;;
- ;; Aha, The Original Variant.
- ;; This code needs to be incorporated into the VARIANT code.
-
- (defmacro %sql-to-keyword (type)
- `(ecase ,type
- (0 :main-deck)
- (1 :extra-deck)
- (2 :side-deck)))
-
- (defmacro %keyword-to-sql (type)
- `(ecase ,type
- (:main-deck 0)
- (:extra-deck 1)
- (:side-deck 2)))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; TODO I think I'm going to erase all these DEFUNs since they're kinda
- ;; outdated now with the changes I made in db.lisp
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Delete
- (defun ydk-deck-delete-from (&rest clauses)
- (apply #'delete-from 'ydk-deck clauses))
-
- (defun ydk-deck-item-delete-from (&rest clauses)
- (apply #'delete-from 'deck-item clauses))
-
- (defun ydk-deck-delete-by-id (id)
- "Remove all matching ID from YDK-DECK and DECK-ITEM, effectively erasing the deck from the database."
- (ydk-deck-delete-from
- (sxql:where (:= :id id)))
- (ydk-deck-item-delete-from
- (sxql:where (:= :deck_id id))))
-
- (defun ydk-deck-delete-by-name (name)
- (let ((found (ydk-deck-by-name name)))
- (when found
- ;; Delete from both the DECK-ITEM and the YDK-DECK reference
- ;; table. The :deck_item table doesn't have a :NAME field, it
- ;; only has the :DECK_ID field. So we need to use
- ;; SELECT-DECK-BY-NAME anyway.
- (ydk-deck-delete-by-id (mito:object-id found)))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Select
- (defmacro ydk-table-select (&body body)
- `(select-dao 'ydk-deck ,@body))
-
- (defun ydk-table-select-count (&optional fields-and-values)
- (apply #'count-dao 'ydk-deck fields-and-values))
-
- (defun ydk-deck-by-id (id &rest args)
- (apply #'find-dao 'ydk-deck :id id args))
-
- (defun ydk-deck-by-name (name &rest args)
- (apply #'find-dao 'ydk-deck :name name args))
-
- ;; Very cool to have figured this out. To get info on a deck, select
- ;; the deck_item where the deck_id is the deck you want. Then INNER
- ;; JOIN on :card_info. It just works. One db trip. Aweseome!
- ;;
- ;; TODO how can we do this with SELECT-DAO?
- ;;
- ;; For now since this is only getting used in one place, RENDER-YDK,
- ;; which is albeit, a pretty core component, ... I'll use
- ;; datafly. Until I figure out how to relate these columns.
- ;;
- ;; I think this is a duplicate of YDK-QUERY... Okay it occured to
- ;; me. I used to use YDK-QUERY before I figured this one out and I
- ;; think I know what's going on.
- ;;
- ;; So YDK-DECK-INFO-BY-ID uses SQL to do an INNER JOIN to get the data
- ;; from the deck. YDK-QUERY works on decks that aren't in the database
- ;; and only returns partial information. I have to use that info to
- ;; re-construct the data. The original purpose of YDK-QUERY was to use
- ;; it like a look-up table, based on that sorting dev.to article.
- ;;
- ;; But then I realized, it's a lot more efficient to do it at the
- ;; database level. so that's where YDK-DECK-INFO-BY-ID was born
- ;; from. It works on existing decks in the database.
- (defgeneric ydk-query (id))
-
- (defmethod ydk-query ((id integer))
- "Query the database for information from YGO_INFO about the DECK ID."
- (with-connection (db)
- (with-transaction
- (mito:retrieve-by-sql
- (sxql:select :*
- (sxql:from :ygo_info)
- (sxql:inner-join :deck_item
- :on (:= :deck_item.passcode :ygo_info.passcode))
- (sxql:order-by :asc :deck_item.id)
- (sxql:where (:= :deck_id id)))))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defmethod ydk-query ((ydk-deck ydk-deck))
- "Query the YDK-DECK by its MITO:OBJECT-ID"
- (ydk-query (mito:object-id ydk-deck)))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defmethod ydk-query ((ydk ydk))
- "Select entries from :YGOPRODECK-DATA corresponding to the unique list
- of cards in DECK. This can be used as a look up table to construct a
- deck description.
-
- It looks like I updated YDK-QUERY to work with the new YDK-ALL output. Neat!"
- (let* ((all (ydk-all ydk))
- (cards (ydk-concatenate ydk))
- (info (with-datafly-connection (db)
- (with-datafly-transaction (db)
- (datafly:retrieve-all
- (sxql:select :*
- (sxql:from :ygo_info)
- (sxql:where (:in :passcode cards))))))))
- (labels ((query-deck (kind)
- (loop for passcode in (getf all kind)
- collect
- (find passcode info
- :key (lambda (plist) (getf plist :passcode))))))
- (list
- :main-deck (query-deck :main-deck)
- :extra-deck (query-deck :extra-deck)
- :side-deck (query-deck :side-deck)))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Update
- (defmethod ydk-rename-deck ((ydk-deck ydk-deck) new-name)
- (setf (ydk-name-of ydk-deck) new-name)
- (save-dao ydk-deck))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defun normalize-content (content)
- "Strip UTF-8 BOM, \"\r\n\" sequences, then split on #\Newline into a list."
- (etypecase content
- ;; It's a LIST - pass it on
- (list content)
- ;; It's a PATHNAME - UIOP:READ-FILE-STRING and then treat it like
- ;; a STRING.
- (pathname
- (split-sequence:split-sequence
- #\Newline
- (normalize-newlines
- (strip-bom (uiop:read-file-string content)))))
- ;; It's a STRING: strip BOM and normalize newlines.
- (string
- (split-sequence:split-sequence
- #\Newline
- (normalize-newlines
- (strip-bom content))))))
-
- (defmethod initialize-with-content ((ydk ydk) content)
- (let ((created-by nil)
- (main-deck '())
- (extra-deck '())
- (side-deck '())
- (state :in-created-by))
-
- (dolist (itm (normalize-content content))
- ;; A bunch of :END2 checks to prevent overrun.
- (unless
- ;; Detect state change
- (cond ((string-equal "#main" itm :end2 (min (length itm) 5))
- (setf state :in-main)
- t)
- ((string-equal "#extra" itm :end2 (min (length itm) 6))
- (setf state :in-extra)
- t)
- ((string-equal "!side" itm :end2 (min (length itm) 5))
- (setf state :in-side)
- t)
- ((equal "" itm)
- t)) ; Skip blank lines!
- ;; Otherwise, we assume it's a valid PASSCODE.
- (ccase state
- (:in-created-by (setf created-by itm))
- (:in-main (push (parse-integer itm) main-deck))
- (:in-side (push (parse-integer itm) side-deck))
- (:in-extra (push (parse-integer itm) extra-deck)))))
-
- (unless (and (slot-boundp ydk 'created-by)
- (slot-value ydk 'created-by))
- (setf (ydk-created-by ydk) created-by))
- ;; Currently we don't read the NAME of the YDK from anywhere
- ;; *inside* the file contents, it is provided externally,
- ;; e.g. file name.
- ;;
- ;; (unless (and (slot-boundp ydk 'name)
- ;; (slot-value ydk 'name))
- ;; (setf (ydk-name-of ydk) name))
- (unless (and (slot-boundp ydk 'main-deck)
- (slot-value ydk 'main-deck))
- (setf (ydk-main-deck-of ydk)
- (reverse main-deck)))
- (unless (and (slot-boundp ydk 'extra-deck)
- (slot-value ydk 'extra-deck))
- (setf (ydk-extra-deck-of ydk)
- (reverse extra-deck)))
- (unless (and (slot-boundp ydk 'side-deck)
- (slot-value ydk 'side-deck))
- (setf (ydk-side-deck-of ydk)
- (reverse side-deck)))))
-
- (defmethod initialize-instance :after ((ydk ydk) &rest initargs
- &key content &allow-other-keys)
- (declare (ignore initargs))
- (when content
- (initialize-with-content ydk content)))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
- (defmethod ydk-add ((ydk ydk) target-deck passcode)
- (let ((deck
- (ecase target-deck
- (:main (ydk-main-deck-of ydk))
- (:extra (ydk-extra-deck-of ydk))
- (:side (ydk-side-deck-of ydk)))))
- (ccase target-deck
- (:main
- (setf (ydk-main-deck-of ydk) (append deck (list passcode))))
- (:extra
- (setf (ydk-extra-deck-of ydk) (append deck (list passcode))))
- (:side
- (setf (ydk-side-deck-of ydk) (append deck (list passcode)))))))
-
- ;; TODO Deprecated. Remove this code. YDK-DELETE-INDEX is
- ;; superior. How are we going to tackle moving cards?
- (defmethod ydk-delete ((ydk ydk) kind passcode &optional (count 1))
- "Sloppily remove PASSCODE from YDK KIND deck. KIND is one of :MAIN
- :EXTRA or :SIDE. Optionally specify how many to remove with COUNT,
- default of 1."
- (labels ((remove-fn (array)
- (remove-if (lambda (lst) (eq lst passcode)) array :count count)))
- (with-slots (main-deck extra-deck side-deck) ydk
- (ccase kind
- (:main (setf main-deck (remove-fn main-deck)))
- (:side (setf side-deck (remove-fn side-deck)))
- (:extra (setf extra-deck (remove-fn extra-deck)))))))
-
- (defmethod ydk-delete-index ((ydk ydk) kind index &optional (count 1))
- "Delete COUNT sequential cards at INDEX from the KIND of deck. KIND
- is one of :MAIN :EXTRA or :SIDE."
- (with-slots (main-deck extra-deck side-deck) ydk
- (ccase kind
- (:main (setf main-deck
- (append
- (subseq main-deck 0 index)
- (subseq main-deck (+ count index)))))
- (:extra (setf extra-deck
- (append
- (subseq extra-deck 0 index)
- (subseq extra-deck (+ count index)))))
- (:side (setf side-deck
- (append
- (subseq side-deck 0 index)
- (subseq side-deck (+ count index))))))))
-
- (defmethod ydk-clear ((ydk ydk) &optional target-deck)
- "Clear out the YDK."
- (case target-deck
- (:main (setf (ydk-main-deck-of ydk) nil))
- (:side (setf (ydk-side-deck-of ydk) nil))
- (:extra (setf (ydk-extra-deck-of ydk) nil))
- (t (progn
- (ydk-clear ydk :main)
- (ydk-clear ydk :extra)
- (ydk-clear ydk :side)))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defmethod ydk-sync ((ydk ydk))
- "Synchronize this YDK intermediate deck to the database. If there's
- already a deck by this name, we \"update\" it by erasing all the
- entries matching that DECK ID using YDK-DECK-ITEM-DELETE-FROM. That is, YDK => SQL."
- (let ((deck-list '())
- (deck (ydk-deck-by-name (ydk-name-of ydk))))
-
- ;; Create the new deck if it does not exist.
- (unless deck
- (setf deck
- (create-dao 'ydk-deck
- :name (ydk-name-of ydk)
- :created-by (ydk-created-by ydk))))
-
- ;; If A deck with this name already exists: clear out the old
- ;; list. This no longer erases the YDK-DECK entry, so DECK-ID
- ;; should stay consistent now.
- (ydk-deck-item-delete-from
- (sxql:where
- (:= :deck_item.deck_id (mito:object-id deck))))
-
- ;; Insert new deck_items into the database. How do we do
- ;; that? We create a bunch of objects then MITO:INSERT-DAO them.
- (loop for (kind lst) on (ydk-all ydk) by #'cddr do
- (dolist (passcode lst)
- (push (make-instance 'deck-item
- :deck-id (mito:object-id deck)
- :kind (%keyword-to-sql kind)
- :passcode passcode)
- deck-list)))
-
- (if (do-grouped-insert deck-list)
- deck)))
-
- (defmethod ydk-sync ((ydk-deck ydk-deck))
- "Query the database deck with this YDK-DECK. That is, SQL => YDK.
-
- TODO Why not WITH-SLOTS?"
- (with-connection (db)
- (let* ((id (mito:object-id ydk-deck))
- (created-by (ydk-created-by ydk-deck))
- (name (ydk-name-of ydk-deck))
- (deck-list (mito:retrieve-dao 'deck-item :deck-id id))
- (main-deck '())
- (extra-deck '())
- (side-deck '()))
-
- (dolist (deck-item deck-list)
- (let ((passcode (deck-passcode-of deck-item)))
- ;; TODO There could be a macro (with-main-side-extra-decks)
- ;; or something to suplliment %keyword-to-sql and
- ;; %sql-to-keyword.
- (ccase (deck-kind-of deck-item)
- (0 (push passcode main-deck))
- (1 (push passcode extra-deck))
- (2 (push passcode side-deck)))))
-
- (make-instance 'ydk
- :deck-id id
- :name name
- :created-by created-by
- :main-deck main-deck
- :extra-deck extra-deck
- :side-deck side-deck))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defmethod ydk-all ((ydk ydk))
- "Get the list of cards from a deck, duplicates included. Generally this order is retained from e.g. file upload or deck creation.
-
- SEE YDK-SORTED."
- (with-slots (main-deck extra-deck side-deck) ydk
- (list :main-deck main-deck
- :side-deck side-deck
- :extra-deck extra-deck)))
-
- (defmethod ydk-concatenate ((ydk ydk))
- "Get the list of cards from a deck, duplicates included. Generally this order is retained from e.g. file upload or deck creation.
-
- SEE YDK-SORTED."
- (with-slots (main-deck extra-deck side-deck) ydk
- (concatenate 'list main-deck extra-deck side-deck)))
-
- (defmethod ydk-unique ((ydk ydk))
- "Get the unique list of cards from a deck."
- (remove-duplicates (ydk-concatenate ydk)))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; (with-datafly-connection (db)
- ;; (with-datafly-transaction
- ;; (datafly:retrieve-all
- ;; (select (:frame_type) (from :ygo_info) (group-by :frame_type)))))
- ;; ((:FRAME-TYPE "effect") (:FRAME-TYPE "effect_pendulum") (:FRAME-TYPE "fusion")
- ;; (:FRAME-TYPE "fusion_pendulum") (:FRAME-TYPE "link") (:FRAME-TYPE "normal")
- ;; (:FRAME-TYPE "normal_pendulum") (:FRAME-TYPE "ritual")
- ;; (:FRAME-TYPE "ritual_pendulum") (:FRAME-TYPE "skill") (:FRAME-TYPE "spell")
- ;; (:FRAME-TYPE "synchro") (:FRAME-TYPE "synchro_pendulum") (:FRAME-TYPE "token")
- ;; (:FRAME-TYPE "trap") (:FRAME-TYPE "xyz") (:FRAME-TYPE "xyz_pendulum"))
- (defmethod ydk-sorted ((ydk ydk))
- "Sort the YDK according to FRAME-TYPE-PRIO."
- (let ((deck-info (copy-list (ydk-query ydk))))
- (labels ((frame-type-prio (plist)
- (let ((kind (getf plist :frame-type)))
- (cond ((string= kind "normal") 0)
- ((string= kind "effect") 1)
- ((string= kind "ritual") 2)
- ((string= kind "fusion") 3)
- ((string= kind "link") 4)
- ((string= kind "skill") 5)
- ((string= kind "synchro") 6)
- ((string= kind "token") 7)
- ((string= kind "xyz") 8)
- ((string= kind "spell") 9)
- ((string= kind "trap") 10)
- ((string= kind "effect_pendulum") 11)
- ((string= kind "fusion_pendulum") 12)
- ((string= kind "normal_pendulum") 13)
- ((string= kind "ritual_pendulum") 14)
- ((string= kind "synchro_pendulum") 15)
- ((string= kind "xyz_pendulum") 16)
- (t 17))))
- (sort-and-extract (kind)
- (mapcar (lambda (plist) (getf plist :passcode))
- (sort
- (sort (copy-list (getf deck-info kind))
- #'string< :key (lambda (plist) (princ-to-string
- (getf plist :name))))
- #'< :key #'frame-type-prio))))
- (make-instance 'ydk
- :created-by (ydk-created-by ydk)
- ;; Sometimes unbound - on unsaved decks.
- :deck-id (ignore-errors (ydk-id-of ydk))
- :name (ydk-name-of ydk)
- :main-deck (sort-and-extract :main-deck)
- :extra-deck (sort-and-extract :extra-deck)
- :side-deck (sort-and-extract :side-deck)))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Now where on earth does this belong? Probably with the YDK stuff maybe?
- ;;
- ;; Maybe this will go back to the toolkit This code might be useful for parsing CSVs or similar.
- ;;
- #+nil
- (defun parse-decklist (string)
- (let ((split-query
- (mapcar #'(lambda (s)
- (string-trim '(#\Newline #\Return #\Tab #\Space) s))
- (remove ""
- (split-sequence:split-sequence
- #\Newline
- (normalize-newlines string))
- :test #'equal)))
- (new-list '()))
- (dolist (line split-query)
- (multiple-value-bind (string substrings)
- (cl-ppcre:scan-to-strings "^(\\d+)x (.*)" line)
- (declare (ignore string))
- (cond (substrings
- (let ((card-name (svref substrings 1))
- (as-number (read-from-string (svref substrings 0))))
- ;; 10x => dotimes 10
- (dotimes (_ as-number)
- (push card-name new-list))))
- (t (push line new-list)))))
- (reverse new-list)))
-
- (defmethod ydk-filter-frame-type ((ydk ydk) kind)
- (let ((monster '("normal" "effect" "ritual" "fusion" "link" "synchro"
- "xyz" "effect_pendulum" "fusion_pendulum" "normal_pendulum"
- "ritual_pendulum" "synchro_pendulum" "xyz_pendulum"))
- (spell '("spell"))
- (trap '("trap"))
- (deck-info (ydk-query ydk)))
- (labels ((filter (plist)
- (remove-if (lambda (itm)
- (if (member (getf itm :frame-type)
- (case kind
- (:monster monster)
- (:spell spell)
- (:trap trap))
- :test #'equal)
- nil
- t))
- plist)))
- (filter (getf deck-info :main-deck)))))
-
- (defmethod ydk-monster-cards ((ydk ydk))
- (ydk-filter-frame-type ydk :monster))
- (defmethod ydk-spell-cards ((ydk ydk))
- (ydk-filter-frame-type ydk :spell))
- (defmethod ydk-trap-cards ((ydk ydk))
- (ydk-filter-frame-type ydk :trap))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defmethod ydk-length ((ydk ydk))
- (reduce #'+ (list (length (ydk-main-deck-of ydk))
- (length (ydk-extra-deck-of ydk))
- (length (ydk-side-deck-of ydk)))))
-
- (defmethod ydk-to-kde ((ydk ydk))
- "Transform the YDK according to KDE Team List."
- (let ((created-by (ydk-created-by ydk))
- (deck-info (ydk-query ydk))
- (monster-cards (ydk-monster-cards ydk))
- (spell-cards (ydk-spell-cards ydk))
- (trap-cards (ydk-trap-cards ydk)))
- (let ((main-deck (getf deck-info :main-deck))
- (extra-deck (getf deck-info :extra-deck))
- (side-deck (getf deck-info :side-deck)))
- (let ((main-deck-rle (rle-encode-plist main-deck))
- (extra-deck-rle (rle-encode-plist extra-deck))
- (side-deck-rle (rle-encode-plist side-deck))
- (monster-cards-rle (rle-encode-plist monster-cards))
- (spell-cards-rle (rle-encode-plist spell-cards))
- (trap-cards-rle (rle-encode-plist trap-cards)))
- (labels ((pad (lst)
- (let ((max 17))
- (append lst
- (loop for i from (length lst) upto max collect
- '("" :name ""))))))
- (list
- :name (ydk-name-of ydk)
- :set nil
- :length (ydk-length ydk)
- :created-by created-by
- :first-date nil
- :final-date nil
- :monster-cards monster-cards
- :spell-cards spell-cards
- :trap-cards trap-cards
- :main-deck main-deck
- :side-deck side-deck
- :extra-deck extra-deck
- :monster-cards-rle (pad monster-cards-rle)
- :spell-cards-rle (pad spell-cards-rle)
- :trap-cards-rle (pad trap-cards-rle)
- :main-deck-rle (pad main-deck-rle)
- :side-deck-rle (pad side-deck-rle)
- :extra-deck-rle (pad extra-deck-rle)))))))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (defmethod %to-string ((ydk ydk))
- (with-slots (created-by main-deck extra-deck side-deck) ydk
- (with-output-to-string (s)
- (format s "~A~%"
- (if created-by
- created-by
- "created by..."))
- (format s "#main~%")
- (dolist (card-name (coerce main-deck 'list))
- (format s "~A~%" card-name))
- (format s "#extra~%")
- (dolist (card-name (coerce extra-deck 'list))
- (format s "~A~%" card-name))
- (format s "!side~%")
- (dolist (card-name (coerce side-deck 'list))
- (format s "~A~%" card-name))
- s)))
|