; Inspired by the snakes the 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
(def *apple* (ref nil))
 
(defn create-apple []
  {:location [(rand-int width) (rand-int height)]
   :color (Color. 210 50 90)
   :type :apple})
 
; snake
(def *snake* (ref nil))
 
(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_RIGHT)) at-right) (if at-bottom (dirs VK_UP) (dirs VK_DOWN))
      (and (= dir (dirs VK_DOWN)) at-bottom) (if at-left (dirs VK_RIGHT) (dirs VK_LEFT))
      (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))
 
; state updates
(defn update-positions [snake apple]
  (dosync
    (if (collision? @snake @apple)
      (do (ref-set apple (create-apple))
        (alter snake move :grow))
      (alter snake move))))
 
(defn update-direction [snake newdir]
  (dosync (alter snake turn newdir)))
 
(defn reset-game []
  (dosync (ref-set *apple* (create-apple))
   (ref-set *snake* (create-snake))))
 
(reset-game)
 
; 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))
 
; gui elements
(def frame (JFrame. "Snake"))
 
(def panel
  (proxy [JPanel ActionListener KeyListener] []
    (getPreferredSize []
      (Dimension.
        (* width point-size)
        (* height point-size)))
    (paintComponent [g]
      (proxy-super paintComponent g)
      (paint g @*snake*)
      (paint g @*apple*))
    (actionPerformed [e]
      (update-positions *snake* *apple*)
      (when (lose? @*snake*)
        (reset-game)
        (JOptionPane/showMessageDialog frame "You lose!"))
      (when (win? @*snake*)
        (reset-game)
        (JOptionPane/showMessageDialog frame "You win!"))
      (.repaint this))
    (keyPressed [e]
      (update-direction *snake* (dirs (.getKeyCode e))))
    (keyReleased [e])
    (keyTyped [e]) ))
 
(def timer (Timer. turn-millis panel))
 
(doto panel
  (.setFocusable true)
  (.addKeyListener panel))
 
(doto frame
  (.add panel)
  (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
  (.pack)
  (.setVisible true))
  
(.start timer)
 