;;; -*- lexical-binding: t -*-

(require 'eieio)

(require 'bad-borderless)
(require 'bad-box)
(require 'bad-demo)
(require 'bad-draw)
(require 'bad-game)
(require 'bad-textroll)
(require 'bad-write)

(defclass maple (game)
  ((name   :initform "maple")
   (exits  :initarg :exits  :type (or null borderless) :initform nil)
   (tr     :initarg :tr     :type (or null textroll)   :initform nil)
   (tr-box :initarg :tr-box :type (or null box)        :initform nil)))

(defun bad-insert (str col)
  (insert (propertize str 'face (list :background col))))

(defun bad-insert-space (len col)
  (let ((str (make-string len ?\s)))
    (bad-insert str col)))

(cl-defmethod bad-frida ((m maple))
  (let* ((lh       24)
         (lines    11)
         (img-h    (* lines lh))
         (img-w    img-h)
         (img-path (file-name-concat bad-dir "data/maple/frida-maple.jpg"))
         (img      (create-image img-path nil nil :width img-w :height img-h))
         (border   3)
         (col      (with-slots (screen) m
                     (with-slots (color) screen
                       color))))
    (insert-sliced-image img nil nil lines)
    (cl-loop
     initially do (goto-char (point-min))
     with frida-strs = '("Name:           "
                         " Frida Maple    "
                         "Age: 27         "
                         "Speciality:     "
                         " PhD student    "
                         " expert on all  "
                         " rebellious and "
                         " subversive     "
                         " cultures       "
                         "Employed by:    "
                         " the CIA        ")
     for l from 0 to (1- lines) do
     (bad-insert-space border col)
     (end-of-line)
     (bad-insert-space 24 col)
     (bad-insert (nth l frida-strs) "#2266aa")
     (bad-insert-space border col)
     (goto-char (pos-bol 2)))
    (kill-line (+ 4 lines)))) ; why +5?

(cl-defmethod bad-init ((m maple))
  (with-slots (exits tr tr-box screen) m
    (with-slots (color) screen
      (setf color "#005b8a"))
    (bad-update screen)

    (setf tr (textroll :name "maple-tr"))
    (let ((frida-quote
           (list "Frida Maple:                                \n"
                 "  Yeah, these are just a bunch of kids.     \n"
                 "  They don't know anything.                 \n"
                 "  Just something 'bout this whole situation.\n")))
      (with-slots (x y w h) tr
        (bad-set tr (string-join frida-quote))
        (setf y 19)
        (setf x 5)
        (setf w 44)
        (setf h 5)
        (bad-update tr)
        (setf tr-box
              (box :name "tr-box"
                   :x (- x 2)
                   :y (- y 2)
                   :w (+ (* 2 2) w)
                   :h (+ (* 2 2) h)))
        (bad-make-light tr-box)))

    (setf exits (box :name "exists"
                     :spc '(?. ?\s ?\$ ?\s)
                     :s1 #1='(?━)
                     :s3 #1#
                     :fg    "#112233"
                     :color "#c4a484"
                     :x 54
                     :y 17
                     :w 23
                     :h  9))
    (bad-update exits)

  (bad-init-keys m)
  (bad-setup m)))

(cl-defmethod bad-init-keys ((m maple))
  (set-char-table-range (nth 1 bad-demo-mode-map) t #'ignore)
  (keymap-set bad-demo-mode-map "q" (lambda () (interactive) (bad-quit m)))
  (keymap-set bad-demo-mode-map "n" (lambda () (interactive) (bad-feed m))))

(cl-defmethod bad-update ((m maple))
  (with-slots (exits tr tr-box screen) m
    (erase-buffer)
    (bad-update exits)
    (bad-update tr-box)
    (bad-update screen)
    (bad-write-replace screen tr-box)
    (bad-write-replace screen tr)
    (bad-draw-to-buf screen)
    (bad-draw-to-buf-transparent exits))
  (bad-frida m))

(cl-defmethod bad-uptick ((m maple))
  (bad-update m)
  (with-slots (tr) m
    (bad-type tr)))

(cl-defmethod bad-feed ((m maple))
  (with-slots (tr) m
    (with-slots (halted) tr
      (setf halted nil))))

(cl-defmethod bad-run-timer ((m maple))
  (with-slots (tmr) m
    (when (member tmr timer-list)
      (cancel-timer tmr))
    (setf tmr (run-with-timer 0 0.1 #'bad-uptick m))))

(cl-defmethod bad-run ((m maple))
  (bad-init m)
  (bad-update m)
  (when t
    (bad-run-timer m)))

(provide 'bad-maple)