src/main.lisp @ 41f2c758451f

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

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


;;;; Splash -------------------------------------------------------------------
(defun draw/splash (pad)
  (boots:draw pad 0 0 *asset/splash*))

(defun 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))
  (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
        (let ((boots:*border-attr* +default+))
          (catch 'quit
            (splash)))))))


(defun toplevel ()
  (sb-ext:disable-debugger)
  (run))

(defun build ()
  (sb-ext:save-lisp-and-die "build/dark"
    :executable t
    :save-runtime-options t
    :toplevel #'dark:toplevel))