# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1618777704 14400
# Node ID 41f2c758451f7fa116a500ee23abd147ab5f074f
# Parent  e953b1af4b62172931c7713a6650f752fc9eec80
More stuff, sketch out a starting ui

diff -r e953b1af4b62 -r 41f2c758451f assets/journal.txt
--- /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.
diff -r e953b1af4b62 -r 41f2c758451f assets/splash.txt
--- /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.
diff -r e953b1af4b62 -r 41f2c758451f scratch.lisp
--- /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")))
diff -r e953b1af4b62 -r 41f2c758451f src/main.lisp
--- 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)