Added more CLI options

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

database/run.lisp

@@ -1,6 +1,5 @@
 (mito:deftable run ()
-  ((category :col-type category)
+  ((category :col-type category))
-   (end-date :col-type (or :datetime :null)))
   (: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
+  (car (query-with-runs-elapsed
-   (sxql:inner-join :run :on (:= :run_id :run.id))
+        (sxql:inner-join :run :on (:= :run_id :run.id))
-   (sxql:order-by :elapsed)
+        (sxql:order-by :elapsed)
-   (sxql:limit 1)
+        (sxql:limit 1)
-   (sxql:where (:= :category_id (mito:object-id category)))))
+        (sxql:where (:= :category_id (mito:object-id category))))))
 
 (defun best-category-split (category-split)
-  (query-with-runs-elapsed
+  (car (query-with-runs-elapsed
-   (sxql:inner-join :category_split :on (:= :category_split_id :category_split.id))
+        (sxql:inner-join :category_split :on (:= :category_split_id :category_split.id))
-   (sxql:order-by :elapsed)
+        (sxql:order-by :elapsed)
-   (sxql:limit 1)
+        (sxql:limit 1)
-   (sxql:where (:= :category_split_id (mito:object-id category-split)))))
+        (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)))))
+  

lispruns.asd

@@ -5,8 +5,7 @@
   :depends-on (:mito
                :sxql
                :cl-ppcre
-               :croatoan
+               :croatoan)
-               :local-time)
   :components ((:file "util") ;; Miscellaneous helpers
                (:file "config") ;; For importing category configuration files
                (:file "digits") ;; Lisp file with cool ascii digits

main.lisp

@@ -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))
+  (let* ((name (get-input "Category Name (e.g. \"SM64\"): "))
-         (percentage (get-input "Percentage (e.g. \"16 Star\"): " 'empty-p))
+         (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 "~%")

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 computation can get +-0.02 seconds out of sync of splits, just set it to the sum of the splits' elapsed time
-             ;; Since timer can get +-0.02 seconds out of sync of splits, just set it to the sum of the splits' elapsed
              (speedrun-elapsed speedrun) (millis-since-internal-timestamp 0 (apply '+ (mapcar 'run-split-elapsed-time (speedrun-splits speedrun)))) 
              (speedrun-state speedrun) 'STOPPED)
             (save-speedrun speedrun))

ui.lisp

@@ -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)
+(defun make-split-line (csplit speedrun-split pb)
-  `((,(category-split-name csplit) . ,(/ 4 12))
+  (let ((split-elapsed (run-split-elapsed-time speedrun-split))
-    ("" . ,(/ 1 12))
+        (format-split-elapsed (run-split-format-elapsed-time speedrun-split)))
-    (,(run-split-format-elapsed-time speedrun-split) . ,(/ 3 12))))
+    `((,(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)
+    (setf (croatoan:color-pair timer-box) (cdr (assoc 'timer-box *colors*)))
-          (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))
+           (bests (statistics (category-splits category)))
-           ;; TODO
+           (split-pbs (cdr (assoc 'SPLIT-PBS bests)))
-           (pbs ()))
+           (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)

util.lisp

@@ -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))))