Initial commit
This commit is contained in:
commit
fc4a6da090
1 changed files with 273 additions and 0 deletions
273
mtg.el
Normal file
273
mtg.el
Normal file
|
@ -0,0 +1,273 @@
|
|||
;;; 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
|
Loading…
Reference in a new issue