src/main.lisp @ 05bd74b8d9c4

(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+))
(defconstant +ooc+ (boots:attr :fg +white+ :bg +black+))

(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-in-game-colors (&body body)
  `(let ((boots:*border-attr* +default+))
     ,@body))

(defmacro with-ooc-colors (&body body)
  `(let ((boots:*border-attr* +ooc+))
     ,@body))

(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-ooc-colors
    (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" +ooc+)
  (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-attr +ooc+
                                :draw #'draw/pause)
      (loop (boots:redraw)
            (multiple-value-bind (e m) (boots:read-event)
              (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
        (with-in-game-colors
          (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))