summaryrefslogtreecommitdiff
path: root/ui.lisp
diff options
context:
space:
mode:
authorLogan Hunt <loganjh@amazon.com>2022-05-24 09:57:15 -0700
committerLogan Hunt <loganjh@amazon.com>2022-05-24 09:57:15 -0700
commit3db9a2eb7a7d14ce935f5902b0c21ce4fd5eb729 (patch)
treef618b9a6342b8d30c39454e9cf7b3cabefc04db4 /ui.lisp
downloadlispruns-3db9a2eb7a7d14ce935f5902b0c21ce4fd5eb729.tar.gz
lispruns-3db9a2eb7a7d14ce935f5902b0c21ce4fd5eb729.zip
None of the original commit messages would actually help anyone
Diffstat (limited to 'ui.lisp')
-rw-r--r--ui.lisp113
1 files changed, 113 insertions, 0 deletions
diff --git a/ui.lisp b/ui.lisp
new file mode 100644
index 0000000..a4ffb44
--- /dev/null
+++ b/ui.lisp
@@ -0,0 +1,113 @@
+(defparameter *lispruns-logo*
+ '("db d888888b .d8888. d8888b. d8888b. db db d8b db .d8888."
+ "88 `88' 88' YP 88 `8D 88 `8D 88 88 888o 88 88' YP"
+ "88 88 `8bo. 88oodD' 88oobY' 88 88 88V8o 88 `8bo. "
+ "88 88 `Y8b. 88~~~ 88`8b 88 88 88 V8o88 `Y8b."
+ "88booo. .88. db 8D 88 88 `88. 88b d88 88 V888 db 8D"
+ "Y88888P Y888888P `8888Y' 88 88 YD ~Y8888P' VP V8P `8888Y'"))
+
+(defparameter *colors*
+ '((main . (:green :black))
+ (figlet . (:black :white))
+ (selected-highlight . (:blue :black))
+ (unselected-highlight . (:white :black))))
+
+;; Returns (y, x) to draw box to center it in screen
+(defun center-box (screen width height)
+ (let ((sw (croatoan:width screen))
+ (sh (croatoan:height screen)))
+ (list (round (- (/ sh 2) (/ height 2))) (round (- (/ sw 2) (/ width 2))))))
+
+(defun write-horizontal-slice-list (scr pos slices)
+ (let ((yi (car pos)))
+ (mapcar (lambda (s)
+ (croatoan:add scr s :position `(,yi ,(cadr pos)))
+ (inc yi))
+ slices)))
+
+;; Draws a list of strings horizontally in a window with padding and an optional border
+(defun figlet-window (title-slices scr pos &key (padding 2) (border nil))
+ (let* ((width (+ (reduce (lambda (a x) (max a x)) (mapcar #'length title-slices)) (* 2 padding)))
+ (height (+ (length *lispruns-logo*) (* 2 padding)))
+ (title-box (make-instance 'croatoan:window
+ :border border
+ :width width
+ :height height
+ :position pos)))
+ (setf (croatoan:background title-box) (make-instance 'croatoan:complex-char :color-pair (cdr (assoc 'figlet *colors*))))
+ (write-horizontal-slice-list title-box `(,padding ,padding) title-slices)
+ title-box))
+
+(defclass highlight-list ()
+ ((scroll-i
+ :initarg :scroll-i
+ :accessor highlight-list-scroll-i)
+ (elements
+ :initarg :elements
+ :accessor highlight-list-elements)
+ (current-element-index
+ :initarg :current-element-index
+ :accessor highlight-list-current-element-index)
+ (height
+ :initarg :height
+ :accessor highlight-list-height)
+ (width
+ :initarg :width
+ :accessor highlight-list-width)))
+
+(defun highlight-list-window (hl pos)
+ (let* ((width (- (highlight-list-width hl) 2))
+ (height (- (highlight-list-height hl) 2))
+ (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)))
+ (cond
+ ((> height (1+ current-element-index))
+ (list 0 height))
+ ((< (- (length elements) height) current-element-index)
+ (list (- (length elements) height) (length elements)))
+ (t (let ((dy (/ (1- height) 2)))
+ (list (- current-element-index (floor dy)) (1+ (+ current-element-index (ceiling dy)))))))))
+ (highlight-menu (make-instance 'croatoan:window
+ :border t
+ :width (+ 2 width)
+ :height (+ 2 height)
+ :position pos)))
+ (let ((yi 0))
+ (mapcar (lambda (el)
+ (setf (croatoan:color-pair highlight-menu)
+ (if (equal (+ yi (car elements-to-draw-subseq)) current-element-index)
+ (cdr (assoc 'selected-highlight *colors*))
+ (cdr (assoc 'unselected-highlight *colors*))))
+ (inc yi)
+ (croatoan:add highlight-menu el :position `(,yi 1)))
+ (subseq elements (car elements-to-draw-subseq) (cadr elements-to-draw-subseq))))
+ highlight-menu))
+
+(defun run-ui ()
+ (croatoan:with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil :enable-colors t :input-buffering nil :input-blocking nil)
+ (croatoan:clear scr)
+ (croatoan:refresh scr)
+ (setf (croatoan:background scr) (make-instance 'croatoan:complex-char :color-pair (cdr (assoc 'main *colors*))))
+ (croatoan:draw-border scr)
+
+ (defvar windows '())
+ (defvar current-index 0)
+ (croatoan:event-case (scr event)
+ (#\b
+ (let ((hl (make-instance 'highlight-list
+ :scroll-i 0
+ :elements '("HELLO" "WORLD" "MY" "NAME" "IS" "LOGAN" "HUNT" "AND" "I" "LIKE" "PIZZA")
+ :current-element-index current-index
+ :height 6
+ :width 10)))
+ (push (highlight-list-window hl '(20 20)) windows))
+ (push (figlet-window *lispruns-logo* scr '(2 2)) windows)
+ (inc current-index))
+ (#\q (return-from croatoan:event-case))
+ (#\c (croatoan:clear scr))
+ (:resize nil)
+ ((nil)
+ (mapcar #'croatoan:refresh (cons scr windows))
+ (sleep (/ 1 60))))))