Cool! If you want to make the Swing stuff more idiomatic, you could take a look at Seesaw <https://github.com/daveray/seesaw>.
On 2 August 2013 17:11, <[email protected]> wrote: > Below is a little (stupid) snake game I wrote using core.async and swing. > It uses channels for timer, keyboard input and repaint to make everything > nice and sequential. > Thought it could be a nice example of the power of core.async. > > I'm not an experienced clojure/lisp developer so I'd be happy if someone > could give me some feedback on the code. > Is it clojure idiomatic? > Am I using core.async properly? > etc. > > Thanks > --anders > > > (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)) > > > -- > -- > You received this message because you are subscribed to the Google > Groups "Clojure" group. > To post to this group, send email to [email protected] > Note that posts from new members are moderated - please be patient with > your first post. > To unsubscribe from this group, send email to > [email protected] > For more options, visit this group at > http://groups.google.com/group/clojure?hl=en > --- > You received this message because you are subscribed to the Google Groups > "Clojure" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to [email protected]. > For more options, visit https://groups.google.com/groups/opt_out. > > > -- -- You received this message because you are subscribed to the Google Groups "Clojure" group. To post to this group, send email to [email protected] Note that posts from new members are moderated - please be patient with your first post. To unsubscribe from this group, send email to [email protected] For more options, visit this group at http://groups.google.com/group/clojure?hl=en --- You received this message because you are subscribed to the Google Groups "Clojure" group. To unsubscribe from this group and stop receiving emails from it, send an email to [email protected]. For more options, visit https://groups.google.com/groups/opt_out.
