diff options
| -rw-r--r-- | config.lisp | 4 | ||||
| -rw-r--r-- | database/run.lisp | 41 | ||||
| -rw-r--r-- | lispruns.asd | 3 | ||||
| -rw-r--r-- | main.lisp | 80 | ||||
| -rw-r--r-- | speedrun.lisp | 6 | ||||
| -rw-r--r-- | ui.lisp | 35 | ||||
| -rw-r--r-- | util.lisp | 2 |
7 files changed, 123 insertions, 48 deletions
diff --git a/config.lisp b/config.lisp index bdb11ca..31f1f58 100644 --- a/config.lisp +++ b/config.lisp @@ -15,7 +15,7 @@ (defun sections (lines &optional (section-list '()) (current-section "") (current-section-list '())) (if (not lines) (cond - ((> (length current-section) 0) + ((nonempty-p current-section) (cons (list current-section current-section-list) section-list)) (t section-list)) (let* ((line (car lines)) @@ -24,7 +24,7 @@ ((= linelen 0) (sections (cdr lines) section-list current-section current-section-list)) ((and (equal #\[ (char line 0)) (equal #\] (char line (1- linelen)))) - (sections (cdr lines) (unless (= (length current-section) 0) + (sections (cdr lines) (unless (not (nonempty-p current-section)) (cons (list current-section current-section-list) section-list)) (subseq line 1 (1- linelen)))) (t diff --git a/database/run.lisp b/database/run.lisp index d474426..3166041 100644 --- a/database/run.lisp +++ b/database/run.lisp @@ -1,6 +1,5 @@ (mito:deftable run () - ((category :col-type category) - (end-date :col-type (or :datetime :null))) + ((category :col-type category)) (:record-timestamps nil) (:conc-name run-)) @@ -13,12 +12,15 @@ (:conc-name run-split-)) - (defun run-splits (run) (mito:select-dao 'run-split (sxql:order-by :category_split_id) (sxql:where (:= :run run)))) +(defun delete-run (run) + (let ((splits (run-splits run))) + (mapcar 'mito:delete-dao (cons run splits)))) + ;; Returns the elapsed time in milliseconds since split started to either ;; current time or the split's end time (defun run-split-elapsed-time (run-split) @@ -41,20 +43,20 @@ ,@body))) (defun best-category-run (category) - (query-with-runs-elapsed - (sxql:inner-join :run :on (:= :run_id :run.id)) - (sxql:order-by :elapsed) - (sxql:limit 1) - (sxql:where (:= :category_id (mito:object-id category))))) + (car (query-with-runs-elapsed + (sxql:inner-join :run :on (:= :run_id :run.id)) + (sxql:order-by :elapsed) + (sxql:limit 1) + (sxql:where (:= :category_id (mito:object-id category)))))) (defun best-category-split (category-split) - (query-with-runs-elapsed - (sxql:inner-join :category_split :on (:= :category_split_id :category_split.id)) - (sxql:order-by :elapsed) - (sxql:limit 1) - (sxql:where (:= :category_split_id (mito:object-id category-split))))) + (car (query-with-runs-elapsed + (sxql:inner-join :category_split :on (:= :category_split_id :category_split.id)) + (sxql:order-by :elapsed) + (sxql:limit 1) + (sxql:where (:= :category_split_id (mito:object-id category-split)))))) -(defun list-runs (&key (order-element :end-time) (direction :asc)) +(defun list-runs (&key (order-element :id) (direction :asc)) (query-with-runs-elapsed (sxql:inner-join :run :on (:= :run_id :run.id)) (sxql:inner-join :category :on (:= :category_id :category.id)) @@ -65,3 +67,14 @@ (sxql:inner-join :run :on (:= :run_id :run.id)) (sxql:order-by (list direction order-element)) (sxql:where (:= :category_id (mito:object-id category))))) + + +(defun statistics (category-splits) + `((SPLIT-PBS ,(mapcar (lambda (category) (getf (best-category-split category) :ELAPSED)) csplits)) + (BEST-CATEGORY-RUN-SPLITS ,(or + (mapcar (lambda (split) + (millis-since-internal-timestamp 0 (run-split-elapsed-time split))) + (ignore-errors + (run-splits (mito:find-dao 'run :id (getf (best-category-run category) :RUN-ID))))) + (mapcar (lambda (csplit) nil) csplits))))) + diff --git a/lispruns.asd b/lispruns.asd index 98faa3f..05f0fb5 100644 --- a/lispruns.asd +++ b/lispruns.asd @@ -5,8 +5,7 @@ :depends-on (:mito :sxql :cl-ppcre - :croatoan - :local-time) + :croatoan) :components ((:file "util") ;; Miscellaneous helpers (:file "config") ;; For importing category configuration files (:file "digits") ;; Lisp file with cool ascii digits @@ -12,7 +12,7 @@ "88booo. .88. db 8D 88 88 `88. 88b d88 88 V888 db 8D" "Y88888P Y888888P `8888Y' 88 88 YD ~Y8888P' VP V8P `8888Y'")) -(defun get-input (prompt &optional (validator (lambda (x) t))) +(defun get-input (prompt &optional (validator 'nonempty-p)) (clear-input) (write-string prompt) (finish-output) @@ -32,10 +32,14 @@ (format t " [~a] ~a~%" i (car x)))) (let ((user-input (get-input (format nil "Select [~a - ~a] or search: " 1 (length options))))) (if (every #'digit-char-p user-input) + ;; Selected by option index (let ((user-integer (parse-integer user-input))) (if (and (>= user-integer 1) (<= user-integer (length options))) (cdr (nth (1- user-integer) options)) - (select-option options))) + (progn + (format t "E: Not a valid selection.~%") + (select-option options)))) + ;; Search for user string, either select the one it matches or recursively call select-option on the matched options (let* ((scanner (cl-ppcre:create-scanner user-input :case-insensitive-mode t)) (filtered (remove-if-not @@ -48,17 +52,17 @@ (cdr searched) (select-option options)))) (t - (format t "That search came up with multiple results:") + (format t "That search came up with multiple results:~%") (select-option filtered))) (progn (format t "E: Could not find option that matched query.~%") (select-option options))))))) (defun user-create-new-category () - (let* ((name (get-input "Category Name (e.g. \"SM64\"): " 'empty-p)) - (percentage (get-input "Percentage (e.g. \"16 Star\"): " 'empty-p)) + (let* ((name (get-input "Category Name (e.g. \"SM64\"): ")) + (percentage (get-input "Percentage (e.g. \"Any% 16 Star\"): ")) (category (mito:insert-dao (make-instance 'category :name name :percentage percentage))) (splits (do ((spliti 1 (1+ spliti)) - (inputs '() (push (get-input (format nil "Split Name [~a]~a: " spliti (if (<= spliti 1) " (blank when done adding)" ""))) inputs))) + (inputs '() (push (get-input (format nil "Split Name [~a]~a: " spliti (if (<= spliti 1) " (blank when done adding)" "")) (lambda (x) t)) inputs))) ((equal (car inputs) "") (mapcar (lambda (category-split-name) @@ -66,36 +70,86 @@ (make-instance 'category-split :name category-split-name :category category))) - (reverse (cdr inputs))))))))) + (reverse (cdr inputs))))))) + (if splits + (format t "Successfully created category~%")))) (defun with-selected-category (f) (let* ((categories (mito:select-dao 'category)) (category-alist (mapcar (lambda (category) `(,(format nil "~a - ~a" (category-name category) (category-percentage category)) . ,category)) categories))) (if categories (funcall f (select-option category-alist)) - (format t "E: There are no categories. Try creating one or importing one")))) + (format t "E: There are no categories. Try creating one or importing one~%")))) + +(defun with-selected-speedrun (f) + (let* ((filter (select-option '(("Choose from a category" . CATEGORY) ("List runs from all categories" . ALL)))) + (runs + (case filter + ('CATEGORY (with-selected-category 'list-category-runs)) + ('ALL (list-runs)))) + (run-details-alist (mapcar (lambda (run-detail) + `(,(let ((formatted-elapsed (format-time (make-time-alist (getf run-detail :ELAPSED)))) + (category-name (getf run-detail :NAME)) + (category-percentage (getf run-detail :PERCENTAGE))) + (apply 'format + (if (and category-name category-percentage) + `(nil "~a - ~a | ~a" ,category-name ,category-percentage ,formatted-elapsed) + `(nil "~a" ,formatted-elapsed)))) + . ,(mito:find-dao 'run :id (getf run-detail :RUN-ID)))) + runs))) + (if run-details-alist + (funcall f (select-option run-details-alist)) + (progn + (format t "E: No runs found~%") + (if (y-or-n-p "Go back?") + nil + (with-selected-speedrun f)))))) - (defun main () (let ((choice (select-option '(("Help" . HELP) ("Import a category" . IMPORT-CATEGORY) ("Make a new category" . NEW-CATEGORY) + ("Delete a category" . DELETE-CATEGORY) ("Start a speedrun" . START-SPEEDRUN) - ("Statistics" . LIST-CATEGORIES) + ("View splits of a speedrun" . VIEW-SPEEDRUNS) + ("Delete a speedrun" . DELETE-SPEEDRUN) ("Exit" . EXIT))))) (case choice ('HELP (format t "~%") - (mapcar #'(lambda (x) (format t "~a~%" x)) *lispruns-logo*)) + (mapcar #'(lambda (x) (format t "~a~%" x)) *lispruns-logo*) + (format t "Welcome to Lispruns!~%")) ('IMPORT-CATEGORY - (import-category (get-input + (if (import-category (get-input (format nil "Relative or absolute path to configuration file [~a]: " (uiop/os:getcwd)) - 'probe-file))) + 'probe-file)) + (format t "Successfully imported category~%"))) ('NEW-CATEGORY (user-create-new-category)) ('START-SPEEDRUN (with-selected-category 'speedrun-ui)) + ('DELETE-SPEEDRUN + (with-selected-speedrun 'mito:delete-dao)) + ('DELETE-CATEGORY + (with-selected-category (lambda (category) + (let ((runs + (mapcar + (lambda (run-detail) (mito:find-dao 'run :id (getf run-detail :RUN-ID))) + (list-category-runs category)))) + (mapcar 'delete-run runs)) + (mito:delete-dao category))) + (format t "Deleted category~%")) + ('VIEW-SPEEDRUNS + (with-selected-speedrun (lambda (run) + (let ((csplits (category-splits (run-category run))) + (rsplits (run-splits run))) + (mapcar (lambda (csplit rsplit) + (format t " ~a~%" (format-line `((,(category-split-name csplit) . ,(/ 3 10)) + ("|" . ,(/ 1 10)) + (,(run-split-format-elapsed-time rsplit) . ,(/ 6 10))) + 70 0))) + csplits rsplits))))) ('EXIT (quit)))) (format t "~%") diff --git a/speedrun.lisp b/speedrun.lisp index f1238f1..e393282 100644 --- a/speedrun.lisp +++ b/speedrun.lisp @@ -6,9 +6,6 @@ (title :initarg :title :accessor speedrun-title) - ;; Whatever internal time units decided by SBCL (get-internal-real-time) - ;; (local-time:now) *could* be used, but by my testing it's around 6 times slower - ;; so why not (start-timestamp :initarg :start-timestamp :accessor speedrun-start-timestamp) @@ -66,8 +63,7 @@ (if (equal (speedrun-current-split-index speedrun) (1- (length (speedrun-splits speedrun)))) (progn (setf - (run-end-date (speedrun-run-dao speedrun)) (local-time:now) - ;; Since timer can get +-0.02 seconds out of sync of splits, just set it to the sum of the splits' elapsed + ;; Since timer computation can get +-0.02 seconds out of sync of splits, just set it to the sum of the splits' elapsed time (speedrun-elapsed speedrun) (millis-since-internal-timestamp 0 (apply '+ (mapcar 'run-split-elapsed-time (speedrun-splits speedrun)))) (speedrun-state speedrun) 'STOPPED) (save-speedrun speedrun)) @@ -1,6 +1,6 @@ (defparameter *colors* '((main . (:green :black)) - (timer-box . (:red :black)) + (timer-box . (:green :black)) (selected-highlight . (:blue :black)) (unselected-highlight . (:white :black)))) @@ -19,10 +19,21 @@ slices))) ;; Formats a category split and a run split for the splits window -(defun make-split-line (csplit speedrun-split) - `((,(category-split-name csplit) . ,(/ 4 12)) - ("" . ,(/ 1 12)) - (,(run-split-format-elapsed-time speedrun-split) . ,(/ 3 12)))) +(defun make-split-line (csplit speedrun-split pb) + (let ((split-elapsed (run-split-elapsed-time speedrun-split)) + (format-split-elapsed (run-split-format-elapsed-time speedrun-split))) + `((,(category-split-name csplit) . ,(/ 4 12)) + ("" . ,(/ 1 12)) + (,format-split-elapsed . ,(/ 3 12)) + ("" . ,(/ 1 12)) + (,(if pb + (let ((split-end-timestamp (ignore-errors (run-split-end-timestamp speedrun-split)))) + (if split-end-timestamp + (let ((elapsed-diff (- (millis-since-internal-timestamp 0 split-elapsed) pb))) + (concatenate 'string (if (plusp elapsed-diff) "+" "-") (format-time (make-time-alist (abs elapsed-diff))))) + (format-time (make-time-alist pb)))) + format-split-elapsed) + . ,(/ 3 12))))) ;; Creates a window with the total time and statistics (defun timer-window (speedrun pos width height) @@ -32,8 +43,7 @@ :position pos :width width :height height))) - (setf (croatoan:color-pair timer-box) - (cdr (assoc 'timer-box *colors*))) + (setf (croatoan:color-pair timer-box) (cdr (assoc 'timer-box *colors*))) (write-horizontal-slice-list timer-box '(1 1) timerglet) timer-box)) @@ -92,14 +102,17 @@ (defun speedrun-ui (category) (croatoan:with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil :enable-colors t :input-buffering nil :input-blocking nil) (setf (croatoan:background scr) (make-instance 'croatoan:complex-char :color-pair (cdr (assoc 'main *colors*)))) + + ;; Create a closure over the UI state (let* ((scroll 0) (frame 0) (state 'TITLE) (redraws '(title-instance)) (speedrun (make-speedrun category)) - (csplits (category-splits category)) - ;; TODO - (pbs ())) + (bests (statistics (category-splits category))) + (split-pbs (cdr (assoc 'SPLIT-PBS bests))) + (best-category-run-pbs (cdr (assoc 'BEST-CATEGORY-RUN-SPLITS bests)))) + (flet ((render () (case state ('TITLE @@ -134,7 +147,7 @@ :height splits-height :width max-width ;; Todo: add personal bests to elements - :elements (mapcar 'make-split-line csplits (speedrun-splits speedrun)))) + :elements (mapcar 'make-split-line csplits (speedrun-splits speedrun) best-category-run-pbs))) (splits-instance (highlight-list-window split-list `(0 ,centered-x))) (timer-instance (timer-window speedrun `(,splits-height ,centered-x) max-width timer-height))) (croatoan:refresh splits-instance) @@ -10,5 +10,5 @@ (defun max-length (lists) (reduce (lambda (a x) (max a x)) (mapcar #'length lists))) -(defun empty-p (s) +(defun nonempty-p (s) (not (zerop (length s)))) |