; This is a Swing-based game where the arrow keys to guide
; a snake to apples.  Each time the snake eats an apple it
; grows and a new apple appears in a random location.
; If the head of the snake hits its body, you lose.
; If the snake grows to a length of 10, you win.
; In either case the game starts over with a new, baby snake.
;
; This was originally written by Abhishek Reddy.
; Mark Volkmann rewrote it in an attempt to make it easier to understand.

(ns com.ociweb.snake
  (:import
    (java.awt Color Dimension)
    (java.awt.event ActionListener KeyEvent KeyListener)
    (javax.swing JFrame JOptionPane JPanel Timer)))

(def *board-height* 30)
(def *board-width* 30)
(def *length-to-win* 10)
(def *ms-per-move* 50)

;----------------------------------------------------------------------------
; Things related to cells
;----------------------------------------------------------------------------

(def *cell-size* 10)

(defstruct cell-struct :x :y)

(defn print-cell [cell]
  (println (str "(" (cell :x) ", " (cell :y) ")")))

(defn adjacent-or-same-cell? [cell1 cell2]
  (let [dx (Math/abs (- (cell1 :x) (cell2 :x)))
        dy (Math/abs (- (cell1 :y) (cell2 :y)))]
    (and (<= dx 1) (<= dy 1))))

(defn make-center-cell []
  (struct cell-struct
    (quot *board-width* 2)
    (quot *board-height* 2)))

(defn make-random-cell []
  (struct cell-struct
    (rand-int (- *board-width* 1))
    (rand-int (- *board-height* 1))))

(defn paint-cell [graphics {x :x y :y} color]
  (.setColor graphics color)
  (.fillRect graphics
    (* x *cell-size*) (* y *cell-size*)
    *cell-size* *cell-size*))

;----------------------------------------------------------------------------
; Things related to apples
;----------------------------------------------------------------------------

(defstruct apple-struct :color :cell)

(defn make-apple []
  (struct apple-struct Color/RED (make-random-cell)))

(def apple (ref (make-apple)))

(defn paint-apple [graphics]
  (paint-cell graphics (@apple :cell) (@apple :color)))

;----------------------------------------------------------------------------
; Things related to snakes
;----------------------------------------------------------------------------

(defstruct snake-struct :alive :body :color :direction)

(defn make-snake []
  (struct snake-struct true (list (make-center-cell)) Color/GREEN :right))

(def snake (ref (make-snake)))

(defn body-overlaps?
  "Determines whether the head is on the same cell as any other in the body."
  [body]
  (let [head (first body)]
    (some #(= % head) (rest body))))

(defn snake-head [] (first (@snake :body)))

(defn snake-length [] (count (@snake :body)))

(defn new-direction
  "Returns the snake's direction, either the current 
   direction or a new one if a board edge was reached."
  [direction {x :x y :y}]
  (let [at-left (= x 0)
        at-right (= x (- *board-width* 1))
        at-top (= y 0)
        at-bottom (= y (- *board-height* 1))]
    (cond
      (and (= direction :up) at-top) (if at-right :left :right)
      (and (= direction :right) at-right) (if at-bottom :up :down)
      (and (= direction :down) at-bottom) (if at-left :right :left)
      (and (= direction :left) at-left) (if at-top :down :up)
      true direction)))

(defn delta
  [direction]
  (let [dx (cond
             (= direction :left) -1
             (= direction :right) 1
             true 0)
        dy (cond
             (= direction :up) -1
             (= direction :down) 1
             true 0)]
        [dx, dy]))

(defn remove-tail [body] (butlast body))

(defn move-snake [grow]
  (if (@snake :alive)
    (let [direction (new-direction (@snake :direction) (snake-head))
          [dx dy] (delta direction)
          old-head (snake-head)
          x (old-head :x)
          y (old-head :y)
          new-head (struct cell-struct (+ x dx) (+ y dy))
          body-with-new-head (cons new-head (@snake :body))
          body (if grow body-with-new-head (remove-tail body-with-new-head))
          alive (not (body-overlaps? body))
          color (if alive Color/GREEN Color/BLACK)]
      (ref-set snake
        (struct snake-struct alive body color direction)))))

(defn paint-snake [graphics]
  (doseq [cell (@snake :body)]
    (paint-cell graphics cell (@snake :color))))

(defn get-direction
  "Gets a keyword that describes the direction
   associated with a given KeyEvent."
  [key-event]
  (let [key-code (.getKeyCode key-event)]
    (cond 
      (= key-code KeyEvent/VK_LEFT) :left
      (= key-code KeyEvent/VK_RIGHT) :right
      (= key-code KeyEvent/VK_UP) :up
      (= key-code KeyEvent/VK_DOWN) :down
      true nil)))

(defn set-snake-direction [key-event]
  (dosync
    (let [direction (get-direction key-event)
          current (@snake :direction)
          valid-change (cond
            (= direction :left) (not= current :right)
            (= direction :right) (not= current :left)
            (= direction :up) (not= current :down)
            (= direction :down) (not= current :up)
            true true)]
      (if valid-change
        (ref-set snake (assoc @snake :direction direction))))))

;----------------------------------------------------------------------------
; Things related to the GUI
;----------------------------------------------------------------------------

(def frame (JFrame. "Snake"))

(defn new-game [message]
  ; If this were running on a thread other than the EDT,
  ; it should be invoked like this:
  ; (SwingUtilities/invokeLater #(JOptionPane/showMessageDialog frame message))
  (JOptionPane/showMessageDialog frame message)
  (ref-set snake (make-snake)))

(defn process-move []
  (dosync
    (if (@snake :alive)
      (if (adjacent-or-same-cell? (snake-head) (@apple :cell))
      ; Use the next line instead to require collision with the apple.
      ;(if (= (snake-head) (@apple :cell))
        (do
          (ref-set apple (make-apple))
          (move-snake true)
          (if (= (snake-length) *length-to-win*)
            (new-game "You win!")))
        (move-snake false))
      (new-game "You killed the snake!"))))

(def panel
  (proxy [JPanel ActionListener KeyListener]
    [] ; superclass constructor arguments

    (getPreferredSize []
      (Dimension.
        (* *board-width* *cell-size*)
        (* *board-height* *cell-size*)))

    (paintComponent [graphics]
      (proxy-super paintComponent graphics)
      (dosync
        (paint-apple graphics)
        (paint-snake graphics)))

    ; This is called by the Timer created on the last line.
    (actionPerformed [e]
      (process-move)
      (.repaint this))

    (keyPressed [e] (set-snake-direction e))
    (keyReleased [e]) ; do nothing
    (keyTyped [e]) ; do nothing
  ))

(defn main []
  (doto panel
    (.setFocusable true) ; won't generate key events without this
    (.addKeyListener panel))

  (doto frame
    (.add panel)
    (.pack)
    (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
    (.setVisible true))

  ; Fire ActionEvents on the JPanel at regular intervals.
  (.start (Timer. *ms-per-move* panel)))

; Only run the application automatically if run as a script,
; not if loaded in a REPL with load-file.
;(println "*command-line-args* =" *command-line-args*)
;(if *command-line-args* (main))
(main)