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

(require 'color)
(require 'eieio)

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

(defclass egypt (game)
  ((name :initform "egypt")
   (col-buf     :initarg :col-buf     :type (or null buffer) :initform nil)
   (eye         :initarg :eye         :type (or null ascii)  :initform nil)
   (egypt-sub   :initarg :egypt-sub   :type (or null box)    :initform nil)
   (crack-left  :initarg :crack-left  :type (or null box)    :initform nil)
   (crack-right :initarg :crack-right :type (or null box)    :initform nil)
   (egypt-box   :initarg :egypt-box   :type (or null box)    :initform nil)))

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

(cl-defmethod bad-init ((e egypt))
  (with-slots (col-buf
               w h
               screen
               eye egypt-sub crack-left crack-right egypt-box)
      e
    (bad-col-buf-init e)
    (setf screen (box :name "screen" :w w :h (1+ h) :spc (list bad-nonsolid)))
    (bad-border screen ?\s)
    (bad-side screen 2 (char-to-string bad-nonsolid))
    (bad-update screen)

    (setf eye (ascii :name #1="eye" :align-c t :x 6 :y 2))
    (bad-read-file eye (concat #1# ".txt")
               (file-name-concat bad-dir "data" (oref e name)))

    (setq egypt-sub
          (box :name "egypt-sub"
               :x 1       :y 1
               :w (- w 2) :h (- h 2)
               :c1 #1=?\\    :s1 '(#2=?^) :c2 #2#
               :s4 '(?/ #1#)              :s2 #3=`(,bad-nonsolid)
               :c4 #1#       :s3 '(#4=?_) :c3 #4#
               :spc #3#
               :resize-wh '(-2 -2)))
    (bad-update egypt-sub)

  (setq crack-left
    (box :name "crack-left"
         :x 3 :y 2
         :w 2 :h 1
         :c1   #1=?_ :c2  #2=?-
         :s4 '(#1#)  :s2 '(#2#)
         :c4   #1#   :c3   #2#
         :resize-wh '(nil -4)))
  (bad-update crack-left)

  (setq crack-right
    (box :name "crack-right"
         :x (- w 4) :y 2
         :w 2       :h 1
         :c1   #1=?_ :c2   #2=?-
         :s4 '(#1#)  :s2 '(#2#)
         :c4   #1#   :c3   #2#
         :align-rel-xy '(-4 nil)
         :resize-wh    '(nil -4)))
  (bad-update crack-right)

  (setq egypt-box
    (box :name "egypt-box"
         :w #1=(1+ (* 10 (/ w #2=16)))
         :h #3=(1+ (* 18 (/ h #2#)))
         :w-min #1# :h-min #3#
         :w-max w   :h-max h
         :c1 #1=?_       :s1 '(#1#) :c2 #2=?\s
         :s4 #3='(?\\ ?/)           :s2 #3#
         :c4 #2#         :s3 '(?^)  :c3 #2#
         :sub (list egypt-sub crack-left crack-right eye)))
  (setf (oref egypt-box tick) (lambda () (bad-egypt-box-tick egypt-box)))
  (bad-update egypt-box)
  (with-slots (w h) egypt-box ;; NOTE: OK
    (bad-size egypt-box w h))
  (bad-init-keys e)
  (bad-setup e)))

(cl-defmethod bad-init-keys ((e egypt))
  (set-char-table-range (nth 1 bad-demo-mode-map) t #'ignore)
  (keymap-set bad-demo-mode-map "q" #'kill-emacs)
  (with-slots ((eb egypt-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 egypt))
  (with-slots (col-buf screen egypt-box w h) 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-update egypt-box)
    (bad-write-replace screen egypt-box)
    (bad-draw-to-buf-transparent screen t)))

(cl-defmethod bad-egypt-box-tick ((b box))
  (with-slots (w h) b
    (bad-write-index b     (* (- h 2) w)  ?\\)
    (bad-write-index b (1+ (* (- h 1) w)) ?`)
    (unless (zerop (mod h 2))
      (bad-write-index b (- (* h w) 1) ?`))))

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

(provide 'bad-egypt)