cl-deck-builder2/src/draw.lisp

#|

draw.lisp

The main drawing stuff from ImageMagick is handled here. We use
UIOP:RUN-PROGRAM. It's pretty clumsy, but it works for the types
of files we're working with.

It could probably use some polishing up. Particularly the command
processing. Using INFERIOR-SHELL just calls UIOP:RUN-PROGRAM under the
hood anyway. Is it worth it for the extra param processing? It might
be slightly safer, certainly LISP-ier...

|#
(in-package :cl-user)

(defpackage #:cl-deck-builder2.draw
  (:use #:cl)
  (:local-nicknames (#:v #:org.shirakumo.verbose))
  (:import-from #:cl-deck-builder2.toolkit
                #:make-static-filename-kind
                #:relative-file-list
                #:ygo-probe-file-list
                #:static-probe-file-list)
  (:import-from #:cl-deck-builder2.models
                #:ydk-main-deck-of
                #:ydk-extra-deck-of
                #:ydk-side-deck-of)
  (:export :draw-deck-image)
  (:documentation "The Drawing package.

We currently wrap ImageMagick on the command line using UIOP:RUN-PROGRAM.

Cairo2 does not support JPEG. We generate a command pipeline with ~montage~ and ~convert~ binaries."))

(in-package #:cl-deck-builder2.draw)

;; Rough class abstraction:
(defclass draw-pipeline ()
  ())

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter *command* nil
  "The current command line used in the drawing process. Useful for inspection/debug purposes.")

(defparameter +convert-binary+ "convert"
  "The path to ImageMagick ~convert~ binary.")

(defparameter +montage-binary+ "montage"
  "The path to ImageMagick ~montage~ binary.")

;; This is for full deck list. I can have a few params for different
;; decks e.g. main, side, extra.
;;
;; TODO Having all these params is ugly. Maybe a hash table?
(defparameter +command-line-params-main-deck+
  ;;"-resize '421x614>' -geometry +5+5 -tile 10x")
  ; "-geometry +5+5 -tile 10x -texture '/home/user/public/noise.png'" ;;'#ff8b53'"
  "-geometry +5+5 -tile 10x -background '#FF8B53'"
  "Parameters for making the MAIN deck. It's 10x cards wide, There's 5 px between cards. The color is from <https://yugioh.fandom.com/wiki/Card_colors>.

This is for full main deck list. I can have a few params for different decks e.g. main, side, extra. This one is for the main deck. Parameters for making the MAIN deck: It's 10x cards wide,There's 5 px between cards.")

(defparameter +command-line-params-extra-deck+
  ;; "-resize '421x614>' -geometry +5+5 -tile 15x")
  "-geometry +5+5 -tile 15x -background '#BC5A84'"
  "Parameters for making the EXTRA deck. It's 15x cards wide,There's 5 px between cards.")

(defparameter +command-line-params-side-deck+
  ;; "-resize '421x614>' -geometry +5+5 -tile 15x")
  "-geometry +5+5 -tile 15x -background '#1D9E74'"
  "Parameters for making the SIDE deck. It's 15x cards wide,There's 5 px between cards.")

(defparameter +command-line-params-main-deck-output+
  ;; "-resize '421x614>' -geometry +5+5 -tile 15x")
  ;; "-geometry '4310x2496>'"
  ;; "-geometry '2560x>' -background '#FF8B53' -gravity South -splice 0x10"
  "-background '#FF8B53' -gravity South -splice 0x10"
  "Parameters for final output of the MAIN deck. It's the width of the MAIN deck output, which will be set to 2560.

TODO: Use identify to query this information.")

(defparameter +command-line-params-extra-deck-output+
  ;; "-resize '421x614>' -geometry +5+5 -tile 15x")
  ;; "-geometry '4310x2496>'"
  "-geometry '4310>'"
  "Parameters for final output of the EXTRA and SIDE decks. It's exactly the width of the MAIN deck output, which happens to be 4310x2496.

TODO: Use identify to query this information.

Parameters for final output of the EXTRA and SIDE decks. It's exactly the width of the MAIN deck output, which happens to be 4310x2496. Card images are almost always 421x614 px in size, and we add 5 px of padding around all sides. So that's where this number comes from (((421+10)*10) = 4310).")

(defparameter +command-line-params-final-output+
  ;; "-resize '421x614>' -geometry +0+0 -tile 1x")
  "-geometry +0+0 -tile 1x -background none"
  "The options passed to convert for the final image result. Smoosh everything together into one 1x wide image!")

(defparameter +command-line-params-watermark-lower-right+
  "-gravity southeast -geometry +10+10 -draw \"image Over 32,32 256,256 'runew.png'\""
  "Draw a watermark in the bottom right with this command.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun command-setup (file-list pathname &key (deck-type :main) (dry-run nil))
  "Set up the *COMMAND* parameter for use in COMMAND-EXEC.

You can kind of see the structure of the command:

         ~A ~A ~{\"~A\" ~} miff:- | ~A miff:- ~A \"~A\"

That's \"montage [input-options] [list-of-input-filenames] miff:- | convert miff:- [output-options] [output-filename]\".

We use the MIFF format to speed up the whole montage process.

ARGUMENTS:

FILE-LIST   The list of files to be used in the generation of the deck image. The files must exist.
PATHNAME    The pathname of the output file.
DECK-TYPE   The kind of deck we'll be generating. Allowed values are :MAIN :SIDE :EXTRA and :FINAL. The default is :MAIN.
DRY-RUN     If DRY-RUN is T, instead of filling in a whole file list, which can be clunky to view, we replace the list of files with ~'(FILE LIST)~. Very kludgy.

SEE *COMMAND*
SEE COMMAND-EXEC"
  (let* ((extra-params (case deck-type
                         (:main +command-line-params-main-deck+)
                         (:extra +command-line-params-extra-deck+)
                         (:side +command-line-params-side-deck+)
                         (:final +command-line-params-final-output+)
                         (otherwise "")))
         (output-params (case deck-type
                          (:main +command-line-params-main-deck-output+)
                          ((:side :extra) +command-line-params-extra-deck-output+)
                          (otherwise "")))
         (command (format nil "~A ~A ~{\"~A\" ~} miff:- | ~A miff:- ~A \"~A\""
                          +montage-binary+
                          extra-params
                          (if dry-run
                              '(file list)
                              file-list)
                          +convert-binary+
                          output-params
                          pathname)))
    (setf *command* command)))

(defun command-exec (&key (command *command*) (dry-run nil))
  "Execute the command with UIOP:RUN-PROGRAM, or do a dry run.

ARGUMENTS:
COMMAND  The command line to execute. It doesn't have to be anything to do with ImageMagick. This is a generic wrapper around UIOP:RUN-PROGRAM. The default command line to pass is *COMMAND*.
DRY-RUN  If DRY-RUN is T, use FORMAT to output a string instead."
  (if dry-run
      (v:info :draw "~a" command)
      (uiop:run-program command
                        :output t
                        :error-output t)))


(defun identify-image (pathname &optional (dry-run nil))
  "Wrapper around ImageMagick IDENTIFY.

PATHNAME The path to the file to identify.
DRY-RUN  Inform COMMAND-EXEC that this is a DRY-RUN. "
  (command-exec :command (format nil "identify \"~A\"" pathname)
                :dry-run dry-run))

;; TODO The way we pass args around like this is ugly af. Maybe a STRUCT?
;;
;; This absolutely needs a rewrite. I should be using classes for this.
(defun make-passcode-files-list (types pathname-name ydk)
  "Build TYPES -> MERGE-PATHNAMES ASSOCIATION-LIST. TYPES gets filled in
with PATHNAME-NAME and PASSCODE info:

    (:MAIN OG_bechi_21-Chaos Turbo-main.jpg ( main deck ... ))
    (:SIDE OG_bechi_21-Chaos Turbo-side.jpg ( side deck ... ))
    (:EXTRA OG_bechi_21-Chaos Turbo-extra.jpg ( extra deck ... ))

Then the :FINAL image instead of a list of passcodes, is a list of
files passed to STATIC-RELATIVE-FILE-LIST:

    (:FINAL OG_bechi_21-Chaos Turbo-final.jpg (OG_bechi_21-Chaos Turbo-main.jpg
                                               OG_bechi_21-Chaos Turbo-extra.jpg
                                               OG_bechi_21-Chaos Turbo-side.jpg))

ARGUMENTS:
types            A LIST of the types of images we want to generate. May be one of :MAIN, :SIDE, :EXTRA, or :FINAL.
pathname-name    The PATHNAME-NAME of the file you want to create. E.g. if you had a YDK file named \"Chaos Turbo 2023.ydk\" you should pass the output of (PATHNAME-NAME #P\"Chaos Turbo 2023.ydk\"
ydk              The YDK information we're generating the deck for."
  (loop for type in types
        collect
        (list type
              (make-static-filename-kind pathname-name type)
              (case type
                (:main (ydk-main-deck-of ydk))
                (:extra (ydk-extra-deck-of ydk))
                (:side (ydk-side-deck-of ydk))))))

(defun draw-deck-image (ydk pathname &key (dry-run nil))
  "Parse a YDK, setup a bunch of command lines, and generate a deck image. Very clunky and clumsy, most likely candidate for a rewrite right here.

ARGUMENTS
DATA     Raw YDK data. May be anything that INITIALIZE-WITH-CONTENT can process.
PATHNAME The path to where the output images will be stored. The PATHNAME-NAME will be munged to have ~-main~,~-side~,~-extra-~, or ~-final~ appended to it.
DRY-RUN  Do a dry run.

SEE INITIALIZE-WITH-CONTENT"

  (v:info :draw "DRAW-DECK-IMAGE: ~a" pathname)

  (let* ((pathname-name (typecase pathname
                          (pathname (pathname-name pathname))
                          (string pathname)
                          (integer (princ-to-string pathname))))
         (datum (make-passcode-files-list '(:main :extra :side)
                                          pathname-name ydk)))

    ;; Build the three images
    (loop for data in datum do
      (destructuring-bind (kind path lst)
          data
        (if (not lst)
            (progn
              ;; Whatever item this is, there are no cards in
              ;; it. Remove it from the query.
              ;; (format t "~A~%" datum)
              (setf datum (delete kind datum :key #'car)))
            (progn
              ;; There are cards in it.
              (v:info :draw "Generating ~A deck: ~A (~A cards)" kind path (length lst))
              (if (probe-file path)
                  (v:info :draw "File exists: ~A" path)
                  (progn
                    (command-setup (ygo-probe-file-list lst) path :deck-type kind :dry-run dry-run)
                    (command-exec :dry-run dry-run)))))))

    (let* (;; KEY-PAIRS is :MAIN + (:MAIN :EXTRA:) + (:MAIN :SIDE) if they exist.
           ;; If we filtered out something above, it won't show up in this list...
           (key-pairs (alexandria:map-product 'list
                                              '(:main)
                                              (remove :main (mapcar #'first datum))))
           ;; COMBINATIONS-LIST is every file name combined,
           ;; e.g. Deck-Name-MAIN, Deck-Name-MAIN-EXTRA,
           ;; Deck-Name-FINAL; the ones from KEY-PAIRS noted above
           ;; combined with PATHNAME-NAME. It's in a similar format as
           ;; the output from MAKE-PASSCODE-FILES-LIST.
           (combinations-list
             (loop for key-pair in key-pairs
                   collect
                   (list 
                    ;; double loop ... ? Who cares, it works...
                    (loop for key-pair in key-pair
                          collect (make-static-filename-kind pathname-name key-pair))
                         (make-static-filename-kind pathname-name key-pair))))
           (final-filenames
             (append
              (mapcar #'second datum)
              (mapcar #'second combinations-list)
              (list (make-static-filename-kind pathname-name :final)))))

      (merge-images (car (last final-filenames)) (mapcar #'second datum))
      (loop for combination in combinations-list do
        (merge-images (second combination) (first combination) dry-run))

      (relative-file-list final-filenames))))

(defun merge-images (final-filename image-lst &optional dry-run)
  "Merge images in IMAGE-LST into FINAL-FILENAME.

IMAGE-LST      The list of images to be merged. Will be merged in order specified.
FINAL-FILENAME The output filename.
DRY-RUN  Do a dry run."
  (v:info :draw "Generating final image: ~A ~a" final-filename image-lst)
  ;; MAPCAR #'SECOND??? Oh Well, it works.
  (if (probe-file final-filename)
      (v:info :draw "File exists: ~A" final-filename)
      (progn
        (command-setup (static-probe-file-list image-lst)
                       final-filename :deck-type :final :dry-run dry-run)
        (command-exec :dry-run dry-run))))