Clojure Snake with Predator

Today I spent the morning trying out the Clojure snake from Stuart Halloway's Programming Clojure. I spent the afternoon making up / doing from memory a predator snake that follows the player's snake around.  Here is the full Code.

;; Setup
;;This is the test bed for me to test new things
(ns ai.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?)] clojure.contrib.math))
(import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_UP VK_DOWN)


(def width 75)
(def height 50)
(def point-size 10)
(def turn-millis 75)
(def win-length 50)
(def dirs { VK_LEFT [-1 0]
            VK_RIGHT [1 0]
            VK_DOWN [0 1]
            VK_UP [0 -1]})

;; The Functional Part            
(defn add-points [& pts]
  "Adds points together"
  (vec (apply map + pts)))
  
(defn point-to-screen-rect [pt]
  "Converts a point to a rectangle"
  (map #(* point-size %)
    [(pt 0) (pt 1) 1 1]))
    
(defn create-apple []
  {:location [(rand-int width) (rand-int height)]
    :color (Color. 210 50 90)
    :type :apple})

(defn create-snake [colour]
  {:body (list [(rand-int width) (rand-int height)])
    :dir [1 0]
    :type :snake
    :color colour})
    
(defn move [{:keys [body dir] :as snake} & grow]
  (assoc snake :body (cons (add-points (first body) dir)
    (if grow body (butlast body))))) 
    
(defn win? [{body :body}]
  (>= (count body) win-length))
  
(defn head-overlaps-body? [{[head & body] :body}]
  "Pretty neat, does the head an body include the same point?"
  (includes? body head))

(def lose? head-overlaps-body?)

(defn eats? [{[snake-head] :body} {apple :location}]
  "Very neat, All the work is done in the bindings in the function args"
  (= snake-head apple))
  
(defn turn  [snake newdir]
  (assoc snake :dir newdir))
  
;; This is the mutable part  
(defn reset-game [snake ai-snake apple]
  (dosync (ref-set apple (create-apple))
    (ref-set snake (create-snake (Color. 15 160 70))))
    (ref-set ai-snake (create-snake (Color. 15 255 70)))
    nil)
  
(defn update-direction [snake newdir]
  (when newdir (dosync (alter snake turn newdir))))
  
 (defn update-positions [snake ai-snake apple]
  (dosync
    (if (eats? @snake @apple)
      (do (ref-set apple (create-apple))
          (alter snake move :grow))
      (
      (alter snake move)
      (alter ai-snake move))))
     nil)

;;My AI part;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;(defn eats? [{[snake-head] :body} {apple :location}]
;;  "Very neat, All the work is done in the bindings in the function args"
;;  (= snake-head apple))
  
;;The functional part
 (defn point-dif [& pts]
 "The difference between two points"
    (vec (apply map - pts)))

(defn int-to-dir [pt] ;;Exception handling from Programming Clojure P83
    (try
        (/ pt (abs pt))
        (catch ArithmeticException _ 0)))

(defn point-to-dir [& pts]
    (vec (apply map int-to-dir pts)))
    
;;New direction Note that params needs to be derefed using @
(defn intercept-direction [{[target-head] :body} {[ai-head] :body}]
    (point-to-dir (point-dif target-head ai-head)))

;;End of my AI part;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


 ;; The GUI part
 (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)))
        
;;Multimethod
;;Paint takes 2 args, g is the Java.awt graphics object, object is the object to be painted
(defmulti paint (fn [g object & _] (:type object)))

(defmethod paint :apple [g {:keys [location color]}]
    (fill-point g location color))
    
(defmethod paint :snake [g {:keys [body color]}]
    (doseq [point body]
        (fill-point g point color)))
        
;;The meaty part
(defn game-panel [frame snake apple ai-snake]
    (proxy [JPanel ActionListener KeyListener] []
        (paintComponent [g]
            (proxy-super paintComponent g) ;;Draw the panel
            (paint g @snake)
            (paint g @ai-snake)
            (paint g @apple))
        (actionPerformed [e]
            (update-positions snake ai-snake apple) ;;Update positions
            ;;(update-direction ai-snake (intercept-direction @snake @ai-snake)) ;;Putting it here will make the pred track you all the time
                (when (lose? @snake)
                    (reset-game snake ai-snake apple)
                    (JOptionPane/showMessageDialog frame "You Lose!"))
                (when (win? @snake)
                    (reset-game snake ai-snake apple)
                    (JOptionPane/showMessageDialog frame "You Win!"))
                (.repaint this))
        (keyPressed [e]
            (update-direction snake (dirs (.getKeyCode e)))
            (update-direction ai-snake (intercept-direction @snake @ai-snake))) ;;Putting it here will make the pred track you on change
            ;;Update the direction of the ai-snake
        (getPreferredSize []
            (Dimension. (* (inc width) point-size)
                        (* (inc height) point-size)))
        (keyReleased [e])   ;;Ignore
        (keyTyped [e])))    ;;Ignore

(defn game []
    (let [snake (ref (create-snake (Color. 15 160 70)))
        apple (ref (create-apple))
        ai-snake (ref (create-snake (Color. 15 255 70)))
        frame (JFrame. "Snake")
        panel (game-panel frame snake apple ai-snake)
        timer (Timer. turn-millis panel)]
    (doto panel
        (.setFocusable true)
        (.addKeyListener panel))
    (doto frame
        (.add panel)
        (.pack)
        (.setVisible true))
    (.start timer)
    [snake, apple, timer]))
               
 (def test-snake (ref nil))
 (def test-ai (ref nil))
 (def test-apple (ref nil)) 

Today's Learning

Had a great day today.
I bought a copy of Cloud Application Architectures by George Reese on Friday, after getting hundreds of emails from the Sun Developer Network about cloud stuff. So today I spent the morning and mid afternoon signing up to Amazon web services and playing around with S3 and EC2. Then spent the afternoon continuing my progress through Real World Haskell, ending with my first file reader that parsed my list of EC2 servers and told me how many there were. Not exactly anything ground breaking but a lot of stuff learned. Now I'm off to read the next chapter of CAA.