simponic/speedrun-timer
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Write code into systems and add formatting for highlight lists

Browse Source
This commit is contained in:
Logan Hunt 2022-05-24 16:22:00 -07:00
parent 3db9a2eb7a
commit 47b6bdf8b7
7 changed files with 114 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
config.lisp
View File

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

25
lispruns.asd Normal file
View File

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

20
main.lisp
View File

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

53
text.lisp Normal file
View File

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

18
time.lisp Normal file
View File

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

16
ui.lisp
View File

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

61
util.lisp
View File

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