--- a/.lispwords Sun Apr 18 17:40:08 2021 -0400
+++ b/.lispwords Tue Apr 20 15:13:04 2021 -0400
@@ -0,0 +1,3 @@
+(1 stack shelf pile)
+(2 canvas)
+(1 with-chiron-layer)
--- a/assets/journal.txt Sun Apr 18 17:40:08 2021 -0400
+++ b/assets/journal.txt Tue Apr 20 15:13:04 2021 -0400
@@ -1,2 +1,4 @@
September 22, 1987
Finally got access to a computer terminal.
+
+Cosmic Hyperspace Interferometer R Operations Network
--- a/dark.asd Sun Apr 18 17:40:08 2021 -0400
+++ b/dark.asd Tue Apr 20 15:13:04 2021 -0400
@@ -10,7 +10,9 @@
:depends-on (#+sbcl #:sb-sprof
:alexandria
:boots
+ :cl-pcg
:iterate
+ :local-time
:losh)
:serial t
--- a/scratch.lisp Sun Apr 18 17:40:08 2021 -0400
+++ b/scratch.lisp Tue Apr 20 15:13:04 2021 -0400
@@ -1,5 +1,29 @@
+(in-package :dark)
+
(ql:quickload :bordeaux-threads)
(bt:interrupt-thread
(first (remove "main thread" (bt:all-threads) :key #'bt:thread-name :test-not #'string=))
(lambda () (error "stop")))
+
+(ql:quickload :boots)
+
+
+(boots%::print-attr
+ (boots:attr :fg (boots:rgb 1 2 3)))
+
+
+
+
+
+
+
+
+abc
+len = 3
+wid = 10
+10 - 3 = 7
+
+0123456789
+
+
--- a/src/main.lisp Sun Apr 18 17:40:08 2021 -0400
+++ b/src/main.lisp Tue Apr 20 15:13:04 2021 -0400
@@ -11,6 +11,9 @@
(defvar *event* nil)
(defvar *mods* nil)
+(defvar *countdown* nil)
+(defvar *seed* nil)
+
;;;; Assets -------------------------------------------------------------------
(defparameter *asset/splash* (alexandria:read-file-into-string "assets/splash.txt"))
@@ -18,6 +21,11 @@
;;;; Utils --------------------------------------------------------------------
+(defparameter *pcg* (pcg:make-pcg))
+
+(defun random (bound &optional max inclusive?)
+ (pcg:pcg-random *pcg* bound max inclusive?))
+
(defun press-any-key ()
(boots:read-event)
(values))
@@ -37,6 +45,34 @@
(unwind-protect (progn ,@body)
(setf (boots:root boots:*screen*) ,prev)))))
+(defmacro event-case (form &body clauses)
+ (alexandria:with-gensyms (e m)
+ `(multiple-value-bind (,e ,m) ,form
+ (unless (handle-global-event ,e ,m)
+ (boots:event-case (values ,e ,m)
+ ,@clauses)))))
+
+(defun handle-global-event (event mods)
+ (boots:event-case (values event mods)
+ (#(:ctrl #\q) (throw 'quit nil))
+ (#\esc (pause) t)
+ (t nil)))
+
+(defun draw-right (pad x y string attr)
+ (boots:draw pad (1+ (- x (length string))) y string attr))
+
+
+(defvar *debug* (make-ring-buffer))
+
+(defun dbg (&optional string &rest args)
+ (if string
+ (rb-push *debug* (apply #'format nil string args))
+ (do-ring-buffer (s *debug*)
+ (write-line s)))
+ (values))
+
+
+
;;;; Splash -------------------------------------------------------------------
(defun draw/splash (pad)
(boots:draw pad 0 0 *asset/splash*))
@@ -44,23 +80,115 @@
(defun splash ()
(with-ooc-colors
(with-ui (boots:make-canvas :width 50 :height 10 :border t :margin t
+ :fill-char #\space
:fill-attr +default+
:draw #'draw/splash)
(boots:redraw)
(press-any-key)))
- (journal))
+ (chiron))
;;;; 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))))))
+
+;;;; Email --------------------------------------------------------------------
+(defun draw/email (pad)
+ (boots:draw pad 0 0 "this is ur email" +default+))
+
+
+
+;;;; Chiron -------------------------------------------------------------------
+(defun human-countdown ()
+ (nest
+ (multiple-value-bind (remaining) (truncate *countdown* internal-time-units-per-second))
+ (multiple-value-bind (days remaining) (truncate remaining (* 60 60 24)))
+ (multiple-value-bind (hours remaining) (truncate remaining (* 60 60)))
+ (multiple-value-bind (mins remaining) (truncate remaining 60))
+ (multiple-value-bind (secs) (truncate remaining))
+ (format nil "~Dd ~2,'0Dh ~2,'0Dm ~2,'0Ds" days hours mins secs)))
+
+(defun draw/chiron/top-bar (pad)
+ (boots:draw pad 0 0 "CHIRON" (boots:attr :fg +black+ :bg +amber+ :bold t))
+ (let ((closing (format nil "Window closes in: ~A" (human-countdown))))
+ (boots:draw pad (- (boots:width pad) (length closing)) 0
+ closing +reverse+)))
+
+(defun draw/chiron/bottom-bar (pad)
+ (boots:draw pad 0 0 "user: elf@chiron" +reverse+)
+ (draw-right pad (1- (boots:width pad)) 0
+ (format nil "(SEED ~X)" *seed*) +reverse+))
+
+
+(defparameter *chiron/top-bar*
+ (boots:make-canvas :height 1 :margin-bottom 1
+ :fill-char #\space
+ :fill-attr +reverse+ :draw #'draw/chiron/top-bar))
+
+(defparameter *chiron/bottom-bar*
+ (boots:make-canvas :height 1 :margin-top 1
+ :fill-char #\space
+ :fill-attr +reverse+ :draw #'draw/chiron/bottom-bar))
+
+
+(defparameter *chiron/journal* (boots:make-canvas :draw #'draw/journal))
+(defparameter *chiron/email* (boots:make-canvas :draw #'draw/email))
+
+(defparameter *chiron* (boots:pile ()))
+
+(defmacro with-chiron-layer (widget &body body)
+ `(progn
+ (push ,widget (boots:children *chiron*))
+ (unwind-protect (progn ,@body)
+ (pop (boots:children *chiron*)))))
+
+(defun key-name (key)
+ (case key
+ (#\tab "tab")
+ (t (string key))))
+
+(defun select-box (heading options)
+ (with-chiron-layer
+ (boots:stack (:margin t :width 20 :height (+ (length options) 2) :border t
+ :fill-char #\space :fill-attr +default+)
+ (boots:canvas (:fill-char #\space :fill-attr +default+ :height 1 :border-bottom t) (pad)
+ (boots:draw pad
+ (truncate (- (boots:width pad) (length heading)) 2)
+ 0 heading +default+))
+ (boots:canvas (:fill-char #\space :fill-attr +default+) (pad)
+ (iterate (for y :from 0)
+ (for (key description result) :in options)
+ (boots:draw pad 0 y (format nil "[~A] ~A" (key-name key)
+ description) +default+))))
+ (third (iterate
+ (boots:redraw)
+ (for (values e m) = (boots:read-event))
+ (unless (handle-global-event e m)
+ (thereis (find-if (lambda (option)
+ (boots:event= option e m))
+ options :key #'first)))))))
+
+(defun select ()
+ (select-box "SELECT"
+ '((#\m "Mail" :mail)
+ (#\j "Journal" :journal)
+ (#\q "Log Out" :quit)
+ (#\tab "Nevermind" :nevermind))))
+
+(defun chiron ()
+ (with-ui *chiron*
+ (with-chiron-layer (boots:stack (:fill-char #\space :fill-attr +default+)
+ *chiron/top-bar*
+ *chiron/journal*
+ *chiron/bottom-bar*)
+ (iterate
+ (timing real-time :per-iteration-into delta)
+ (decf *countdown* delta)
+ (boots:redraw)
+ (event-case (boots:read-event-no-hang)
+ (#\tab (dbg "~S" (select)))
+ (t nil))))))
;;;; Pause --------------------------------------------------------------------
@@ -69,10 +197,10 @@
(boots:draw pad 0 2 "[R]esume" +ooc+)
(boots:draw pad 0 3 "[Q]uit Game" +ooc+))
-
(defun pause ()
(with-ooc-colors
(with-ui (boots:make-canvas :width 30 :height 10 :border t :margin t
+ :fill-char #\space
:fill-attr +ooc+
:draw #'draw/pause)
(loop (boots:redraw)
@@ -84,7 +212,16 @@
;;;; Main ---------------------------------------------------------------------
+(defun init ()
+ (rb-clear *debug*)
+ (setf *seed* (cl:random (expt 2 60) (cl:make-random-state))
+ *pcg* (pcg:make-pcg :seed *seed*)
+ *countdown* (* internal-time-units-per-second
+ (+ (* 60 60 24 15)
+ (random 0 (* 60 60 4))))))
+
(defun run ()
+ (init)
(boots/terminals/ansi:with-ansi-terminal (terminal :truecolor t)
(boots:with-screen (boots:*screen* terminal)
(boots:with-light-borders
--- a/src/package.lisp Sun Apr 18 17:40:08 2021 -0400
+++ b/src/package.lisp Tue Apr 20 15:13:04 2021 -0400
@@ -1,3 +1,4 @@
(defpackage :dark
(:use :cl :iterate :losh)
+ (:shadow :random)
(:export :toplevel :build))