From 47b6bdf8b737bf12f5f7b8839ed2389ff28c723c Mon Sep 17 00:00:00 2001 From: Logan Hunt Date: Tue, 24 May 2022 16:22:00 -0700 Subject: [PATCH] Write code into systems and add formatting for highlight lists --- config.lisp | 1 - lispruns.asd | 25 +++++++++++++++++++++ main.lisp | 20 ----------------- text.lisp | 53 +++++++++++++++++++++++++++++++++++++++++++++ time.lisp | 18 ++++++++++++++++ ui.lisp | 16 +++++++++----- util.lisp | 61 ++++++---------------------------------------------- 7 files changed, 114 insertions(+), 80 deletions(-) create mode 100644 lispruns.asd create mode 100644 text.lisp create mode 100644 time.lisp 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 &optional (val 1)) + `(setf ,x (+ ,val ,x))) -(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))) +;; For system arguments +(defmacro when-option ((options opt) &body body) + `(let ((it (getf ,options ,opt))) + (when it + ,@body)))