274 lines
9.0 KiB
EmacsLisp
274 lines
9.0 KiB
EmacsLisp
;;; mtg.el --- Description -*- lexical-binding: t; -*-
|
||
;;
|
||
;; Copyright (C) 2021 Correl Roush
|
||
;;
|
||
;; Author: Correl Roush <https://github.com/correlr>
|
||
;; Maintainer: Correl Roush <correlr@s1326.ofc.lair>
|
||
;; Created: April 21, 2021
|
||
;; Modified: April 21, 2021
|
||
;; Version: 0.0.1
|
||
;; Keywords: Symbol’s value as variable is void: finder-known-keywords
|
||
;; Homepage: https://github.com/correlr/mtg
|
||
;; Package-Requires: ((emacs "24.3") company esqlite)
|
||
;;
|
||
;; This file is not part of GNU Emacs.
|
||
;;
|
||
;;; Commentary:
|
||
;;
|
||
;; Description
|
||
;;
|
||
;;; Code:
|
||
|
||
(require 'company)
|
||
(require 'esqlite)
|
||
|
||
(defvar mtg-database-source-url "https://mtgjson.com/api/v5/AllPrintings.sqlite")
|
||
(defvar mtg-database-local-path "~/Downloads/mtg.sqlite")
|
||
|
||
(setq mtg-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map (kbd "C-c C-a") #'mtg-insert-card)
|
||
(define-key map (kbd "C-c C-n") #'mtg-insert-card-by-number)
|
||
map))
|
||
|
||
(defconst mtg-card-regex
|
||
(rx line-start
|
||
(* blank)
|
||
;; Quantity
|
||
(group (+ digit))
|
||
(+ blank)
|
||
;; Name
|
||
(group (* not-newline))
|
||
;; Set
|
||
(group "(" (group (>= 3 (any alphanumeric))) ")")
|
||
(+ blank)
|
||
;; Number
|
||
(group "#" (group (+ (not blank))))
|
||
(* blank)
|
||
;; Language
|
||
(group (? "[" (group (+ alpha)) "]"))
|
||
(* blank)
|
||
;; Foil
|
||
(group (? "(foil)"))
|
||
(* blank)
|
||
line-end
|
||
))
|
||
|
||
(defconst mtg-font-lock-defaults
|
||
`(("^[[:blank:]]*0[[:blank:]]+.*$" (0 font-lock-warning-face))
|
||
(,mtg-card-regex
|
||
(1 font-lock-constant-face)
|
||
(2 font-lock-string-face)
|
||
(3 font-lock-builtin-face)
|
||
(5 font-lock-type-face)
|
||
(7 font-lock-variable-name-face)
|
||
(9 font-lock-keyword-face)
|
||
)
|
||
("^[[:blank:]]*#.*$"
|
||
(0 font-lock-comment-face)))
|
||
"Keyword highlighting specification for `mtg-mode'.")
|
||
|
||
(defun mtg-insert-card (quantity)
|
||
"Insert a card into the buffer with QUANTITY."
|
||
(interactive "p")
|
||
(end-of-line)
|
||
(insert
|
||
(format "\n%d %s"
|
||
quantity
|
||
(completing-read
|
||
"Card: "
|
||
(lambda (arg predicate flag)
|
||
(when (>= (length arg) 3)
|
||
(mapcar #'mtg--format-card (mtg--cards arg 50))))))))
|
||
|
||
(defun mtg-insert-card-by-number (quantity)
|
||
"Insert a card into the buffer with QUANTITY."
|
||
(interactive "p")
|
||
(end-of-line)
|
||
(insert
|
||
(format "\n%d %s"
|
||
quantity
|
||
(completing-read
|
||
"Set and number: "
|
||
(lambda (arg predicate flag)
|
||
(let* ((args (s-split-up-to " " arg 1))
|
||
(number (nth 0 args))
|
||
(set-code (nth 1 args)))
|
||
(mapcar #'mtg--format-card (mtg--cards-by-number number set-code nil 5))))))))
|
||
|
||
(defun mtg--format-card (card)
|
||
"Format CARD data as a string."
|
||
(let ((name (nth 0 card))
|
||
(set-code (nth 1 card))
|
||
(number (nth 2 card)))
|
||
(format "%s (%s) #%s" name set-code number)))
|
||
|
||
(defun mtg--cards (substring &optional limit)
|
||
"Fetch cards matching SUBSTRING.
|
||
|
||
If LIMIT is not nil, no more than LIMIT cards will be returned."
|
||
(esqlite-read
|
||
mtg-database-local-path
|
||
(s-concat
|
||
"SELECT DISTINCT name, setCode, number FROM cards"
|
||
(format " WHERE name LIKE '%%%s%%'"
|
||
(esqlite-escape-like (esqlite-escape-string substring)))
|
||
(when limit
|
||
(format " LIMIT %d" limit)))))
|
||
|
||
(defun mtg--cards-by-number (number &optional set-code total limit)
|
||
"Fetch cards matching SET-CODE and NUMBER.
|
||
|
||
If LIMIT is not nil, no more than LIMIT cards will be returned."
|
||
(let* ((constraints (s-join " AND "
|
||
(seq-filter #'identity
|
||
(list (format "number LIKE '%s'" number)
|
||
(when set-code (format "setCode LIKE '%s'" (s-upcase set-code)))))))
|
||
(sql (s-concat
|
||
"SELECT DISTINCT name, setCode, number FROM cards"
|
||
(format " WHERE %s" constraints)
|
||
(when limit
|
||
(format " LIMIT %d" limit)))))
|
||
(esqlite-read
|
||
mtg-database-local-path
|
||
sql)))
|
||
|
||
(defun mtg-card-from-string (card-string)
|
||
(when-let ((groups (s-match
|
||
mtg-card-regex
|
||
card-string)))
|
||
(list 'name (s-trim (nth 2 groups))
|
||
'set-code (nth 4 groups)
|
||
'number (nth 6 groups)
|
||
'language (or (nth 8 groups) "English")
|
||
'foil (not (s-blank? (nth 9 groups))))))
|
||
|
||
(defun mtg-export--magic-manager ()
|
||
(let ((entries (mtg-buffer-cards))
|
||
(export-buffer (generate-new-buffer "*MagicManger export*")))
|
||
(with-current-buffer export-buffer
|
||
(insert (s-join "," '("Card Name"
|
||
"Set Code"
|
||
"Collector Number"
|
||
"Language"
|
||
"Foil"
|
||
"Count"))
|
||
?\n)
|
||
(mapcar (lambda (entry)
|
||
(let ((card (plist-get entry 'card)))
|
||
(insert (s-join "," (list (s-concat "\"" (plist-get card 'name) "\"")
|
||
(s-downcase (plist-get card 'set-code))
|
||
(plist-get card 'number)
|
||
(let ((lang (plist-get card 'language)))
|
||
(cond ((s-equals? lang "Japanese") "ja")
|
||
(t "en")))
|
||
(if (plist-get card 'foil) "True" "False")
|
||
(format "%s" (plist-get entry 'quantity))))
|
||
?\n)))
|
||
entries)
|
||
(goto-char (point-min))
|
||
(csv-mode))
|
||
(display-buffer export-buffer)))
|
||
|
||
(defun mtg-card-quantity-from-string (card-string)
|
||
(let ((groups (s-match
|
||
mtg-card-regex
|
||
card-string)))
|
||
(if groups (string-to-number (nth 1 groups))
|
||
0)))
|
||
|
||
(defun mtg-card-at-point ()
|
||
(mtg-card-from-string
|
||
(buffer-substring-no-properties
|
||
(line-beginning-position)
|
||
(line-end-position))))
|
||
|
||
(defun mtg-card-quantity-at-point ()
|
||
(mtg-card-quantity-from-string
|
||
(buffer-substring-no-properties
|
||
(line-beginning-position)
|
||
(line-end-position))))
|
||
|
||
(defun mtg--lookup-uuid (card)
|
||
(caar
|
||
(esqlite-read
|
||
mtg-database-local-path
|
||
(s-concat
|
||
"SELECT uuid FROM cards WHERE"
|
||
(format " name LIKE '%s'" (esqlite-escape-like (esqlite-escape-string (plist-get card 'name))))
|
||
(format " AND setCode LIKE '%s'" (esqlite-escape-like (esqlite-escape-string (plist-get card 'set-code))))
|
||
(format " AND number LIKE '%s'" (esqlite-escape-like (esqlite-escape-string (plist-get card 'number))))
|
||
" LIMIT 1"))))
|
||
|
||
(defun mtg--lookup-value (card)
|
||
(when-let ((card-uuid (mtg--lookup-uuid card)))
|
||
(seq-map
|
||
(lambda (value)
|
||
(if (stringp value) (string-to-number value)
|
||
0.0))
|
||
(car
|
||
(esqlite-read
|
||
mtg-database-local-path
|
||
(s-concat
|
||
"SELECT min(price), max(price), avg(price)"
|
||
" FROM prices"
|
||
(format " WHERE uuid = '%s'" (esqlite-escape-string card-uuid))
|
||
(format " AND type = '%s'"
|
||
(if (plist-get card 'foil) "foil"
|
||
"normal"))
|
||
" AND game_format = 'paper'"
|
||
" AND currency = 'USD'"))))))
|
||
|
||
(defun mtg-card-uuid-at-point ()
|
||
(when-let ((card (mtg-card-at-point)))
|
||
(mtg--lookup-uuid card)))
|
||
|
||
(defun mtg-card-value-at-point ()
|
||
(when-let ((card (mtg-card-at-point)))
|
||
(mtg--lookup-value card)))
|
||
|
||
(defun mtg-buffer-cards ()
|
||
(seq-filter
|
||
(lambda (entry) (< 0 (plist-get entry 'quantity)))
|
||
(mapcar
|
||
(lambda (s) (list 'quantity (mtg-card-quantity-from-string s)
|
||
'card (mtg-card-from-string s)))
|
||
(s-lines (buffer-substring-no-properties (point-min) (point-max))))))
|
||
|
||
(defun mtg-buffer-value ()
|
||
(seq-reduce
|
||
(lambda (value entry)
|
||
(let* ((quantity (plist-get entry 'quantity))
|
||
(card (plist-get entry 'card))
|
||
(newvalue (mtg--lookup-value card)))
|
||
(list
|
||
(+ (nth 0 value) (* quantity (nth 0 newvalue)))
|
||
(+ (nth 1 value) (* quantity (nth 1 newvalue)))
|
||
(+ (nth 2 value) (* quantity (nth 2 newvalue))))))
|
||
(mtg-buffer-cards)
|
||
'(0.0 0.0 0.0)))
|
||
|
||
(define-derived-mode mtg-mode fundamental-mode "Magic: The Gathering"
|
||
"Major mode for describing Magic: The Gathering cards."
|
||
(setq font-lock-defaults '(mtg-font-lock-defaults))
|
||
(setq-local completion-ignore-case t))
|
||
|
||
(defun company-mtg-backend (command &optional arg &rest ignored)
|
||
(interactive (list 'interactive))
|
||
(case command
|
||
(interactive (company-begin-backend 'company-mtg-backend))
|
||
(prefix (and (eq major-mode 'mtg-mode)
|
||
(company-grab-line (rx line-start
|
||
(* blank)
|
||
(group (+ digit))
|
||
(+ blank)
|
||
(group (* not-newline)))
|
||
2)))
|
||
(candidates
|
||
(mapcar #'mtg--format-card (mtg--cards arg)))))
|
||
|
||
(add-to-list 'company-backends 'company-mtg-backend)
|
||
|
||
(provide 'mtg)
|
||
;;; mtg.el ends here
|