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

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

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

(-> 'eieio)
(-> 'bad-borderless)
(-> 'bad-box)
(-> 'bad-draw)
(-> 'bad-mode)
(-> 'bad-path)
(-> 'bad-program)
(-> 'bad-size)
(-> 'bad-snake)
(-> 'bad-snake-food)
(-> 'bad-snake-level)

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

(defclass snake-game (program)
  ((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 ((sg snake-game))
  (~ (tmr) sg
     (when (member tmr timer-list)
       (cancel-timer tmr))
     (setf tmr (run-with-timer 0 0.13 #'bad-uptick sg)))) ; (/ 1 0.13) ; 7-8 FPS

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

;; -------------------------------------------
;; FPS  where
;; -------------------------------------------
;; 7-8  this game assuming uptick every 0.13
;;  24  cinema
;;  30  old games
;;  60  modern consoles (e.g., PS5)
;; 120  competitive players
;; 240  top competitors
;; 360  eSports champions
;; -------------------------------------------
;; https://www.gpumag.com/good-fps-for-gaming
;; -------------------------------------------

(cl-defmethod bad-init ((sg snake-game))
  (~ (dir bgr field screen w h snk fod lvl) sg
     (setf bgr (or (bad-cat) (ascii :name "bgr")))
     (unless bgr
       (bad-read-file bgr "cat.txt" dir))
     (bad-update screen)
     (~ (w h) screen
        (setf field (box
                     :name "field"
                     :x    (*  5 (/ w #1=16))
                     :y    (* 13 (/ h #1#))
                     :w    (*  8 (/ w #1#))
                     :h #2=(* 13 (/ h #1#))
                     :spc  (string-to-list "  .  "))))
     (bad-make-ascii field)
     (bad-update field)
     (setf lvl (snake-level))
     (setf snk (snake))
     (setf fod (food))
     (bad-init fod field)
     (bad-new-food-pos fod snk)
     (bad-update sg)
     (bad-init-keys sg)
     (bad-setup sg)))

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

(cl-defmethod bad-init-keys ((sg snake-game))
  (keymap-set bad-mode-map "~" (L () (bad-next-font sg 'prev)))
  (keymap-set bad-mode-map "`" (L () (bad-next-font sg)))
  (keymap-set bad-mode-map "p" (L () (bad-pause sg)))
  (keymap-set bad-mode-map "Q" #'text-mode)
  (keymap-set bad-mode-map "q" (L () (bad-quit sg)))
  (~ (snk) sg
     (keymap-set bad-mode-map "i" (L () (bad-up    snk)))
     (keymap-set bad-mode-map "k" (L () (bad-down  snk)))
     (keymap-set bad-mode-map "j" (L () (bad-left  snk)))
     (keymap-set bad-mode-map "l" (L () (bad-right snk)))))

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

(cl-defmethod bad-update ((sg snake-game))
  (~ (bgr field snk fod) sg
     ;; update
     (bad-update field)
     (bad-update snk field)
     (bad-update fod field)
     ;; write
     (bad-write-replace bgr field)
     ;; draw
     (bad-draw-to-buf bgr)))

(cl-defmethod bad-uptick ((sg snake-game))
  (~ (tmr snk fod lvl) sg
     (bad-do-cmd snk)
     (bad-snake-move snk fod)
     (~ (score game-over) snk
        (if (! game-over)
            (bad-level-up lvl sg snk)
          (cancel-timer tmr)
          (message "GAME OVER. Score: %d" score)))
     (bad-update sg)))

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

(cl-defmethod bad-level-2 ((l snake-level) (sg snake-game))
  (~ (lvl score-max) l
     (++ lvl)
     (setf score-max 200))
  (~ (bgr dir) sg
     (bad-read-file bgr "dark.txt" dir)
     (bad-update sg)))

(cl-defmethod bad-level-3 ((l snake-level) (sg snake-game))
  (~ (lvl score-max) l
     (++ lvl)
     (setf score-max 400))
  (~ (bgr dir) sg
     (bad-read-file bgr "bell.txt" dir)
     (bad-update sg)))

(cl-defmethod bad-level-4 ((l snake-level) (sg snake-game))
  (++ (@ l lvl))
  (~ (bgr dir) sg
     (bad-read-file bgr "bin.txt" dir)
     (bad-update sg)))

(cl-defmethod bad-level-up ((l snake-level) (sg snake-game) (snk snake))
  (~ (score) snk
     (when (<= (@ l score-max) score)
       (bad-clear (@ sg screen))
       (cl-case (@ l lvl)
         (1 (bad-level-2 l sg))
         (2 (bad-level-3 l sg))
         (3 (bad-level-4 l sg))
         (t (setf (@ snk game-over) t)
            ($ "More levels to come ... score: %s" score))))))

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

(cl-defmethod bad-run ((sg snake-game))
  (bad-init sg)
  (bad-run-timer sg)
  (bad-right (@ sg snk)))

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

(<- 'bad-snake-game)