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

(require 'color)
(require 'eieio)

(require 'bad-ascii)
(require 'bad-box)
(require 'bad-borderless)
(require 'bad-caption)
(require 'bad-demo)
(require 'bad-draw)
(require 'bad-game)
(require 'bad-paths)
(require 'bad-size)
(require 'bad-textroll)
(require 'bad-write)

(defun grad-box (w h &optional char)
  (or char (setq char ?\s))
  (let* ((min 0.05)
         (beg-col (list min min min))
         (cols (* w (/ h 2)))
         (gcols (cl-concatenate 'list
           (color-gradient (list min 0.5 1.0) beg-col cols)
           (color-gradient beg-col (list min 0.7 min) cols))))
    (cl-loop
     initially do (goto-char (point-min))
     with str = (char-to-string char)
     for c in gcols do
     (insert (propertize str 'face
                         (list :weight 'bold :foreground (color-rgb-to-hex
                                                          (nth 0 c)
                                                          (nth 1 c)
                                                          (nth 2 c)))))
     (when (= (current-column) w)
       (insert "\n")))))

(defclass grr (game)
  ((name :initform "grr")
   (col-buf :initarg :col-buf :type (or null buffer)   :initform nil)
   (eye     :initarg :eye     :type (or null ascii)    :initform nil)
   (grr-box :initarg :grr-box :type (or null box)      :initform nil)
   (tr      :initarg :tr      :type (or null textroll) :initform nil)))

(cl-defmethod bad-about ((e grr))
  (with-slots (name) e
    (message "%s demo" name)))

(cl-defmethod bad-col-buf-init ((e grr))
  (with-slots (col-buf w h) e
    (unless col-buf
      (setf col-buf (get-buffer-create "*col-buf*")))
    (with-current-buffer col-buf
      (read-only-mode -1)
      (grad-box w h ?$)
      (read-only-mode))))

(cl-defmethod bad-init ((e grr))
  (with-slots (col-buf tr
               w h w-max h-max
               help screen
               eye grr-box)
      e
    (bad-col-buf-init e)

    (with-slots (spc) screen
      (setf spc (list bad-nonsolid)))
    (bad-border screen ?\s)
    (bad-side   screen 2 #1=(char-to-string #2=bad-nonsolid))
    (bad-side   screen 3 #1#)
    (bad-corner screen 3 #2#)
    (bad-update screen)

    (setf eye (ascii :name #1="eye"
                     :align-c t
                     :fg    "white"
                     :color "red"
                     :w (or w-max #1=12)
                     :h (or h-max (/ #1# 2))
                     :x 1
                     :y 1))
    (bad-read-file eye (concat #1# ".txt")
               (file-name-concat bad-dir "data" "egypt"))

    (setf help
         (caption
          :name "help"
          :text #5=(string-join
       #3=(list #2=(format "%s help        [i]    " #1="[h]")
                          "[a] about   [j] adj [l]"
                          "[q] quit        [k]    "))
          :text-alt #1#
          :text-draw #5#
          :w (length #2#) :h #4=(length #3#)
          :y (- h #4#)))
    (bad-update help)

    (setf tr (textroll :x 36 :y 3 :name "grr-tr"))
    (bad-text tr
          #2=(list
            #1="  The International Badseller!       "
               "  This is BAD, bad.el version 0.3.0  "
               "  and color is in the news.          "
               "  But in a bad way!                  "
               "              -- the BAD NEWS service"))
    (with-slots (w h) tr
      (setf w (length #1#))
      (setf h (length #2#)))
    (bad-update tr)

    (with-slots ((ew w) (eh h)) eye
      (setf grr-box
            (box :name "grr-box"
                 :w #1=(+ 2 ew)
                 :h #2=(1+ eh)
                 :fg    "white"
                 :color "red"
                 :w-min #1#
                 :h-min #2#
                 :w-max w
                 :h-max (- h (oref help h))
                 :sub (list eye)))
      (bad-box-inverted-border grr-box)
      (bad-update grr-box))
    (with-slots (w h) grr-box ;; NOTE: OK
      (bad-size grr-box w h))

    (bad-init-keys e)
    (bad-setup e)))

(cl-defmethod bad-init-keys ((e grr))
  (set-char-table-range (nth 1 bad-demo-mode-map) t #'ignore)
  (keymap-set bad-demo-mode-map "h" (lambda () (interactive) (bad-help-toggle e)))
  (keymap-set bad-demo-mode-map "a" (lambda () (interactive) (text-mode)))
  (keymap-set bad-demo-mode-map "q" #'kill-emacs)
  (with-slots ((eb grr-box)) e
    (keymap-set bad-demo-mode-map "i" (lambda () (interactive) (bad-add-row eb  -1) (bad-update e)))
    (keymap-set bad-demo-mode-map "k" (lambda () (interactive) (bad-add-row eb)     (bad-update e)))
    (keymap-set bad-demo-mode-map "j" (lambda () (interactive) (bad-add-col eb  -1) (bad-update e)))
    (keymap-set bad-demo-mode-map "l" (lambda () (interactive) (bad-add-col eb)     (bad-update e)))))

(cl-defmethod bad-update ((e grr))
  (with-slots (col-buf screen grr-box help w h tr) e
    (erase-buffer)
    (dolist (l (with-current-buffer col-buf
                 (seq-split (buffer-substring (point-min) (point-max)) (1+ w))))
      (insert (seq--into-string l)))
    (bad-update screen)
    (bad-write-replace screen tr)
    (bad-write-replace screen help)
    (bad-draw-to-buf-transparent screen)
    (bad-draw-to-buf-transparent grr-box)))

(cl-defmethod bad-run ((e grr))
  (bad-init e)
  (bad-update e))

(provide 'bad-grad)