simponic/speedrun-timer
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added more CLI options

Browse Source
This commit is contained in:
Logan Hunt 2022-06-04 13:09:39 -07:00
parent f272429796
commit 6dadca7796
Signed by untrusted user who does not match committer: simponic
GPG Key ID: 52B3774857EB24B1
7 changed files with 123 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
config.lisp
View File

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

41
database/run.lisp
View File

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

3
lispruns.asd
View File

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

80
main.lisp
View File

@ -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
speedrun.lisp
View File

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

35
ui.lisp
View File

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

2
util.lisp
View File

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