commit fc4a6da09085ddff48a154eff9d0bf3451ecf322 Author: Correl Date: Thu Jun 24 10:10:17 2021 -0400 Initial commit diff --git a/mtg.el b/mtg.el new file mode 100644 index 0000000..c89fa00 --- /dev/null +++ b/mtg.el @@ -0,0 +1,273 @@ +;;; mtg.el --- Description -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2021 Correl Roush +;; +;; Author: Correl Roush +;; Maintainer: Correl Roush +;; 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