;;; wca-prep.el --- Practice WCA puzzles (Rubik's Cube) -*- lexical-binding: t; -*-

;; Copyright (C) 2023 Vasilij Schneidermann <mail@vasilij.de>
;; SPDX-License-Identifier: GPL-3.0-or-later

;; Author: Vasilij Schneidermann <mail@vasilij.de>
;; URL: https://depp.brause.cc/wca-prep
;; Version: 0.0.1
;; Package-Requires: ((emacs "29.1"))
;; Keywords: games

;; This file is NOT part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Set of commands for practicing WCA puzzles (such as Rubik's Cube):
;; - Generate puzzle scramble
;; - Visualization of puzzle scramble
;; - Stopwatch to measure solve time
;; - Statistics visualization of solve data
;;
;; Supported puzzles:
;; - 2x2x2 cube
;; - 3x3x3 cube (Rubik's Cube)

;;; Code:

(require 'cl-lib)
(require 'seq)
(require 'sqlite)
(require 'svg)
(require 'tabulated-list)
(require 'transient)

(defgroup wca-prep nil
  "Practice WCA puzzles"
  :group 'games
  :prefix "wca-prep-")

;;; generate puzzle scramble

(defvar-local wca-prep-current-puzzle nil)

(defvar-local wca-prep-puzzle-faces nil)
(defvar-local wca-prep-puzzle-scramble-faces nil)
(defvar-local wca-prep-puzzle-scramble-rotations nil)

(defvar-local wca-prep-puzzle-scramble-length nil)
(defvar-local wca-prep-puzzle-scramble nil)

(defvar-local wca-prep-puzzle-facelet-count nil)
(defvar-local wca-prep-puzzle-facelets nil)

(cl-defgeneric wca-prep-generate-scramble-turn (_puzzle)
  "Generate a random puzzle turn for PUZZLE."
  (let ((faces wca-prep-puzzle-scramble-faces)
        (rotations wca-prep-puzzle-scramble-rotations))
    (vector (aref faces (random (length faces)))
            (aref rotations (random (length rotations))))))

(defun wca-prep-canonicalize-repeated-turn (turns)
  "Mutate TURNS by collapsing a repeated last turn.
For this, the turn is compared with the preceding one and if they
use the same face, a merge is performed. In other words:

- If no merges apply, TURNS is unmodified.
- Otherwise the new rotation is determined and the current turn
  erased.
- Then, depending on whether they cancel each other out or not,
  either the previous turn is erased or the previous turn is
  adjusted."
  (let ((i (1- (length turns))))
    (while (and (> i 0) (not (aref turns i)))
      (setq i (1- i)))
    (when (not (zerop i)) ; first turn -> nothing to canonicalize
      (let ((cur-turn (aref turns i))
            (prev-turn (aref turns (1- i))))
        (seq-let (cur-face cur-rotation) cur-turn
          (seq-let (prev-face prev-rotation) prev-turn
            (when (eq cur-face prev-face) ; only the same face qualifies
              (let ((new-rotation (% (+ prev-rotation cur-rotation) 4)))
                ;; erase current turn
                (aset turns i nil)
                (if (zerop new-rotation)
                    ;; erase previous turn
                    (aset turns (1- i) nil)
                  ;; adjust previous turn
                  (aset prev-turn 1 new-rotation))))))))))

(cl-defgeneric wca-prep-faces-independent-p (_puzzle face other-face)
  "Test whether rotations of FACE and OTHER-FACE are independent.
Independence means that turning one face does not affect the
other one."
  (cl-ecase face
    (L (eq other-face 'R))
    (R (eq other-face 'L))
    (U (eq other-face 'D))
    (D (eq other-face 'U))
    (F (eq other-face 'B))
    (B (eq other-face 'F))))

(defun wca-prep-canonicalize-independent-turn (puzzle turns)
  "Mutate TURNS by neutralizing independent (as per PUZZLE) ones.
For this, the last three turns x, y and z are looked at. If y and
z denote independently turning faces and x and z use the same
face, then x and z can be combined and z is erased. In other
words:

- If no merges apply, TURNS is unmodified.
- Otherwise the new rotation is determined and turn z is erased.
- Then, depending on whether turn x and z cancel each other out
  or not, either turn x is erased (with turn y taking its place)
  or turn x is adjusted."
  (let ((i (1- (length turns))))
    (while (and (> i 0) (not (aref turns i)))
      (setq i (1- i)))
    (when (>= i 2) ; nothing to canonicalize for less than 3 turns
      (let ((turn-x (aref turns (- i 2)))
            (turn-y (aref turns (1- i)))
            (turn-z (aref turns i)))
        (seq-let (x-face x-rotation) turn-x
          (seq-let (y-face y-rotation) turn-y
            (seq-let (z-face z-rotation) turn-z
              (when (and (wca-prep-faces-independent-p puzzle x-face y-face)
                         (eq x-face z-face))
                (let ((new-rotation (% (+ x-rotation z-rotation) 4)))
                  ;; erase turn-z
                  (aset turns i nil)
                  (if (zerop new-rotation)
                      ;; turn-y goes to where turn-x was
                      (progn
                        (aset turns (1- i) nil)
                        (aset turn-x 0 y-face)
                        (aset turn-x 1 y-rotation))
                    ;; turn-x is adjusted
                    (aset turn-x 1 new-rotation)))))))))))

(defun wca-prep-generate-scramble-turns (puzzle turns)
  "Fill vector TURNS with canonicalized turns"
  (fillarray turns nil)
  (let ((i 0)
        (turn-count (length turns))
        done)
    (while (not done)
      (aset turns i (wca-prep-generate-scramble-turn puzzle))
      (wca-prep-canonicalize-repeated-turn turns)
      (wca-prep-canonicalize-independent-turn puzzle turns)

      ;; find new position of i
      (setq i (1- turn-count))
      (while (and (> i 0) (not (aref turns i)))
        (setq i (1- i)))

      ;; have we progressed?
      (when (aref turns i)
        (setq i (1+ i)))

      ;; are we done?
      (when (= i turn-count)
        (setq done t)))
    turns))

(cl-defgeneric wca-prep-format-turn (_puzzle turn)
  "Format TURN using the WCA notation for PUZZLE"
  (seq-let (face rotation) turn
    (let ((modifier (cl-ecase rotation
                      (1 "")
                      (2 "2")
                      (3 "'"))))
      (format "%s%s" face modifier))))

(cl-defgeneric wca-prep-insert-scramble (puzzle scramble)
  "Insert a representation of SCRAMBLE specific to PUZZLE."
  (dotimes (i (length scramble))
    (when (not (zerop i))
      (insert " "))
    (insert (wca-prep-format-turn puzzle (aref scramble i)))))

(cl-defgeneric wca-prep-lookup-scramble-turn (_puzzle _face)
  "Look up permutation for a PUZZLE applying to symbol FACE"
  (error "Not implemented"))

(cl-defmethod wca-prep-lookup-scramble-turn ((_puzzle (eql '2x2x2)) face)
  (cl-ecase face
    (R [[03 16] [01 18]
        [16 23] [18 21]
        [23 11] [21 09]
        [11 03] [09 01]
        [12 13] [13 15]
        [15 14] [14 12]])
    (U [[17 13] [16 12]
        [13 09] [12 08]
        [09 05] [08 04]
        [05 17] [04 16]
        [00 01] [01 03]
        [03 02] [02 00]])
    (F [[02 12] [03 14]
        [12 21] [14 20]
        [21 07] [20 05]
        [07 02] [05 03]
        [08 09] [09 11]
        [11 10] [10 08]])))

(cl-defmethod wca-prep-lookup-scramble-turn ((_puzzle (eql '3x3x3)) face)
  (cl-ecase face
    (L [[00 18] [03 21] [06 24]
        [18 45] [21 48] [24 51]
        [45 44] [48 41] [51 38]
        [44 00] [41 03] [38 06]
        [09 11] [10 14]
        [11 17] [14 16]
        [17 15] [16 12]
        [15 09] [12 10]])
    (R [[08 36] [05 39] [02 42]
        [36 53] [39 50] [42 47]
        [53 26] [50 23] [47 20]
        [26 08] [23 05] [20 02]
        [27 29] [28 32]
        [29 35] [32 34]
        [35 33] [34 30]
        [33 27] [30 28]])
    (U [[38 29] [37 28] [36 27]
        [29 20] [28 19] [27 18]
        [20 11] [19 10] [18 09]
        [11 38] [10 37] [09 36]
        [00 02] [01 05]
        [02 08] [05 07]
        [08 06] [07 03]
        [06 00] [03 01]])
    (D [[24 33] [25 34] [26 35]
        [33 42] [34 43] [35 44]
        [42 15] [43 16] [44 17]
        [15 24] [16 25] [17 26]
        [45 47] [46 50]
        [47 53] [50 52]
        [53 51] [52 48]
        [51 45] [48 46]])
    (F [[06 27] [07 30] [08 33]
        [27 47] [30 46] [33 45]
        [47 17] [46 14] [45 11]
        [17 06] [14 07] [11 08]
        [18 20] [19 23]
        [20 26] [23 25]
        [26 24] [25 21]
        [24 18] [21 19]])
    (B [[02 09] [01 12] [00 15]
        [09 51] [12 52] [15 53]
        [51 35] [52 32] [53 29]
        [35 02] [32 01] [29 00]
        [36 38] [37 41]
        [38 44] [41 43]
        [44 42] [43 39]
        [42 36] [39 37]])))

(defun wca-prep-apply-scramble (turns facelets)
  (let ((puzzle wca-prep-current-puzzle)
        (scratch (copy-sequence facelets)))
    (seq-doseq (turn turns)
      (seq-let (face rotations) turn
        (let ((permutation (wca-prep-lookup-scramble-turn puzzle face)))
          (dotimes (_ rotations)
            (seq-doseq (turn permutation)
              (seq-let (from to) turn
                (aset facelets to (aref scratch from))))
            (dotimes (i (length facelets))
              (aset scratch i (aref facelets i)))))))))

;;; visualize puzzle scramble

(defconst wca-prep-white-svg-tile ["#ffffff" "#000000"])
(defconst wca-prep-orange-svg-tile ["#ffaf1c" "#x000000"])
(defconst wca-prep-green-svg-tile ["#58d568" "#x000000"])
(defconst wca-prep-red-svg-tile ["#ed3030" "#x000000"])
(defconst wca-prep-blue-svg-tile ["#1c5ffe" "#x000000"])
(defconst wca-prep-yellow-svg-tile ["#f2f215" "#x000000"])

(cl-defgeneric wca-prep-insert-facelets (_puzzle _facelets)
  "Insert graphical representation of FACELETS for PUZZLE")

(cl-defmethod wca-prep-insert-facelets ((_puzzle (eql '2x2x2)) facelets)
  (let* ((unfolded-facelets [[-1 -1 00 01]
                             [-1 -1 02 03]
                             [04 05 08 09 12 13 16 17]
                             [06 07 10 11 14 15 18 19]
                             [-1 -1 20 21]
                             [-1 -1 22 23]])
         (tile-size 24)
         (facelets-per-face 2)
         (horizontal-faces 4)
         (vertical-faces 3)
         (border-width 2)
         (svg-width (* (+ tile-size (* border-width 2))
                       horizontal-faces facelets-per-face))
         (svg-height (* (+ tile-size (* border-width 2))
                        vertical-faces facelets-per-face))
         (drawing-offset 4)
         (svg (svg-create svg-width svg-height)))
    (dotimes (row (length unfolded-facelets))
      (let ((facelet-row (aref unfolded-facelets row)))
        (dotimes (col (length facelet-row))
          (let ((facelet-index (aref facelet-row col)))
            (when (>= facelet-index 0)
              (let* ((facelet (aref facelets facelet-index))
                     (colors (cond
                              ((<= 00 facelet 03) wca-prep-white-svg-tile)
                              ((<= 04 facelet 07) wca-prep-orange-svg-tile)
                              ((<= 08 facelet 11) wca-prep-green-svg-tile)
                              ((<= 12 facelet 15) wca-prep-red-svg-tile)
                              ((<= 16 facelet 19) wca-prep-blue-svg-tile)
                              ((<= 20 facelet 23) wca-prep-yellow-svg-tile)))
                     (fg-color (aref colors 0))
                     (bg-color (aref colors 1))
                     (outline-x (+ (* col (+ tile-size border-width))
                                   drawing-offset))
                     (outline-y (+ (* row (+ tile-size border-width))
                                   drawing-offset))
                     (outline-size (+ tile-size (* border-width 2)))
                     (fill-x (+ outline-x border-width))
                     (fill-y (+ outline-y border-width))
                     (fill-size tile-size))
                (svg-rectangle svg outline-x outline-y
                               outline-size outline-size
                               :fill bg-color)
                (svg-rectangle svg fill-x fill-y
                               fill-size fill-size
                               :fill fg-color)))))))
    (svg-insert-image svg)
    (insert "\n")))

(cl-defmethod wca-prep-insert-facelets ((_puzzle (eql '3x3x3)) facelets)
  (let* ((unfolded-facelets [[-1 -1 -1 00 01 02]
                             [-1 -1 -1 03 04 05]
                             [-1 -1 -1 06 07 08]
                             [09 10 11 18 19 20 27 28 29 36 37 38]
                             [12 13 14 21 22 23 30 31 32 39 40 41]
                             [15 16 17 24 25 26 33 34 35 42 43 44]
                             [-1 -1 -1 45 46 47]
                             [-1 -1 -1 48 49 50]
                             [-1 -1 -1 51 52 53]])
         (tile-size 16)
         (facelets-per-face 3)
         (horizontal-faces 4)
         (vertical-faces 3)
         (border-width 1)
         (svg-width (* (+ tile-size (* border-width 2))
                       horizontal-faces facelets-per-face))
         (svg-height (* (+ tile-size (* border-width 2))
                        vertical-faces facelets-per-face))
         (drawing-offset 4)
         (svg (svg-create svg-width svg-height)))
    (dotimes (row (length unfolded-facelets))
      (let ((facelet-row (aref unfolded-facelets row)))
        (dotimes (col (length facelet-row))
          (let ((facelet-index (aref facelet-row col)))
            (when (>= facelet-index 0)
              (let* ((facelet (aref facelets facelet-index))
                     (colors (cond
                              ((<= 00 facelet 08) wca-prep-white-svg-tile)
                              ((<= 09 facelet 17) wca-prep-orange-svg-tile)
                              ((<= 18 facelet 26) wca-prep-green-svg-tile)
                              ((<= 27 facelet 35) wca-prep-red-svg-tile)
                              ((<= 36 facelet 44) wca-prep-blue-svg-tile)
                              ((<= 45 facelet 53) wca-prep-yellow-svg-tile)))
                     (fg-color (aref colors 0))
                     (bg-color (aref colors 1))
                     (outline-x (+ (* col (+ tile-size border-width))
                                   drawing-offset))
                     (outline-y (+ (* row (+ tile-size border-width))
                                   drawing-offset))
                     (outline-size (+ tile-size (* border-width 2)))
                     (fill-x (+ outline-x border-width))
                     (fill-y (+ outline-y border-width))
                     (fill-size tile-size))
                (svg-rectangle svg outline-x outline-y
                               outline-size outline-size
                               :fill bg-color)
                (svg-rectangle svg fill-x fill-y
                               fill-size fill-size
                               :fill fg-color)))))))
    (svg-insert-image svg)
    (insert "\n")))

;;; data model

(defconst wca-prep-wca-puzzles
  '("2x2x2" "3x3x3" "4x4x4" "5x5x5" "6x6x6" "7x7x7"
    "Clock" "Skewb" "Megaminx" "Pyraminx" "Square-1"))

(defvar wca-prep-db nil)

(defcustom wca-prep-db-dir (locate-user-emacs-file "wca-prep/")
  "Directory storing the SQLite database"
  :type 'directory
  :group 'wca-prep)

(defconst wca-prep-sql-schema
  '("CREATE TABLE puzzles(id INTEGER PRIMARY KEY,
                          name TEXT,
                          last_cid INTEGER,
                          FOREIGN KEY(last_cid) REFERENCES categories(id),
                          UNIQUE(name))"
    "CREATE TABLE categories(id INTEGER PRIMARY KEY,
                             label TEXT)"
    "CREATE TABLE runs(id INTEGER PRIMARY KEY,
                       pid INTEGER,
                       cid INTEGER,
                       timestamp INTEGER,
                       duration REAL,
                       FOREIGN KEY(pid) REFERENCES puzzles(id),
                       FOREIGN KEY(cid) REFERENCES categories(id))"
    "CREATE TABLE wca_prep_settings(key TEXT,
                                    value TEXT,
                                    UNIQUE(key))"))

(defmacro wca-prep--with-sqlite-shorthands (&rest body)
  (declare (debug (sexp body)) (indent 0))
  `(cl-macrolet ((sqlite-select-row (db sql &optional values)
                   `(car (sqlite-select ,db ,sql ,values)))
                 (sqlite-select-value (db sql &optional values)
                   `(car (car (sqlite-select ,db ,sql ,values))))
                 ;; (sqlite-execute-row (db sql &optional values)
                 ;;   `(car (sqlite-execute ,db ,sql ,values)))
                 (sqlite-execute-value (db sql &optional values)
                   `(car (car (sqlite-execute ,db ,sql ,values)))))
     ,@body))

(defun wca-prep-db-put (db key value)
  (sqlite-execute db "INSERT INTO wca_prep_settings(key, value)
                           VALUES(?, ?)"
                  (list key value)))

(defun wca-prep-db-get (db key)
  (wca-prep--with-sqlite-shorthands
    (sqlite-select-value db "SELECT value
                               FROM wca_prep_settings
                              WHERE key = ?"
                         (list key))))

(defmacro wca-prep--with-sqlite-transaction (db &rest body)
  "Execute BODY while holding a transaction for DB.
Similar to `with-sqlite-transaction', except it does perform
`sqlite-rollback' on error and reraises the exception."
  (declare (debug (sexp body)) (indent 1))
  (let ((db-var (gensym))
        (func-var (gensym))
        (res-var (gensym))
        (commit-var (gensym)))
    `(let ((,db-var ,db)
           (,func-var (lambda () ,@body))
           ,res-var ,commit-var)
       (if (sqlite-available-p)
           (unwind-protect
               (progn
                 (sqlite-transaction ,db-var)
                 (setq ,res-var (funcall ,func-var))
                 (setq ,commit-var (sqlite-commit ,db-var))
                 ,res-var)
             (or ,commit-var (sqlite-rollback ,db-var)))
         (funcall ,func-var)))))

(defun wca-prep-initialize-db (db)
  (wca-prep--with-sqlite-shorthands
    (wca-prep--with-sqlite-transaction db
      (dolist (statement wca-prep-sql-schema)
        (sqlite-execute db statement))
      (dolist (puzzle wca-prep-wca-puzzles)
        (let ((cid (sqlite-execute-value db "INSERT INTO categories(label)
                                                  VALUES(?)
                                               RETURNING id"
                                         '("default"))))
          (sqlite-execute db "INSERT INTO puzzles(name, last_cid)
                                   VALUES(?, ?)"
                                (list puzzle cid))))
      (wca-prep-db-put db "last_puzzle" "3x3x3"))))

(defun wca-prep-persist-run (db puzzle-name timestamp duration)
  (message "Trying to persist run of %.2fs..." duration)
  (wca-prep--with-sqlite-shorthands
    (wca-prep--with-sqlite-transaction db
      (let ((ret (sqlite-select-row db "SELECT id, last_cid FROM puzzles
                                         WHERE name = ?"
                                    (list (symbol-name puzzle-name)))))
        (seq-let (pid cid) ret
          (when (or (not pid) (not cid))
            (error "Unknown puzzle name: %s" puzzle-name))
          (sqlite-execute db "INSERT INTO runs(pid, cid, timestamp, duration)
                                 VALUES(?, ?, ?, ?)"
                          (list pid cid timestamp duration))))))
  (message "Persisted run of %.2fs!" duration))

(defun wca-prep-delete-last-run (db puzzle-name)
  (message "Trying to delete last run...")
  (wca-prep--with-sqlite-shorthands
    (wca-prep--with-sqlite-transaction db
      (let ((ret (sqlite-select-row db "SELECT id, last_cid FROM puzzles
                                         WHERE name = ?"
                                    (list (symbol-name puzzle-name)))))
        (seq-let (pid cid) ret
          (when (or (not pid) (not cid))
            (error "Unknown puzzle name: %s" puzzle-name))
          (let ((rid (sqlite-select-value db "SELECT id FROM runs
                                               WHERE pid = ? AND cid = ?
                                            ORDER BY timestamp DESC
                                               LIMIT 1"
                                             (list pid cid))))
            (when (not rid)
              (user-error "No last run recorded for current puzzle"))
            (sqlite-execute db "DELETE FROM runs WHERE id = ?" (list rid))
            (message "Deleted last run!")))))))

(defun wca-prep-fetch-runs (db puzzle-name)
  (wca-prep--with-sqlite-shorthands
    (wca-prep--with-sqlite-transaction db
      (let ((ret (sqlite-select-row db "SELECT id, last_cid FROM puzzles
                                         WHERE name = ?"
                                    (list (symbol-name puzzle-name)))))
        (seq-let (pid cid) ret
          (when (or (not pid) (not cid))
            (error "Unknown puzzle name: %s" puzzle-name))
          (sqlite-select db "SELECT id, timestamp, duration FROM runs
                              WHERE pid = ? AND cid = ?
                           ORDER BY timestamp ASC"
                         (list pid cid)))))))

;; TODO: add migration support
(defun wca-prep-check-db (db)
  (let* ((col-names
          (mapcar #'car
                  (sqlite-select db "SELECT name FROM pragma_table_info(?)"
                                 '("wca_prep_settings")))))
    (when (not col-names)
      (wca-prep-initialize-db db))))

(defun wca-prep-ensure-db ()
  (when (not wca-prep-db)
    (when (not (file-exists-p wca-prep-db-dir))
      (make-directory wca-prep-db-dir t))
    (setq wca-prep-db (sqlite-open (expand-file-name "db" wca-prep-db-dir)))
    (when (not (sqlitep wca-prep-db))
      (error "Failed to open SQLite database"))
    (sqlite-pragma wca-prep-db "foreign_keys = ON")
    (sqlite-pragma wca-prep-db "journal_mode = WAL"))
  (wca-prep-check-db wca-prep-db))

;;; interactive commands

(defcustom wca-prep-timer-redraw-interval 0.05
  "Interval at which the elapsed time is redrawn.
Smaller values increase both accuracy and CPU usage."
  :type 'float
  :group 'wca-prep)

(defvar-local wca-prep-elapsed-beg nil)
(defvar-local wca-prep-elapsed-end nil)
(defvar-local wca-prep-scramble-beg nil)
(defvar-local wca-prep-scramble-end nil)
(defvar-local wca-prep-facelets-beg nil)
(defvar-local wca-prep-facelets-end nil)

(defvar-local wca-prep-timer nil)
(defvar-local wca-prep-timer-state nil)
(defvar-local wca-prep-from-timestamp nil)
(defvar-local wca-prep-to-timestamp nil)

(defconst wca-prep-buffer-name "*WCA Prep*")
(defconst wca-prep-stats-buffer-name "*WCA Prep Stats*")
(defconst wca-prep-mode-name "WCA Prep")

(define-derived-mode wca-prep-mode special-mode wca-prep-mode-name
  "Practice WCA puzzles (such as Rubik's Cube)"
  (setq wca-prep-timer-state 'paused)
  (buffer-disable-undo))

(cl-defgeneric wca-prep-initialize-puzzle-vars (_puzzle)
  "Set up variables for PUZZLE.")

(cl-defmethod wca-prep-initialize-puzzle-vars ((_puzzle (eql '2x2x2)))
  (setq wca-prep-puzzle-faces [L R U D F B])
  (setq wca-prep-puzzle-scramble-faces [R U F])
  (setq wca-prep-puzzle-scramble-rotations [1 2 3])
  (setq wca-prep-puzzle-scramble-length 11)
  (setq wca-prep-puzzle-facelet-count (* 4 6))
  (setq wca-prep-puzzle-scramble
        (make-vector wca-prep-puzzle-scramble-length nil))
  (setq wca-prep-puzzle-facelets
        (make-vector wca-prep-puzzle-facelet-count nil)))

(cl-defmethod wca-prep-initialize-puzzle-vars ((_puzzle (eql '3x3x3)))
  (setq wca-prep-puzzle-faces [L R U D F B])
  (setq wca-prep-puzzle-scramble-faces [L R U D F B])
  (setq wca-prep-puzzle-scramble-rotations [1 2 3])
  (setq wca-prep-puzzle-scramble-length 20)
  (setq wca-prep-puzzle-facelet-count (* 9 6))
  (setq wca-prep-puzzle-scramble
        (make-vector wca-prep-puzzle-scramble-length nil))
  (setq wca-prep-puzzle-facelets
        (make-vector wca-prep-puzzle-facelet-count nil)))

(defun wca-prep-initialize-puzzle ()
  ;; TODO: query last puzzle from config/db
  (when (not wca-prep-current-puzzle)
    (setq wca-prep-current-puzzle '3x3x3)))

;; TODO: have a reset procedure to switch between puzzles

(defun wca-prep-initialize-buffer ()
  (let (buffer-read-only)
    (erase-buffer)
    (insert "Elapsed: ")
    (setq wca-prep-elapsed-beg (point-marker))
    (insert " ")
    (setq wca-prep-elapsed-end (point-marker))
    (insert "\n\n")
    (setq wca-prep-scramble-beg (point-marker))
    (insert " ")
    (setq wca-prep-scramble-end (point-marker))
    (insert "\n\n")
    (setq wca-prep-facelets-beg (point-marker))
    (insert " ")
    (setq wca-prep-facelets-end (point-marker))

    (set-marker-insertion-type wca-prep-scramble-end t)
    (set-marker-insertion-type wca-prep-elapsed-end t)
    (set-marker-insertion-type wca-prep-facelets-end t)))

(defun wca-prep-randomize-puzzle ()
  (dotimes (i (length wca-prep-puzzle-facelets))
    (aset wca-prep-puzzle-facelets i i))
  (let ((puzzle wca-prep-current-puzzle))
    (wca-prep-generate-scramble-turns puzzle wca-prep-puzzle-scramble))
  (wca-prep-apply-scramble wca-prep-puzzle-scramble
                           wca-prep-puzzle-facelets))

(defun wca-prep-render-puzzle ()
  (let ((puzzle wca-prep-current-puzzle)
        (scramble wca-prep-puzzle-scramble)
        (facelets wca-prep-puzzle-facelets)
        buffer-read-only)
    (save-excursion
      (save-restriction
        (narrow-to-region wca-prep-scramble-beg wca-prep-scramble-end)
        (delete-region (point-min) (point-max))
        (wca-prep-insert-scramble puzzle scramble))
      (save-restriction
        (narrow-to-region wca-prep-facelets-beg wca-prep-facelets-end)
        (delete-region (point-min) (point-max))
        (wca-prep-insert-facelets puzzle facelets)))))

(defun wca-prep-render-time-in-buffer (elapsed)
  (let (buffer-read-only)
    (save-excursion
      (save-restriction
        (narrow-to-region wca-prep-elapsed-beg wca-prep-elapsed-end)
        (delete-region (point-min) (point-max))
        (insert (format "%.2fs" elapsed))))))

(defun wca-prep-render-time-in-modeline (elapsed)
  (setq mode-name (format "%s: %.2fs" wca-prep-mode-name elapsed))
  (force-mode-line-update))

(defun wca-prep-elapsed-time ()
  (- (or wca-prep-to-timestamp (float-time))
     wca-prep-from-timestamp))

(defun wca-prep-render-time (buf)
  (with-current-buffer buf
    (wca-prep-render-time-in-buffer (wca-prep-elapsed-time))))

(defun wca-prep-random-puzzle ()
  (interactive)
  (wca-prep-randomize-puzzle)
  (wca-prep-render-puzzle))

(defun wca-prep-toggle-timer ()
  (interactive)
  (if wca-prep-timer
      (progn
        (setq wca-prep-to-timestamp (float-time))
        (cancel-timer wca-prep-timer)
        (setq wca-prep-timer nil)
        (wca-prep-render-time (current-buffer))
        (let ((puzzle wca-prep-current-puzzle)
              (timestamp (truncate (float-time)))
              (duration (wca-prep-elapsed-time)))
          (wca-prep-persist-run wca-prep-db puzzle timestamp duration)
          (wca-prep-random-puzzle)))
    (setq wca-prep-from-timestamp (float-time))
    (setq wca-prep-to-timestamp nil)
    (let* ((interval wca-prep-timer-redraw-interval)
           (buf (current-buffer))
           (timer (run-at-time interval interval #'wca-prep-render-time buf)))
      (setq wca-prep-timer timer)))
  (cl-ecase wca-prep-timer-state
    (playing (setq wca-prep-timer-state 'paused))
    (paused (setq wca-prep-timer-state 'playing))))

(defun wca-prep-cancel-run ()
  (interactive)
  (if (yes-or-no-p "Delete last run? ")
      (wca-prep-delete-last-run wca-prep-db wca-prep-current-puzzle)
    (message "")))

(defun wca-prep--tabulated-list-duration<? (a b)
  (let ((timestamp1 (get-text-property 0 'value (aref (cadr a) 1)))
        (timestamp2 (get-text-property 0 'value (aref (cadr b) 1))))
    (< timestamp1 timestamp2)))

(define-derived-mode wca-prep-runs-list-mode tabulated-list-mode "WCA Prep Stats"
  "Mode for listing stats for WCA puzzle practice (such as Rubik's Cube)"
  ;; TODO: unbind revert key for now (because it needs the db and
  ;; current puzzle to work correctly, except they are set in the
  ;; other buffer)
  (setq tabulated-list-format
        [("Timestamp" 20 t)
         ("Duration" 10 wca-prep--tabulated-list-duration<?)]))

(defun wca-prep--run-to-tabulated-list-entry (row)
  (seq-let (id timestamp duration) row
    (let* ((time-format "%Y-%m-%d %H:%M:%S" )
           (time-string (format-time-string time-format timestamp))
           (duration-string (format "%.2fs" duration))
           (duration-string (propertize duration-string 'value duration)))
      (list id (vector time-string duration-string)))))

(defun wca-prep-show-runs-as-tabulated-list ()
  (interactive)
  (let ((buf (get-buffer-create wca-prep-stats-buffer-name))
        (runs (wca-prep-fetch-runs wca-prep-db wca-prep-current-puzzle)))
    (with-current-buffer buf
      (let (buffer-read-only)
        (erase-buffer)
        (wca-prep-runs-list-mode)
        (tabulated-list-init-header)
        (setq tabulated-list-entries
              (mapcar #'wca-prep--run-to-tabulated-list-entry runs))
        (tabulated-list-print)))
    (pop-to-buffer buf)))

(defun wca-prep-show-runs-as-graph ()
  (interactive)
  (user-error "TODO"))

(defun wca-prep-select-puzzle (puzzle)
  (interactive)
  (when (not (memq puzzle '(2x2x2 3x3x3)))
    (user-error "Unsupported puzzle: %s" puzzle))
  (setq wca-prep-current-puzzle puzzle)
  ;; TODO: reinitialize vars
  ;; TODO: re-render
  )

(let ((map wca-prep-mode-map))
  (define-key map (kbd "SPC") #'wca-prep-toggle-timer)
  (define-key map (kbd "p") #'wca-prep-dispatch-puzzle)
  (define-key map (kbd "g") nil) ; HACK: no need for revert-buffer
  (define-key map (kbd "r") #'wca-prep-random-puzzle)
  (define-key map (kbd "k") #'wca-prep-cancel-run)
  (define-key map (kbd "s") #'wca-prep-dispatch-stats)
  (define-key map (kbd "h") #'wca-prep-dispatch-help)
  (define-key map (kbd "?") #'wca-prep-dispatch-help))

(transient-define-prefix wca-prep-dispatch-help ()
  "Transient overview of available top-level commands"
  [["Stopwatch"
    ("SPC" "Toggle timer" wca-prep-toggle-timer)
    ;; TODO: modify those two to confirm/abort this (magit-style)
    ("k" "Cancel last run" wca-prep-cancel-run)]

   ["Other"
    ("r" "Randomize puzzle" wca-prep-random-puzzle)
    ("p" "Select puzzle" wca-prep-dispatch-puzzle)
    ("s" "Show stats" wca-prep-dispatch-stats)]])

(transient-define-prefix wca-prep-dispatch-puzzle (arg)
  "Transient overview of puzzle selection"
  [["NxNxN puzzles"
    ("2" "2x2x2" (lambda () (interactive) (wca-prep-select-puzzle '2x2x2)))
    ("3" "3x3x3" (lambda () (interactive) (wca-prep-select-puzzle '3x3x3)))
    ("4" "4x4x4" (lambda () (interactive) (wca-prep-select-puzzle '4x4x4)))
    ("5" "5x5x5" (lambda () (interactive) (wca-prep-select-puzzle '5x5x5)))
    ("6" "6x6x6" (lambda () (interactive) (wca-prep-select-puzzle '6x6x6)))
    ("7" "7x7x7" (lambda () (interactive) (wca-prep-select-puzzle '7x7x7)))]

   ["Other puzzles"
    ("c" "Clock" (lambda () (interactive) (wca-prep-select-puzzle 'clock)))
    ("k" "Skewb" (lambda () (interactive) (wca-prep-select-puzzle 'skewb)))
    ("m" "Megaminx" (lambda () (interactive) (wca-prep-select-puzzle 'megaminx)))
    ("p" "Pyraminx" (lambda () (interactive) (wca-prep-select-puzzle 'pyraminx)))
    ("s" "Square-1" (lambda () (interactive) (wca-prep-select-puzzle 'square-1)))]])

(transient-define-prefix wca-prep-dispatch-stats (arg)
  "Transient overview of stats selection"
  [("l" "Show stats as list" wca-prep-show-runs-as-tabulated-list)
   ("g" "Show stats as graph" wca-prep-show-runs-as-graph)])

(defun wca-prep-sanity-check ()
  (when (or (not (display-images-p))
            (not (image-type-available-p 'svg)))
    (user-error "wca-prep requires SVG support"))
  (when (not (sqlite-available-p))
    (user-error "wca-prep requires SQLite support")))

(defun wca-prep ()
  (interactive)
  (wca-prep-sanity-check)
  (wca-prep-ensure-db)
  (let ((buf (get-buffer-create wca-prep-buffer-name)))
    (with-current-buffer buf
      (wca-prep-mode)
      (wca-prep-initialize-puzzle)
      (wca-prep-initialize-puzzle-vars wca-prep-current-puzzle)
      (wca-prep-randomize-puzzle)
      (wca-prep-initialize-buffer)
      (wca-prep-render-puzzle))
    (pop-to-buffer buf)))

;; TODO: record last used puzzle in transient UI
;; TODO: show current puzzle/category (in modeline?)