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

(require 'eieio)

(require 'bad-borderless)
(require 'bad-box)
(require 'bad-box-draw)
(require 'bad-caption)
(require 'bad-demo)
(require 'bad-draw)
(require 'bad-game)
(require 'bad-paths)
(require 'bad-size)
(require 'bad-snake)
(require 'bad-snake-food)
(require 'bad-snake-level)

(defclass snake-game (game)
  ((name :initform "snake-game")
   (dir  :initarg :dir :type string                :initform (file-name-concat bad-dir "data" "snake"))
   (snk  :initarg :snk :type (or null snake)       :initform nil)
   (fod  :initarg :fod :type (or null food)        :initform nil)
   (lvl  :initarg :lvl :type (or null snake-level) :initform nil)))

(cl-defmethod bad-run-timer ((s snake-game))
  (with-slots (tmr) s
    (when (member tmr timer-list)
      (cancel-timer tmr))
    (setf tmr (run-with-timer 0 0.13 #'bad-uptick s))))

(cl-defmethod bad-pause ((s snake-game))
  (with-slots (tmr) s
    (if (member tmr timer-list)
        (cancel-timer tmr)
      ;; NOTE: (timer-activate tmr) DNC
      ;;       create a new one instead
      (bad-run-timer s))))

(cl-defmethod bad-init-help ((s snake-game))
  (with-slots (help) s
    (setf help (caption
                :name "help"
                :text-alt #1="[h]"
                :text #4=(string-join
             #3=(list #2=(format "%s help   " #1#)
                                "[s] score  "
                                "[p] pause  "
                                "[q] quit   "
                                "           "
                                "    [i]    "
                                "[j] mov [l]"
                                "    [k]    "))
                :text-draw #4#
                :y 2
                :w (length #2#) :h (length #3#)))
    (bad-update help t)))

(cl-defmethod bad-init ((s snake-game))
  (with-slots (dir bg field screen w h snk fod lvl) s
    (bad-init-help s)

    (setf bg (ascii :name "background"))
    (bad-read-file bg "cat.txt" dir t)
    (bad-update screen)

    (with-slots (w h) screen
      (setf field (box
                :name "field"

                :x    (*  5 (/ w 16))
                :y    (* 13 (/ h 16))
                :w #1=(*  8 (/ w 16))
                :h #2=(* 13 (/ h 16))
                :spc (string-to-list "  .  ")))
      (bad-update field)

      (setf lvl (snake-level))
      (setf snk (snake))
      (with-slots (score-cpn score) snk
        (setf score-cpn (caption
                         :name "score-caption"
                         :visible nil
                         :y (1- #2#)
                         :w 3
                         :h 1))
        (bad-update score-cpn t)
        (bad-draw-score snk)))

    (setf fod (food))
    (bad-init fod field)
    (bad-new-food-pos fod snk)

    (bad-update s)
    (bad-init-keys s)
    (bad-setup s)))

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

  (keymap-set bad-demo-mode-map "h" (lambda () (interactive) (bad-help-toggle s)))
  (keymap-set bad-demo-mode-map "p" (lambda () (interactive) (bad-pause s)))
  (keymap-set bad-demo-mode-map "q" #'kill-emacs)

  (with-slots (snk) s
    (keymap-set bad-demo-mode-map "s" (lambda () (interactive) (bad-score-toggle snk)))

    ;; no idea why these don't work
    (keymap-set bad-demo-mode-map "<up>"    (lambda () (interactive) (bad-up    snk)))
    (keymap-set bad-demo-mode-map "<down>"  (lambda () (interactive) (bad-down  snk)))
    (keymap-set bad-demo-mode-map "<left>"  (lambda () (interactive) (bad-left  snk)))
    (keymap-set bad-demo-mode-map "<right>" (lambda () (interactive) (bad-right snk)))

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

(cl-defmethod bad-score-toggle ((snk snake))
  (with-slots (score-cpn) snk
    (with-slots (visible) score-cpn
      (setf visible (not visible)))))

(cl-defmethod bad-update ((s snake-game))
  (with-slots (help bg field screen snk fod) s
    (bad-update field)
    (bad-update snk field)
    (bad-update fod field)

    (with-slots (score-cpn) snk
      (bad-update score-cpn)
      (bad-update score-cpn field))

    (bad-write-replace screen bg)
    (bad-write-replace screen field)
    (bad-write-replace screen help)
    (bad-draw-to-buf screen)))

(cl-defmethod bad-uptick ((s snake-game))
  (with-slots (tmr snk fod lvl) s
    (bad-do-cmd snk)
    (bad-move snk fod)

    (with-slots (score game-over) snk
      (if (not game-over)
          (bad-level-up lvl s snk)
        (cancel-timer tmr)
        (message "GAME OVER. Score: %d" score)))
    (bad-update s)))

(cl-defmethod bad-level-2 ((l snake-level) (s snake-game))
  (with-slots (lvl score-max) l
    (cl-incf lvl)
    (setf score-max 200))
  (with-slots (help bg dir) s
    (with-slots (y) help
      (setf y 10))
    (bad-draw-fold help)
    (bad-read-file bg "dark.txt" dir t)
    (bad-update s)))

(cl-defmethod bad-level-3 ((l snake-level) (s snake-game))
  (with-slots (lvl score-max) l
    (cl-incf lvl)
    (setf score-max 400))
  (with-slots (help bg dir) s
    (with-slots (x y) help
      (bad-pos help 0 7))
    (bad-read-file bg "bell.txt" dir t)
    (bad-update s)))

(cl-defmethod bad-level-4 ((l snake-level) (s snake-game))
  (with-slots (lvl) l
    (cl-incf lvl))
  (with-slots (bg dir help) s
    (with-slots (x y) help
      (bad-pos help 0 2))
    (bad-read-file bg "bin.txt" dir t))
  (bad-update s))

(cl-defmethod bad-level-up ((l snake-level) (s snake-game) (snk snake))
  (with-slots (score) snk
    (with-slots (score-max) l
      (when (and (<= score-max score))
        (with-slots (screen) s
          (bad-clear screen))
        (with-slots (lvl) l
          (if (= 1 lvl)
              (bad-level-2 l s)
            (if (= 2 lvl)
                (bad-level-3 l s)
              (when (= 3 lvl)
                (bad-level-4 l s)))))))))

(cl-defmethod bad-run ((s snake-game))
  (bad-init s)
  (bad-run-timer s)
  (with-slots (snk) s
    (bad-right snk)))

(provide 'bad-snake-game)