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

(require 'cl-lib)
(cl-pushnew "." load-path :test #'string=)
(require 'luki-lisp)

;; --------------------------------------------------------------------------

(-> 'eieio)
(-> 'bad-elem)
(-> 'bad-move)
(-> 'bad-pos)
(-> 'bad-snake-food)
(-> 'bad-write)

;; --------------------------------------------------------------------------

(defclass snake (elem)
  ((name :initform "")
   (data :initform (list (list #1=1 #2=1))) ; NOTE: OK
   (len  :initform 1)
   (x    :initform #1#)
   (y    :initform #2#)
   (score     :initarg :score     :type   integer           :initform 0)
   (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-update ((src snake) &optional dst) ; NOTE: OK
  (when (cl-typep dst 'elem)
    (~ (data hd c max-x max-y) src
       (~ (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 #1=(+ x (* w y)) hd)))
            (pcase-dolist (`(,x ,y) tl)
              (bad-write-index dst #1# c)))))))

;; --------------------------------------------------------------------------

(cl-defmethod bad-do-cmd ((s snake))
  (~ (mx my cmds) s
     (when cmds
       (pcase-let ((`(,dmx ,dmy) (pop cmds)))
         (when (& dmx (z mx))
           (setf mx dmx)
           (setf my 0))
         (when (& dmy (z my))
           (setf mx 0)
           (setf my dmy))))))

;; --------------------------------------------------------------------------

(cl-defmethod bad-eat ((s snake) (f food))
  (~ (x y len score) s
     (~ ((food-x x) (food-y y)) f
        (when (& (= x food-x)
                 (= y food-y))
          (bad-new-food-pos f s)
          (++ score len)))))

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

;; --------------------------------------------------------------------------

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

(cl-defmethod bad-collide ((s snake))
  (~ (hd min-x min-y x y max-x max-y game-over) s
     (when (or (& min-x max-x (! (< min-x x max-x)))
               (& min-y max-y (! (< min-y y max-y))))
       (setf hd ?x)
       (setf game-over t))))

;; --------------------------------------------------------------------------

(cl-defmethod bad-moving-p ((s snake))
  (~ (mx my) s
     (nand (z mx) (z my))))

(cl-defmethod bad-snake-move ((s snake) (f food))
  (~ (game-over len data x y mx my) s
     (when (& (! game-over) (bad-moving-p s))
       (bad-move s mx my)
       (push `(,x ,y) data)
       (bad-bite s)
       (bad-collide s)
       (unless (bad-eat s f)
         (setf data (butlast data)))
       (setf len (--- data)))))

;; --------------------------------------------------------------------------

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

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

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

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

;; --------------------------------------------------------------------------

(<- 'bad-snake)