diff --git a/config.lisp b/config.lisp index 96bff4d..bdb11ca 100644 --- a/config.lisp +++ b/config.lisp @@ -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)))) diff --git a/main.lisp b/main.lisp index a15daca..6e89cd0 100644 --- a/main.lisp +++ b/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))))) diff --git a/speedrun.lisp b/speedrun.lisp index b78f75d..df473c9 100644 --- a/speedrun.lisp +++ b/speedrun.lisp @@ -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))) - (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))) - (setf (speedrun-state speedrun) 'STOPPED) - (setf (run-split-start-time (current-split speedrun)) now)))) + (unless (equal (speedrun-state speedrun) 'STOPPED) + (setf (run-split-end-time (current-split speedrun)) now) + (if (equal (speedrun-current-split-index speedrun) (1- (length (speedrun-splits speedrun)))) + (progn + (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)))) diff --git a/ui.lisp b/ui.lisp index 1e20091..56261b6 100644 --- a/ui.lisp +++ b/ui.lisp @@ -90,46 +90,57 @@ (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) - (case state - ('TITLE - (if (member 'title-instance redraws) - (let* ((padding 3) - (width (+ (* 2 padding) (max-length *lispruns-logo*))) - (height (+ (* 2 padding) (length *lispruns-logo*))) - (logo-centered (center-box scr width height)) - (logo-box (make-instance 'croatoan:window :border t :width width :height height :position logo-centered))) - (write-horizontal-slice-list logo-box `(,padding ,padding) *lispruns-logo*) - (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)) + (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*))) + (logo-centered (center-box scr width height)) + (logo-box (make-instance 'croatoan:window :border t :width width :height height :position logo-centered))) + (write-horizontal-slice-list logo-box `(,padding ,padding) *lispruns-logo*) + (croatoan:refresh logo-box)))) + ('RUNNING + (update-time speedrun) + (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)))))))