the snake game with core.async and swing

anders.clj

(ns my-test
  (use [midje.sweet])
  (require [clojure.core.async :as async :refer :all])
  (import [javax.swing JFrame JButton JPanel SwingUtilities])
  (import [java.awt Color Dimension])
  (import [java.awt.event ActionListener WindowAdapter KeyListener]))


(defn map-chan [f in]
  (let [c (chan)]
    (go (loop []
          (when-let [v (f (<! in))]
            (>! c v))
          (recur)))
    c))

(defn start-timer! []
  (let [c (chan)]
    (go (while true (<! (timeout 250)) (>! c :go)))
    c))

(defn closing-channel [frame]
  (let [c (chan)]
    (.addWindowListener frame
                        (proxy [WindowAdapter] []
                          (windowClosing [e] (put! c e))))
    c))

(defn array-of [coordinates index]
  (int-array (map #(nth % index) coordinates)))

(defn points-of [coordinates]
  [(array-of coordinates 0) (array-of coordinates 1)])

(defn draw-poly-line [canvas coordinates]
  (SwingUtilities/invokeLater
   (fn []
     (let [[x-points y-points] (points-of coordinates)
           g (.getGraphics canvas)
           prev-color (.getColor g)]
      (.setColor g Color/BLACK)
      (.drawPolyline g x-points y-points (count coordinates))
      (.setColor g prev-color)))))

(def step 5)
(defmulti calc-new-pos (fn[xy prev-pos dir] [xy dir]))
(defmethod calc-new-pos [:x :right][xy prev-pos dir] (+ prev-pos step))
(defmethod calc-new-pos [:x :left][xy prev-pos dir] (- prev-pos step))
(defmethod calc-new-pos [:y :down][xy prev-pos dir] (+ prev-pos step))
(defmethod calc-new-pos [:y :up][xy prev-pos dir] (- prev-pos step))
(defmethod calc-new-pos :default [xy prev-pos dir] prev-pos)

(defn calc-snake [dir snake-obj counter]
  (let [[l-x l-y] (last snake-obj)
        old-snake (if (= (mod counter 2) 0) snake-obj (rest snake-obj))]
    (conj (vec old-snake) [(calc-new-pos :x l-x dir) (calc-new-pos :y l-y dir)])))

(facts "snake positions"
       (fact "snake moves and grows"
             (calc-snake :right [[1 2]] 2) => [[1 2] [6 2]]
             (calc-snake :right [[2 2]] 4) => [[2 2] [7 2]])
       (facts "snake moves"
              (calc-snake :right [[1 2]] 1) => [[6 2]]
              (calc-snake :down [[1 2]] 1) => [[1 7]]
              (calc-snake :left [[10 2]] 1) => [[5 2]]
              (calc-snake :up [[10 7]] 1) => [[10 2]]
              ))

(def key-to-dir-map {37 :left, 38 :up, 39 :right, 40 :down})

(defn key-channel [obj]
  (let [c (chan)]
    (.addKeyListener obj
                     (reify KeyListener
                       (keyTyped [_ e] )
                       (keyPressed [_ e] )
                       (keyReleased [_ e]
                         (put! c e))))
    c))

(defn create-canvas [paint-channel]
  (proxy [JButton] []
                 (getPreferredSize [] (Dimension. 300 300))
                 (paintComponent [g]
                   (go
                     (proxy-super paintComponent g)
                     (>! paint-channel :repaint)))))

(defmulti inside-window? (fn [dir canvas pos] dir))
(defmethod inside-window? :left [dir canvas [x _]] (>= x (.getX canvas)))
(defmethod inside-window? :right [dir canvas [x _]] (<= x (+ (.getX canvas) (.getWidth canvas))))
(defmethod inside-window? :up [dir canvas [_ y]] (>= y (.getY canvas)))
(defmethod inside-window? :down [dir canvas [_ y]] (<= y (+ (.getY canvas) (.getHeight canvas))))



(def initial-snake (vec  (map (fn [x] [x 10])  (take 20 (iterate (partial + step) 0)))))


(defn game-rules-ok? [snake dir canvas]
  (and
   (apply distinct? snake)
   (inside-window? dir canvas (last snake))))

(facts "game rules"
       (let [canvas (JButton.)]
         (.setBounds canvas 0 0 10 10)
         (facts "inside window"
                (game-rules-ok? [[0 0]] :right canvas) => truthy
                (game-rules-ok? [[11 0]] :right canvas) => falsey
                (game-rules-ok? [[11 0]] :left canvas) => truthy
                (game-rules-ok? [[11 0]] :up canvas) => truthy
                (game-rules-ok? [[11 0]] :down canvas) => truthy
                (game-rules-ok? [[11 11]] :down canvas) => falsey)
         (facts "snake eating itself"
              (game-rules-ok? [[0 0] [0 0]] :right canvas) => falsey
              (game-rules-ok? [[0 0] [1 0]] :right canvas) => true
              )))
(defn you-loose! [cc]
  (println "you loose!")
  (put! cc :close))


(defn snake [cc]
  (let [paint-channel (chan)
        timer-channel (start-timer!)
        canvas (create-canvas paint-channel)
        dir-channel (map-chan #(key-to-dir-map (.getKeyCode %)) (key-channel canvas))
        ]
    (go
     (loop [last-dir :right
               snake-obj initial-snake
               counter 0]
          (let [[v c] (alts! [paint-channel dir-channel timer-channel])]
            (condp = c
              timer-channel
              (do
                (put! dir-channel last-dir)
                (recur last-dir snake-obj counter))
              paint-channel
              (do
                (draw-poly-line canvas snake-obj)
                (recur last-dir snake-obj counter))
              dir-channel
              (do
                (.repaint canvas (.getBounds canvas))
                (let [new-snake (calc-snake v snake-obj counter)]
                  (if (game-rules-ok? new-snake v canvas)
                    (recur v new-snake (inc counter))
                    (you-loose! cc)
                    )))
              ))))
    canvas))

(defn frame []
  (let [f (JFrame.)
      cc (closing-channel f)]
    (.add (.getContentPane f) (snake cc))
    (.pack f)
    (.setVisible f true)
    (go
     (<! cc)
     (println "bye!")
     (.setVisible f false))
    f))

From mailing list, for easier reading:

https://groups.google.com/forum/#!topic/clojure/VlUjA_WnMfc