More stuff, sketch out a starting ui
author |
Steve Losh <steve@stevelosh.com> |
date |
Sun, 18 Apr 2021 16:28:24 -0400 |
parents |
e953b1af4b62
|
children |
05bd74b8d9c4
|
branches/tags |
(none) |
files |
assets/journal.txt assets/splash.txt scratch.lisp src/main.lisp |
Changes
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/assets/journal.txt Sun Apr 18 16:28:24 2021 -0400
@@ -0,0 +1,2 @@
+September 22, 1987
+Finally got access to a computer terminal.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/assets/splash.txt Sun Apr 18 16:28:24 2021 -0400
@@ -0,0 +1,5 @@
+TODO: title
+by Steve Losh
+for the Lisp Game Jam, Spring 2021
+
+Press any key to start.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/scratch.lisp Sun Apr 18 16:28:24 2021 -0400
@@ -0,0 +1,5 @@
+(ql:quickload :bordeaux-threads)
+
+(bt:interrupt-thread
+ (first (remove "main thread" (bt:all-threads) :key #'bt:thread-name :test-not #'string=))
+ (lambda () (error "stop")))
--- a/src/main.lisp Sun Apr 18 14:03:33 2021 -0400
+++ b/src/main.lisp Sun Apr 18 16:28:24 2021 -0400
@@ -1,34 +1,85 @@
(in-package :dark)
+;;;; Global -------------------------------------------------------------------
+(defconstant +black+ (boots:rgb 0 0 0))
+(defconstant +white+ (boots:rgb 255 255 255))
+(defconstant +amber+ (boots:rgb #xFB #x7D #x01))
+(defconstant +default+ (boots:attr :fg +amber+ :bg +black+))
+(defconstant +reverse+ (boots:attr :fg +black+ :bg +amber+))
+
+(defvar *event* nil)
+(defvar *mods* nil)
+
+
+;;;; Assets -------------------------------------------------------------------
+(defparameter *asset/splash* (alexandria:read-file-into-string "assets/splash.txt"))
+(defparameter *asset/journal* (alexandria:read-file-into-string "assets/journal.txt"))
+
+
+;;;; Utils --------------------------------------------------------------------
(defun press-any-key ()
(boots:read-event)
(values))
-(defparameter *splash* (format nil "~
- TODO: title~@
- by Steve Losh ~@
- for the Lisp Game Jam, Spring 2021~@
- ~@
- Press any key to start."))
+(defmacro with-ui (ui &body body)
+ (alexandria:with-gensyms (prev)
+ `(let ((,prev (boots:root boots:*screen*)))
+ (setf (boots:root boots:*screen*) ,ui)
+ (unwind-protect (progn ,@body)
+ (setf (boots:root boots:*screen*) ,prev)))))
-(defmacro with-ui (ui &body body)
- `(unwind-protect (progn (setf (boots:root boots:*screen*) ,ui)
- ,@body)
- (setf (boots:root boots:*screen*) nil)))
+;;;; Splash -------------------------------------------------------------------
(defun draw/splash (pad)
- (boots:draw pad 0 0 *splash*))
+ (boots:draw pad 0 0 *asset/splash*))
(defun splash ()
- (with-ui (boots:make-canvas :width 50 :height 10 :border 1 :margin t :draw #'draw/splash)
+ (with-ui (boots:make-canvas :width 50 :height 10 :border t :margin t
+ :fill-attr +default+
+ :draw #'draw/splash)
(boots:redraw)
- (press-any-key)))
+ (press-any-key))
+ (journal))
+
+;;;; Journal ------------------------------------------------------------------
+(defun draw/journal (pad)
+ (boots:draw pad 0 0 *asset/journal* +default+))
+
+(defun journal ()
+ (with-ui (boots:make-canvas :border t :fill-attr +default+
+ :draw #'draw/journal)
+ (loop (boots:redraw)
+ (boots:event-case (boots:read-event-no-hang)
+ (#\esc (pause))))))
+;;;; Pause --------------------------------------------------------------------
+(defun draw/pause (pad)
+ (boots:draw pad 0 0 "Paused" +default+)
+ (boots:draw pad 0 2 "[R]esume" +reverse+)
+ (boots:draw pad 0 3 "[Q]uit" +default+))
+
+(defun pause ()
+ (with-ui (boots:make-canvas :width 30 :height 10 :border t :margin t
+ :fill-attr +default+
+ :draw #'draw/pause)
+ (loop (boots:redraw)
+ (multiple-value-bind (e m)
+ (boots:read-event-no-hang)
+ (boots:event-case (values e m)
+ ((#\r #\esc) (return-from pause))
+ (#\q (throw 'quit nil))
+ (t (setf *event* e *mods* m)))))))
+
+
+;;;; Main ---------------------------------------------------------------------
(defun run ()
(boots/terminals/ansi:with-ansi-terminal (terminal :truecolor t)
(boots:with-screen (boots:*screen* terminal)
(boots:with-light-borders
- (splash)))))
+ (let ((boots:*border-attr* +default+))
+ (catch 'quit
+ (splash)))))))
+
(defun toplevel ()
(sb-ext:disable-debugger)