; Inspired by the snakes that have gone before:
; Abhishek Reddy's snake: http://www.plt1.com/1070/even-smaller-snake/
; Mark Volkmann's snake: http://www.ociweb.com/mark/programming/ClojureSnake.html
 
(ns examples.snake
  (:import (java.awt Color Dimension) 
    (javax.swing JPanel JFrame Timer JOptionPane)
    (java.awt.event ActionListener KeyListener))
  (:use clojure.contrib.import-static
    [clojure.contrib.seq-utils :only (includes?)]))
    
(import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_UP VK_DOWN)         
 
; Game board and coordinates. points are [x,y] vectors
(def width 40)
(def height 40)
(def point-size 10)
(def turn-millis 75)
(def win-length 5)
 
(defn new-point [& pts]
  (vec (apply map + pts)))
 
(defn point-to-screen-rect [pt]
  (map #(* point-size %)
       [(pt 0) (pt 1) 1 1]))
 
(def dirs { VK_LEFT  [-1  0]
            VK_RIGHT [ 1  0]
            VK_UP    [ 0 -1]
            VK_DOWN  [ 0  1] })
 
; apple
(defn create-apple []
  {:location [(rand-int width) (rand-int height)]
   :color (Color. 210 50 90)
   :type :apple})
 
; snake
(defn create-snake []
  {:body (list [1 1])
   :dir (dirs VK_RIGHT)
   :color (Color. 15 160 70)
   :type :snake})

(defn follow-edge
  [head dir]
    (let [at-left (= (head 0) 0)
           at-right (= (head 0) (- width 1))
           at-top  (= (head 1) 0)
           at-bottom (= (head 1) (- height 1))]
    (cond
      (and (= dir (dirs VK_UP)) at-top) 
        (if at-right (dirs VK_LEFT) (dirs VK_RIGHT))
      (and (= dir (dirs VK_DOWN)) at-bottom) 
        (if at-right (dirs VK_LEFT) (dirs VK_RIGHT))
      (and (= dir (dirs VK_RIGHT)) at-right) 
        (if at-top (dirs VK_DOWN) (dirs VK_UP))
      (and (= dir (dirs VK_LEFT)) at-left) 
        (if at-top (dirs VK_DOWN) (dirs VK_UP))
      true dir)))

(defn move [{:keys [body dir] :as snake} & grow]
  (let [new-head (new-point (first body) dir)]
    (assoc snake :body (cons new-head
                             (if grow body (butlast body)))
                 :dir (follow-edge new-head dir)) ))
 
(defn turn [snake newdir]
    (assoc snake :dir (follow-edge (first (snake :body)) newdir)))
 
(defn win? [{body :body}]
  (>= (count body) win-length))
 
(defn head-overlaps-body? [{[head & body] :body}]
  ; have proposed to SS that argument order be reversed:
  (includes? head body))
 
(def lose? head-overlaps-body?)
 
(defn collision? [{[snake-head] :body} {apple :location}]
   (= snake-head apple))
 
; game state updates
(defn create-game []
  {:type :game
   :apple (ref nil)
   :snake (ref nil)})

(defn handle-timer [{:keys [snake apple]}]
  (dosync
   (if (collision? @snake @apple)
     (do (ref-set apple (create-apple))
   (alter snake move :grow))
     (alter snake move))))
 
(defn handle-keycode [{:keys [snake]} keycode]
  (dosync (alter snake turn (dirs keycode))))

(defn reset-game [{:keys [apple snake]}]
  (dosync
    (ref-set apple (create-apple))
    (ref-set snake (create-snake))))
 
(defn end-game? [game]
  (let [{:keys [apple snake]} game]
    (cond
      (lose? @snake) (do (reset-game game) "You lose!")
      (win? @snake) (do (reset-game game) "You win!"))))
 
; drawing
(defn fill-point [g pt color]
  (let [[x y width height] (point-to-screen-rect pt)]
    (.setColor g color)
    (.fillRect g x y width height)))
 
(defmulti paint (fn [g object & _] (:type object)))
 
(defmethod paint :snake [g {:keys [body color]}]
  (doseq [point body]
    (fill-point g point color)))
 
(defmethod paint :apple [g {:keys [location color]}]
  (fill-point g location color))
 
(defmethod paint :game [g {:keys [apple snake]}]
  (paint g @apple)
  (paint g @snake))

; main function and GUI
(def frame (JFrame. "Snake"))

; main function
(defn run-game [game]
  (let [frame (JFrame. "Snake")
        panel (proxy [JPanel ActionListener KeyListener] []
                (getPreferredSize []
                  (Dimension.
                    (* width point-size)
                    (* height point-size)))
                (paintComponent [g]
                  (proxy-super paintComponent g)
                  (paint g game))
                (actionPerformed [e]
                  (handle-timer game)
                  (when-let [msg (end-game? game)]
                    (JOptionPane/showMessageDialog frame msg))
                  (.repaint this))
                (keyPressed [e]
                   (handle-keycode game (.getKeyCode e)))
                (keyReleased [e])
                (keyTyped [e]))]
 
    (reset-game game)
 
    (doto panel
      (.setFocusable true)
      (.addKeyListener panel))
 
    (doto frame
      (.add panel)
      (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
      (.pack)
      (.setVisible true))
 
    (.start (Timer. turn-millis panel))))
 
(run-game (create-game))