Initial commit

This commit is contained in:
Correl Roush 2021-06-24 10:10:17 -04:00
commit fc4a6da090

273
mtg.el Normal file
View 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: Symbols 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