Write code into systems and add formatting for highlight lists

7 files changed, 115 insertions, 81 deletions

diff --git a/config.lisp b/config.lisp
index 4fb5bc0..96bff4d 100644
--- a/config.lisp
+++ b/config.lisp
@@ -61,7 +61,6 @@
                    :name (get-property category-section "name")
                    :percentage (get-property category-section "percentage")))
 
-
 ;; Creates the splits
 (defun create-category-split-objects (category splits-section &optional (splits '()))
   (if (not splits-section)
diff --git a/lispruns.asd b/lispruns.asd
new file mode 100644
index 0000000..ef870b7
--- /dev/null
+++ b/lispruns.asd
@@ -0,0 +1,25 @@
+(asdf:defsystem "lispruns"
+    :description "A speedrun timer using n-curses written in lisp"
+    :version "0.1"
+    :author "Simponic"
+    :depends-on (:unix-opts
+                 :mito
+                 :sxql
+                 :cl-ppcre
+                 :croatoan
+                 :local-time)
+    :components ((:file "util") ;; Miscellaneous helpers
+                 (:file "config") ;; For importing category configuration files
+                 (:file "digits") ;; Lisp file with cool ascii digits
+                 (:file "text" :depends-on ("digits")) ;; Helper functions for performing figlet-like actions and such
+                 (:file "time") ;; Custom time forms
+                 (:file "ui" :depends-on ("util" "text" "time")) ;; Functions to draw the UI
+                 (:file "speedrun" :depends-on ("util")) ;; The actual timer logic
+                 (:file "database/category") ;; Category DAO
+                 (:file "database/run") ;; Run DAO
+                 (:file "main" :depends-on ("util"
+                                            "config"
+                                            "ui"
+                                            "speedrun"
+                                            "database/category"
+                                            "database/run"))))
diff --git a/main.lisp b/main.lisp
index 5efd61e..1404b25 100644
--- a/main.lisp
+++ b/main.lisp
@@ -1,22 +1,6 @@
-(ql:quickload '(unix-opts mito cl-ppcre croatoan local-time))
-
 ;; 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")
-
-;; Utils
-(load "util.lisp")
-
-;; Config file importing
-(load "config.lisp")
-
-;; Load the UI
-(load "ui.lisp")
-
-;; The timing logic
-(load "speedrun.lisp")
 
 ;; Define command line arguments
 (opts:define-opts
@@ -26,10 +10,6 @@
    :long "import"
    :arg-parser #'identity))
 
-(defmacro when-option ((options opt) &body body)
-  `(let ((it (getf ,options ,opt)))
-     (when it
-       ,@body)))
 (defun main ()
   (let ((options (opts:get-opts)))
     (when-option (options :import)
diff --git a/text.lisp b/text.lisp
new file mode 100644
index 0000000..80b5267
--- /dev/null
+++ b/text.lisp
@@ -0,0 +1,53 @@
+;; Pads string 's' on the right by 'width'
+(defun pad-right-string (s width)
+  (format nil (concatenate 'string "~" (write-to-string width) "a") s))
+
+;; Wraps text and adds a hypen if it doesn't fit within (1- width), scrolling
+;; by index i
+(defun maybe-wrap-text (text width i)
+  (let ((textlen (length text)))
+    (if (>= width textlen)
+        text
+        (let* ((max-width (1- width))
+               (max-wrap (1+ (- textlen max-width)))
+               (wrap-i (rem i max-wrap)))
+          (concatenate 'string (subseq text wrap-i (+ wrap-i (min max-width textlen))) "-")))))
+
+;; line is an alist containing the string as the first element and the
+;; fraction of the maximum width "max-width" the whole line should take up (these should
+;; add up to 1)
+;; scroll-i is the index the string is truncated to with a hyphen (see maybe-wrap-text)
+;; ex. (format-line `(("Hello, world" . ,(/ 2 5))
+;;                    ("" . ,(/ 1 5))
+;;                    ("Hello, again" . ,(/ 2 5)))
+;;                  20 2)
+;; -> "llo, wo-    llo, ag-"
+(defun format-line (line max-width &optional (scroll-i 0) (formatted ""))
+  (if (eq line nil)
+      formatted
+      (if (listp line)
+          (let* ((curr (car line))
+                 (text-width (floor (* max-width (cdr curr))))
+                 (wrapped-string (maybe-wrap-text (car curr) text-width scroll-i))
+                 (current-string (pad-right-string wrapped-string text-width)))
+            (format-line (cdr line) max-width scroll-i (concatenate 'string formatted current-string)))
+          (pad-right-string (maybe-wrap-text line max-width scroll-i) max-width))))
+
+;; Add a list of strings representing horizontal slices of a character to another list of strings representing horizontal slices of a string, or create a new list of horizontal slices if the original was empty.
+;; Character height will be truncated to the height of the first character in the slices.
+(defun add-to-horizontal (character horizontal-layers &key (seperator " "))
+  (let ((layer-height (length horizontal-layers)))
+    (loop for i from 0 to (1- (if (zerop layer-height) (length character) layer-height))
+          collect
+          (let ((layer (nth i horizontal-layers))
+                (character-slice (nth i character)))
+            (if (and layer (> (length layer) 0))
+                (concatenate 'string layer seperator character-slice)
+              character-slice)))))
+
+;; Creates a list of horizontal slices to display a formatted larger string by using figlet characters
+(defun lispglet (str &optional (char-hashes *big-digits*))
+  (loop for horizontal-layers = '()
+        then (add-to-horizontal (gethash c char-hashes) horizontal-layers)
+        for c across str
+        finally (return horizontal-layers)))
diff --git a/time.lisp b/time.lisp
new file mode 100644
index 0000000..3d0f2bb
--- /dev/null
+++ b/time.lisp
@@ -0,0 +1,18 @@
+;; Makes a-list with '((hours . HOURS) (minutes . MINUTES) (seconds . SECONDS) (ms . MILLISECONDS))
+(defun make-time-alist (ms)
+  `((hours    . ,(floor (/ ms (* 1000 60 60))))
+	   (minutes . ,(floor (mod (/ ms (* 1000 60)) 60)))
+	   (seconds . ,(floor (mod (/ ms 1000) 60)))
+	   (ms      . ,(mod ms 1000))))
+
+;; Formats, disregarding min/hour if they shouldn't be shown, a time alist to "H:M:S.ms"
+(defun format-time (time-alist)
+  (let
+      ((hours (cdr (assoc 'hours time-alist)))
+       (minutes (cdr (assoc 'minutes time-alist)))
+       (seconds (cdr (assoc 'seconds time-alist)))
+       (centis (round (/ (cdr (assoc 'ms time-alist)) 10))))
+    (concatenate 'string
+                 (unless (zerop hours) (format nil "~2,'0d:" hours))
+                 (unless (and (zerop minutes) (zerop hours)) (format nil "~2,'0d:" minutes))
+                 (format nil "~2,'0d.~2,'0d" seconds centis))))
diff --git a/ui.lisp b/ui.lisp
index a4ffb44..b6e87a5 100644
--- a/ui.lisp
+++ b/ui.lisp
@@ -61,7 +61,7 @@
          (elements (highlight-list-elements hl))
          (current-element-index (highlight-list-current-element-index hl))
          (elements-to-draw-subseq (if (>= height (length elements))
-                                      (list 0 (1- (length elements)))
+                                      (list 0 (length elements))
                                       (cond
                                         ((> height (1+ current-element-index))
                                          (list 0 height))
@@ -81,7 +81,9 @@
                          (cdr (assoc 'selected-highlight *colors*))
                          (cdr (assoc 'unselected-highlight *colors*))))
                (inc yi)
-               (croatoan:add highlight-menu el :position `(,yi 1)))
+               (croatoan:add highlight-menu
+                             (format-line el width (highlight-list-scroll-i hl))
+                             :position `(,yi 1)))
              (subseq elements (car elements-to-draw-subseq) (cadr elements-to-draw-subseq))))
    highlight-menu))
          
@@ -98,11 +100,14 @@
                          (#\b
                           (let ((hl (make-instance 'highlight-list
                                                    :scroll-i 0
-                                                   :elements '("HELLO" "WORLD" "MY" "NAME" "IS" "LOGAN" "HUNT" "AND" "I" "LIKE" "PIZZA")
+                                                   :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 10)))
-                            (push (highlight-list-window hl '(20 20)) windows))
+                                                   :width 20)))
+                            (push (highlight-list-window hl '(10 20)) windows))
                           (push (figlet-window *lispruns-logo* scr '(2 2)) windows)
                           (inc current-index))
                          (#\q (return-from croatoan:event-case))
@@ -110,4 +115,5 @@
                          (:resize nil)
                          ((nil)
                           (mapcar #'croatoan:refresh (cons scr windows))
+                          (inc current-scroll-index 0.02)
                           (sleep (/ 1 60))))))
diff --git a/util.lisp b/util.lisp
index 805e0bc..584f442 100644
--- a/util.lisp
+++ b/util.lisp
@@ -1,55 +1,8 @@
-;; For big ascii-art digits
-(load "digits.lisp")
-
-(defmacro inc (x)
-  `(setf ,x (1+ ,x)))
-
-;; Wraps text and adds ellipsis if it doesn't fit within width, scrolling
-;; by index i
-(defun maybe-wrap-text (text width i)
-  (let ((textlen (length text)))
-    (if (>= width textlen)
-        text
-        (let* ((max-width (1- width))
-               (max-wrap (1+ (- textlen max-width)))
-               (wrap-i (rem i max-wrap)))
-          (concatenate 'string (subseq text wrap-i (+ wrap-i (min max-width textlen))) "-")))))
-
-;; Makes a-list with '((hours . HOURS) (minutes . MINUTES) (seconds . SECONDS) (ms . MILLISECONDS))
-(defun make-time-alist (ms)
-  `((hours    . ,(floor (/ ms (* 1000 60 60))))
-	   (minutes . ,(floor (mod (/ ms (* 1000 60)) 60)))
-	   (seconds . ,(floor (mod (/ ms 1000) 60)))
-	   (ms      . ,(mod ms 1000))))
-
-
-;; Add a list of strings representing horizontal slices of a character to another list of strings representing horizontal slices of a string, or create a new list of horizontal slices if the original was empty.
-;; Character height will be truncated to the height of the first character in the slices.
-(defun add-to-horizontal (character horizontal-layers &key (seperator " "))
-  (let ((layer-height (length horizontal-layers)))
-    (loop for i from 0 to (1- (if (zerop layer-height) (length character) layer-height))
-          collect
-          (let ((layer (nth i horizontal-layers))
-                (character-slice (nth i character)))
-            (if (and layer (> (length layer) 0))
-                (concatenate 'string layer seperator character-slice)
-              character-slice)))))
-
-;; Formats, disregarding min/hour if they shouldn't be shown, a time alist to "H:M:S.ms"
-(defun format-time (time-alist)
-  (let
-      ((hours (cdr (assoc 'hours time-alist)))
-       (minutes (cdr (assoc 'minutes time-alist)))
-       (seconds (cdr (assoc 'seconds time-alist)))
-       (centis (round (/ (cdr (assoc 'ms time-alist)) 10))))
-    (concatenate 'string
-                 (unless (zerop hours) (format nil "~2,'0d:" hours))
-                 (unless (and (zerop minutes) (zerop hours)) (format nil "~2,'0d:" minutes))
-                 (format nil "~2,'0d.~2,'0d" seconds centis))))
-
-;; Creates a list of horizontal slices to display a formatted larger string by using figlet characters
-(defun lispglet (str &optional (char-hashes *big-digits*))
-  (loop for horizontal-layers = '()
-        then (add-to-horizontal (gethash c char-hashes) horizontal-layers)
-        for c across str
-        finally (return horizontal-layers)))
+(defmacro inc (x &optional (val 1))
+  `(setf ,x (+ ,val ,x)))
+
+;; For system arguments
+(defmacro when-option ((options opt) &body body)
+  `(let ((it (getf ,options ,opt)))
+     (when it
+       ,@body)))