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

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

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
+(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 ()
-  (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)))))

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)))
+    (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) (1- (length (speedrun-splits speedrun))))
-    (if (equal (speedrun-current-split-index speedrun) (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))))

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)))
+           (speedrun (make-speedrun category))
-      (croatoan:event-case (scr event)
+           (csplits (category-splits category)))
-        (#\q (return-from croatoan:event-case))
+      (flet ((render () 
-        (#\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)
+                      (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)))
+                  (if (member 'timer-instance redraws)
-               (croatoan:refresh timer-instance))))
+                      (croatoan:clear scr))
-         (setf redraws '())
+                  (if (zerop (mod frame 4)) 
-         (sleep (/ 1 30)))))))
+                      (let* ((screen-thirds (floor (/ (croatoan:width scr) 3)))
-
+                             (split-list (make-instance 'highlight-list
-
+                                                        :scroll-i scroll 
-;;    (setq hl (make-instance 'highlight-list
+                                                        :current-element-index (if (eq (speedrun-state speedrun) 'STOPPED) (1- (length (speedrun-splits speedrun))) (speedrun-current-split-index speedrun))
-;;                            :scroll-i 0
+                                                        :height (croatoan:height scr)
-;;                            :elements `(
+                                                        :width screen-thirds
-;;                                        (("HELLO" . ,(/ 1 2)) ("" . ,(/ 1 2)))
+                                                        :elements (mapcar #'category-split-name csplits)))
-;;                                        (("THIS IS A TEST" . ,(/ 1 2)) (" OF WRAPPING TRUNCATION" . ,(/ 1 2)))
+;;                                                        :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)))
-;;                            :current-element-index current-index
+                             (timer-instance (timer-window speedrun `(0 ,screen-thirds) (* 2 screen-thirds) 8)))
-;;                            :height 6
+                        (croatoan:refresh splits-instance)
-;;                            :width 20))
+                        (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)))))))