Add simple cli for interfacing with program (not fully functional); show splits

This commit is contained in:
Logan Hunt 2022-05-30 22:45:29 -07:00
parent ffa83bc8b0
commit d4e9417c32
Signed by untrusted user who does not match committer: simponic
GPG Key ID: 52B3774857EB24B1
4 changed files with 113 additions and 60 deletions

View File

@ -76,7 +76,7 @@
;; Driver that takes the config and inserts the category and its ;; Driver that takes the config and inserts the category and its
;; splits into the db, obviously requires a mito toplevel connection ;; splits into the db, obviously requires a mito toplevel connection
(defun import-config (file-path) (defun import-category (file-path)
(let* (let*
((config-sections (sections (read-lines file-path))) ((config-sections (sections (read-lines file-path)))
(category (mito:insert-dao (create-category-object (get-section "category" config-sections)))) (category (mito:insert-dao (create-category-object (get-section "category" config-sections))))

View File

@ -1,17 +1,54 @@
;; Migrate database structure ;; Migrate database structure
(mito:connect-toplevel :sqlite3 :database-name #P"timer.db") (mito:connect-toplevel :sqlite3 :database-name #P"timer.db")
(setq mito:*auto-migration-mode* t) (setq mito:*auto-migration-mode* t)
(load "database/category.lisp")
(load "database/run.lisp")
;; Define command line arguments (defun get-input (prompt validation)
(opts:define-opts (clear-input)
(:name :import (write-string prompt)
:description "create splits and category from a config file" (finish-output)
:short #\i (let ((input (read-line)))
:long "import" (if (ignore-errors (funcall validation input))
:arg-parser #'identity)) input
(get-input prompt validation))))
;; Options is an alist with the prompt string as the car and the value as the cdr
(defun get-option (options)
(let ((i 0))
(loop for x in options
do
(inc i)
(format t " [~a] ~a~%" i (car x))))
(cdr (nth (1- (parse-integer (get-input
(format nil "[~a - ~a]: " 1 (length options)) (lambda (x) (let ((user-integer (parse-integer x)))
(and
(>= user-integer 1)
(<= user-integer (length options))))))))
options)))
(defun main () (defun main ()
(let ((options (opts:get-opts))) (mapcar #'(lambda (x) (format t "~a~%" x)) *lispruns-logo*)
(when-option (options :import) (let ((choice (get-option '(("Help" . HELP)
(import-config (getf options :import))) ("Import a category" . IMPORT-CATEGORY)
(run-ui (car (mito:select-dao 'category))))) ("Make a new category" . NEW-CATEGORY)
("Start a speedrun" . START-SPEEDRUN)
("Statistics" . LIST-CATEGORIES)
("Exit" . EXIT)))))
(case choice
('IMPORT-CATEGORY
(import-category (get-input (format nil "Relative or absolute path to configuration file [~a]: " (uiop/os:getcwd)) 'probe-file)))
('NEW-CATEGORY
(format t "NEW CATEGORY~%"))
('START-SPEEDRUN
(speedrun-ui (car (mito:select-dao 'category))))
('EXIT
(quit))))
(format t "~%")
(main))
;; (let ((options (opts:get-opts)))
;; (when-option (options :import)
;; (import-config (getf options :import)))
;; (run-ui (car (mito:select-dao 'category)))))

View File

@ -52,16 +52,21 @@
(speedrun-start-timestamp speedrun) (get-internal-real-time) (speedrun-start-timestamp speedrun) (get-internal-real-time)
(run-split-start-time (current-split speedrun)) (local-time:now))) (run-split-start-time (current-split speedrun)) (local-time:now)))
;; Saves the speedrun into the database
(defun save-speedrun (speedrun)
(mapcar #'mito:save-dao (cons (speedrun-run-dao speedrun) (speedrun-splits speedrun))))
;; Set the state of the speedrun to be stopped if there are no more splits. ;; Set the state of the speedrun to be stopped if there are no more splits.
;; Or, set the current split to the next one in the list. ;; Or, set the current split to the next one in the list.
(defun next-split (speedrun) (defun next-split (speedrun)
(let ((now (local-time:now))) (let ((now (local-time:now)))
(setf (run-split-end-time (current-split speedrun)) now) (unless (equal (speedrun-state speedrun) 'STOPPED)
(inc (speedrun-current-split-index speedrun)) (setf (run-split-end-time (current-split speedrun)) now)
(if (equal (speedrun-current-split-index speedrun) (length (speedrun-splits speedrun))) (if (equal (speedrun-current-split-index speedrun) (1- (length (speedrun-splits speedrun))))
(setf (speedrun-state speedrun) 'STOPPED) (progn
(setf (run-split-start-time (current-split speedrun)) now)))) (setf (speedrun-state speedrun) 'STOPPED)
(save-speedrun speedrun))
(progn
(inc (speedrun-current-split-index speedrun))
(setf (run-split-start-time (current-split speedrun)) now))))))
;; Saves the speedrun into the database
(defun save-speedrun (speedrun)
(mapcar #'mito:save-dao (cons (speedrun-run-dao speedrun) (speedrun-splits speedrun))))

91
ui.lisp
View File

@ -90,46 +90,57 @@
(subseq elements (car elements-to-draw-subseq) (cadr elements-to-draw-subseq)))) (subseq elements (car elements-to-draw-subseq) (cadr elements-to-draw-subseq))))
highlight-menu)) highlight-menu))
(defun run-ui (category) (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) (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*)))) (setf (croatoan:background scr) (make-instance 'croatoan:complex-char :color-pair (cdr (assoc 'main *colors*))))
(let* ((state 'TITLE) (let* ((scroll 0)
(frame 0)
(state 'TITLE)
(redraws '(title-instance)) (redraws '(title-instance))
(speedrun (make-speedrun category))) (speedrun (make-speedrun category))
(croatoan:event-case (scr event) (csplits (category-splits category)))
(#\q (return-from croatoan:event-case)) (flet ((render ()
(#\space (case state
(case state ('TITLE
('TITLE (if (member 'title-instance redraws)
(start-speedrun speedrun) (croatoan:clear scr)
(setf state 'RUNNING)) (let* ((padding 3)
('RUNNING (next-split speedrun)))) (width (+ (* 2 padding) (max-length *lispruns-logo*)))
(:resize nil) (height (+ (* 2 padding) (length *lispruns-logo*)))
((nil) (logo-centered (center-box scr width height))
(case state (logo-box (make-instance 'croatoan:window :border t :width width :height height :position logo-centered)))
('TITLE (write-horizontal-slice-list logo-box `(,padding ,padding) *lispruns-logo*)
(if (member 'title-instance redraws) (croatoan:refresh logo-box))))
(let* ((padding 3) ('RUNNING
(width (+ (* 2 padding) (max-length *lispruns-logo*))) (update-time speedrun)
(height (+ (* 2 padding) (length *lispruns-logo*))) (if (member 'timer-instance redraws)
(logo-centered (center-box scr width height)) (croatoan:clear scr))
(logo-box (make-instance 'croatoan:window :border t :width width :height height :position logo-centered))) (if (zerop (mod frame 4))
(write-horizontal-slice-list logo-box `(,padding ,padding) *lispruns-logo*) (let* ((screen-thirds (floor (/ (croatoan:width scr) 3)))
(croatoan:refresh logo-box)))) (split-list (make-instance 'highlight-list
('RUNNING :scroll-i scroll
(update-time speedrun) :current-element-index (if (eq (speedrun-state speedrun) 'STOPPED) (1- (length (speedrun-splits speedrun))) (speedrun-current-split-index speedrun))
(let ((timer-instance (timer-window speedrun '(10 10) 70 10))) :height (croatoan:height scr)
(croatoan:refresh timer-instance)))) :width screen-thirds
(setf redraws '()) :elements (mapcar #'category-split-name csplits)))
(sleep (/ 1 30))))))) ;; :elements `((("FIRST SPLIT IS EPIC" . ,(/ 4 12)) ("" . ,(/ 1 12)) ("10:10:00.22" . ,(/ 3 12)) ("" . ,(/ 1 12)) ("20:00.00" . ,(/ 3 12))))))
(splits-instance (highlight-list-window split-list '(0 0)))
(timer-instance (timer-window speedrun `(0 ,screen-thirds) (* 2 screen-thirds) 8)))
;; (setq hl (make-instance 'highlight-list (croatoan:refresh splits-instance)
;; :scroll-i 0 (croatoan:refresh timer-instance)))))
;; :elements `( (setf redraws '()
;; (("HELLO" . ,(/ 1 2)) ("" . ,(/ 1 2))) frame (mod (1+ frame) 60))
;; (("THIS IS A TEST" . ,(/ 1 2)) (" OF WRAPPING TRUNCATION" . ,(/ 1 2))) (if (zerop (mod frame 30))
;; ) (inc scroll))
;; :current-element-index current-index (sleep (/ 1 60))))
;; :height 6 (croatoan:event-case (scr event)
;; :width 20)) (#\q (return-from croatoan:event-case))
(#\space
(case state
('TITLE
(start-speedrun speedrun)
(setf redraws '(timer-instance))
(setf state 'RUNNING))
('RUNNING (next-split speedrun))))
(:resize (render))
((nil) (render)))))))