Add simple cli for interfacing with program (not fully functional); show splits
This commit is contained in:
Logan Hunt
parent
ffa83bc8b0
commit
d4e9417c32
GPG Key ID:
52B3774857EB24B1
@ -76,7 +76,7 @@
|
||||
|
||||
;; Driver that takes the config and inserts the category and its
|
||||
;; splits into the db, obviously requires a mito toplevel connection
|
||||
(defun import-config (file-path)
|
||||
(defun import-category (file-path)
|
||||
(let*
|
||||
((config-sections (sections (read-lines file-path)))
|
||||
(category (mito:insert-dao (create-category-object (get-section "category" config-sections))))
|
||||
|
||||
59
main.lisp
59
main.lisp
@ -1,17 +1,54 @@
|
||||
;; Migrate database structure
|
||||
(mito:connect-toplevel :sqlite3 :database-name #P"timer.db")
|
||||
(setq mito:*auto-migration-mode* t)
|
||||
(load "database/category.lisp")
|
||||
(load "database/run.lisp")
|
||||
|
||||
;; Define command line arguments
|
||||
(opts:define-opts
|
||||
(:name :import
|
||||
:description "create splits and category from a config file"
|
||||
:short #\i
|
||||
:long "import"
|
||||
:arg-parser #'identity))
|
||||
(defun get-input (prompt validation)
|
||||
(clear-input)
|
||||
(write-string prompt)
|
||||
(finish-output)
|
||||
(let ((input (read-line)))
|
||||
(if (ignore-errors (funcall validation input))
|
||||
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 ()
|
||||
(let ((options (opts:get-opts)))
|
||||
(when-option (options :import)
|
||||
(import-config (getf options :import)))
|
||||
(run-ui (car (mito:select-dao 'category)))))
|
||||
(mapcar #'(lambda (x) (format t "~a~%" x)) *lispruns-logo*)
|
||||
(let ((choice (get-option '(("Help" . HELP)
|
||||
("Import a category" . IMPORT-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)))))
|
||||
|
||||
@ -52,16 +52,21 @@
|
||||
(speedrun-start-timestamp speedrun) (get-internal-real-time)
|
||||
(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.
|
||||
;; Or, set the current split to the next one in the list.
|
||||
(defun next-split (speedrun)
|
||||
(let ((now (local-time:now)))
|
||||
(unless (equal (speedrun-state speedrun) 'STOPPED)
|
||||
(setf (run-split-end-time (current-split speedrun)) now)
|
||||
(inc (speedrun-current-split-index speedrun))
|
||||
(if (equal (speedrun-current-split-index speedrun) (length (speedrun-splits speedrun)))
|
||||
(if (equal (speedrun-current-split-index speedrun) (1- (length (speedrun-splits speedrun))))
|
||||
(progn
|
||||
(setf (speedrun-state speedrun) 'STOPPED)
|
||||
(setf (run-split-start-time (current-split speedrun)) now))))
|
||||
(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))))
|
||||
|
||||
67
ui.lisp
67
ui.lisp
@ -90,25 +90,20 @@
|
||||
(subseq elements (car elements-to-draw-subseq) (cadr elements-to-draw-subseq))))
|
||||
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)
|
||||
(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))
|
||||
(speedrun (make-speedrun category)))
|
||||
(croatoan:event-case (scr event)
|
||||
(#\q (return-from croatoan:event-case))
|
||||
(#\space
|
||||
(case state
|
||||
('TITLE
|
||||
(start-speedrun speedrun)
|
||||
(setf state 'RUNNING))
|
||||
('RUNNING (next-split speedrun))))
|
||||
(:resize nil)
|
||||
((nil)
|
||||
(speedrun (make-speedrun category))
|
||||
(csplits (category-splits category)))
|
||||
(flet ((render ()
|
||||
(case state
|
||||
('TITLE
|
||||
(if (member 'title-instance redraws)
|
||||
(croatoan:clear scr)
|
||||
(let* ((padding 3)
|
||||
(width (+ (* 2 padding) (max-length *lispruns-logo*)))
|
||||
(height (+ (* 2 padding) (length *lispruns-logo*)))
|
||||
@ -118,18 +113,34 @@
|
||||
(croatoan:refresh logo-box))))
|
||||
('RUNNING
|
||||
(update-time speedrun)
|
||||
(let ((timer-instance (timer-window speedrun '(10 10) 70 10)))
|
||||
(croatoan:refresh timer-instance))))
|
||||
(setf redraws '())
|
||||
(sleep (/ 1 30)))))))
|
||||
|
||||
|
||||
;; (setq hl (make-instance 'highlight-list
|
||||
;; :scroll-i 0
|
||||
;; :elements `(
|
||||
;; (("HELLO" . ,(/ 1 2)) ("" . ,(/ 1 2)))
|
||||
;; (("THIS IS A TEST" . ,(/ 1 2)) (" OF WRAPPING TRUNCATION" . ,(/ 1 2)))
|
||||
;; )
|
||||
;; :current-element-index current-index
|
||||
;; :height 6
|
||||
;; :width 20))
|
||||
(if (member 'timer-instance redraws)
|
||||
(croatoan:clear scr))
|
||||
(if (zerop (mod frame 4))
|
||||
(let* ((screen-thirds (floor (/ (croatoan:width scr) 3)))
|
||||
(split-list (make-instance 'highlight-list
|
||||
:scroll-i scroll
|
||||
:current-element-index (if (eq (speedrun-state speedrun) 'STOPPED) (1- (length (speedrun-splits speedrun))) (speedrun-current-split-index speedrun))
|
||||
:height (croatoan:height scr)
|
||||
:width screen-thirds
|
||||
:elements (mapcar #'category-split-name csplits)))
|
||||
;; :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)))
|
||||
(croatoan:refresh splits-instance)
|
||||
(croatoan:refresh timer-instance)))))
|
||||
(setf redraws '()
|
||||
frame (mod (1+ frame) 60))
|
||||
(if (zerop (mod frame 30))
|
||||
(inc scroll))
|
||||
(sleep (/ 1 60))))
|
||||
(croatoan:event-case (scr event)
|
||||
(#\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)))))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user