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

(require 'eieio)

(require 'bad-caption)
(require 'bad-move)
(require 'bad-pos)
(require 'bad-snake-food)
(require 'bad-write)

(defclass snake (elem)
  ((name :initform "")
   (data :initform (list (list #1=1 #2=1)))
   (len  :initform 1)
   (x    :initform #1#)
   (y    :initform #2#)
   (score     :initarg :score     :type   integer           :initform 0)
   (score-cpn :initarg :score-cpn :type   (or null caption) :initform nil)
   (game-over :initarg :game-over :custom boolean           :initform nil)
   (cmds      :initarg :cmds      :type   list              :initform nil)
   (mx        :initarg :mx        :type   integer           :initform 0)
   (my        :initarg :my        :type   integer           :initform 0)
   (hd        :initarg :hd        :type   (or null integer) :initform nil)
   (c         :initarg :c         :type   integer           :initform ?%)))

(cl-defmethod bad-draw-score ((s snake) &optional dst)
  (with-slots (score-cpn score) s
    (with-slots (text-draw w h) score-cpn
      (setf text-draw #1=(format "[%d]" score))
      (setf w (length #1#))
      (setf h 1)
      (when (cl-typep dst 'elem)
        (bad-write-replace dst score-cpn)))))

(cl-defmethod bad-update ((src snake) &optional dst) ; NOTE: OK
  (when (cl-typep dst 'elem)
    (with-slots (data hd c max-x max-y) src
      (with-slots (w h) dst
        (or max-x (setf max-x (1- w)))
        (or max-y (setf max-y (1- h)))
        (let ((tl data))
          (when hd
            (pcase-let ((`(,x ,y) (pop tl)))
              (bad-write-index dst (+ x (* w y)) hd)))
          (pcase-dolist (`(,x ,y) tl)
            (bad-write-index dst (+ x (* w y)) c)
            (bad-draw-score src dst)))))))

(cl-defmethod bad-do-cmd ((s snake))
  (with-slots (mx my cmds) s
    (when cmds
      (pcase-let (( `(,dmx ,dmy) (pop cmds) ))
        (when (and dmx (zerop mx))
          (setf mx dmx)
          (setf my 0))
        (when (and dmy (zerop my))
          (setf mx 0)
          (setf my dmy))))))

(cl-defmethod bad-eat ((s snake) (f food))
  (with-slots (x y len score) s
    (with-slots ((food-x x) (food-y y)) f
      (when (and (= x food-x) (= y food-y))
        (bad-new-food-pos f s)
        (cl-incf score len)))))

(cl-defmethod bad-new-food-pos ((f food) (s snake))
  (with-slots (data) s
    (with-slots (min-x max-x min-y max-y) f
      (let* ((allowed (cl-loop
                       for xi from min-x to max-x
                       with res
                       do (cl-loop
                           for yi from min-y to max-y
                           do (push (list xi yi) res))
                       finally return
                         (cl-set-difference res data :test #'equal)))
             (len (length allowed)))
        (pcase-let ((`(,x ,y) (nth (random len) allowed)))
          (bad-pos f x y))))))

(cl-defmethod bad-bite ((s snake))
  (with-slots (hd data game-over) s
    (unless (= 1 (cl-count (car data) data :test #'equal))
      (setf hd ?o)
      (setf game-over t))))

(cl-defmethod bad-collide ((s snake))
  (with-slots (hd min-x min-y x y max-x max-y game-over) s
    (when (or (and max-x (not (< min-x x max-x)))
              (and max-y (not (< min-y y max-y))))
      (setf hd ?x)
      (setf game-over t))))

(cl-defmethod bad-moving-p ((s snake))
  (with-slots (mx my) s
    (not (and (zerop mx) (zerop my)))))

(cl-defmethod bad-move ((s snake) (f food))
  (with-slots (game-over data len x y mx my) s
    (when (and (not game-over) (bad-moving-p s))
      (bad-mov s mx my)
      (push (list x y) data)
      (bad-bite s)
      (bad-collide s)
      (unless (bad-eat s f)
        (setf data (butlast data)))
      (setf len (length data)))))

(cl-defmethod bad-up ((s snake))
  (with-slots (cmds) s
    (push '( nil -1) cmds)))

(cl-defmethod bad-down ((s snake))
  (with-slots (cmds) s
    (push '( nil  1) cmds)))

(cl-defmethod bad-left ((s snake))
  (with-slots (cmds) s
    (push '(-1  nil) cmds)))

(cl-defmethod bad-right ((s snake))
  (with-slots (cmds) s
    (push '( 1  nil) cmds)))

(provide 'bad-snake)