Added more CLI options
This commit is contained in:
parent
f272429796
commit
6dadca7796
@ -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
|
||||
|
@ -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
|
||||
(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)))))
|
||||
(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:order-by :elapsed)
|
||||
(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)))))
|
||||
|
||||
|
@ -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
|
||||
|
78
main.lisp
78
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))
|
||||
(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 "~%")
|
||||
|
@ -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))
|
||||
|
31
ui.lisp
31
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)
|
||||
(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))
|
||||
(,(run-split-format-elapsed-time speedrun-split) . ,(/ 3 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)
|
||||
|
Loading…
Reference in New Issue
Block a user