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

(require 'eieio)

(require 'bad-abc)
(require 'bad-ascii)
(require 'bad-binary)
(require 'bad-borderless)
(require 'bad-caption)
(require 'bad-cyclic)
(require 'bad-demo)
(require 'bad-draw)
(require 'bad-game)
(require 'bad-paths)
(require 'bad-size)
(require 'bad-write)

(require 'bad-toronto-magni)
(require 'bad-toronto-water)

(defclass toronto (game)
  ((name    :initform "toronto")
   (tor     :initarg :toronto :type (or null ascii)       :initform nil)
   (inner   :initarg :inner   :type (or null magni-glass) :initform nil)
   (outer   :initarg :outer   :type (or null borderless)  :initform nil)
   (abc-var :initarg :abc-var :type (or null abc)         :initform nil)
   (water   :initarg :water   :type (or null cyclic)      :initform nil)
   (about   :initarg :about   :type (or null caption)     :initform nil)
   (dsta    :initarg :dsta    :type (or null caption)     :initform nil)
   (tmr     :initarg :tmr     :type (or null vector)      :initform nil)))

(cl-defmethod bad-animate ((d toronto))
  (with-slots (water) d
    (bad-toggle water "animation")
    (bad-update d)))

(cl-defmethod bad-about ((d toronto))
  (with-slots (about dsta) d
    (bad-visible about)
    (with-slots ((oh y) visible) about
      (with-slots (y) dsta
        (if visible
            (setf y (+ oh 2))
          (setf y oh)))))
  (bad-update d))

(cl-defmethod bad-find ((d toronto))
  (with-slots (inner) d
    (bad-find inner)
    (bad-update d)))

(cl-defmethod bad-init-keys ((d toronto))
  (set-char-table-range (nth 1 bad-demo-mode-map) t #'ignore)

  (keymap-set bad-demo-mode-map "h" (lambda () (interactive) (bad-help-toggle d)))
  (keymap-set bad-demo-mode-map "a" (lambda () (interactive) (bad-about       d)))
  (keymap-set bad-demo-mode-map "s" (lambda () (interactive) (bad-animate     d)))
  (keymap-set bad-demo-mode-map "f" (lambda () (interactive) (bad-find        d)))
  (keymap-set bad-demo-mode-map "q" #'kill-emacs)

  (with-slots ((i inner)) d
    (keymap-set bad-demo-mode-map "I" (lambda () (interactive) (bad-make-movable i) (bad-add-row i -1) (bad-update d)))
    (keymap-set bad-demo-mode-map "K" (lambda () (interactive)                  (bad-add-row i)    (bad-update d)))
    (keymap-set bad-demo-mode-map "J" (lambda () (interactive) (bad-make-movable i) (bad-add-col i -1) (bad-update d)))
    (keymap-set bad-demo-mode-map "L" (lambda () (interactive)                  (bad-add-col i)    (bad-update d)))

    (keymap-set bad-demo-mode-map "j" (lambda () (interactive) (bad-left  i) (bad-update d)))
    (keymap-set bad-demo-mode-map "i" (lambda () (interactive) (bad-up    i) (bad-update d)))
    (keymap-set bad-demo-mode-map "k" (lambda () (interactive) (bad-down  i) (bad-update d)))
    (keymap-set bad-demo-mode-map "l" (lambda () (interactive) (bad-right i) (bad-update d)))))

(cl-defmethod bad-init ((d toronto))
  (with-slots (w h about dsta help outer inner water tor abc-var) d
    (setf abc-var (abc))
    (bad-init abc-var)

    (setf tor (ascii :name #1="toronto"))
    (bad-read-file tor (concat #1# ".txt") (file-name-concat bad-dir "data" #1#))

    (setq about (caption
                 :name "about"
                 :visible nil
                 :text-draw #1="dorks run away in the face of a warrior"
                 :w-max w
                 :w #2=(length #1#) :h 1
                 :x (- w #2#)       :y 6))
    (bad-update about)

    (setf dsta (caption
                :name #1="dsta"
                :text-draw #2=(format "%s: OK" #1#)
                :w-max w
                :w #3=(length #2#) :h 1
                :x (- w #3#)       :y 6))
    (bad-update dsta)

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

    (setq outer (borderless  :name "outer" :w w :h h))
    (bad-update outer)

    (setq inner (magni-glass :name "inner" :x (- w 18) :outer outer))
    (bad-update inner)
    (bad-set-area inner)

    (let ((str "The river. It has seen too much."))
      (setq water (cyclic :name "water" :src (bad-bytes str) :w w :h 4)))
    (bad-lake water)
    (with-slots ((water-h h)) water
      (with-slots ((tor-h h)) tor
        (bad-pos-y water (+ 1 (- h water-h)))
        (bad-pos-y tor   (+ 2 (- h water-h tor-h)))))

    (bad-draw-draw abc-var outer (- w 39) 0)
    (bad-init-keys d)
    (bad-setup d)))

(cl-defmethod bad-status-draw ((d toronto))
  (with-slots (inner dsta) d
    (with-slots (status) inner
      (with-slots (text-alt data x w w-max) dsta
        (setf text-alt status)
        (setf x (- w-max #1=(length text-alt)))
        (setf w #1#)
        (bad-draw-fold dsta)))))

(cl-defmethod bad-update ((d toronto))
  (bad-status-draw d)
  (with-slots (outer water tor abc-var about help inner dsta) d
    (let ((dst outer))
      (bad-update dst)
      (bad-write-replace dst water)
      (bad-write-replace dst tor)
      (bad-draw-draw abc-var dst)
      (bad-write-replace dst about)
      (bad-write-replace dst dsta)
      (bad-write-replace dst help)
      (bad-write-replace dst inner)
      (bad-draw-to-buf dst))
    (goto-char 2)))

(cl-defmethod bad-tick ((d toronto) &optional n now)
  (or n (setq n 1))
  (with-slots (water) d
    (dotimes (_ n)
      (unless now
        (bad-update water))
      (bad-update d))))

(cl-defmethod bad-run ((d toronto))
  (bad-init d)
  (with-slots (tmr) d
    (setf tmr (run-with-timer 0 1 #'bad-tick d))))

(provide 'bad-toronto)