Guest User

Untitled

a guest
Oct 17th, 2017
125
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. ; START: namespace
  2. (ns reader.snake
  3.   (:import (java.awt Color Dimension)
  4.      (javax.swing JPanel JFrame Timer JOptionPane)
  5.            (java.awt.event ActionListener KeyListener))
  6.   (:use clojure.contrib.import-static
  7.   [clojure.contrib.seq-utils :only (includes?)]))
  8. (import-static java.awt.event.KeyEvent VK_LEFT VK_RIGHT VK_UP VK_DOWN)
  9. ; END: namespace
  10.  
  11. (def width 75)
  12. (def height 50)
  13. (def point-size 10)
  14. (def turn-millis 75)
  15. (def win-length 5)
  16. (def dirs { VK_LEFT  [-1  0]
  17.             VK_RIGHT [ 1  0]
  18.             VK_UP    [ 0 -1]
  19.             VK_DOWN  [ 0  1]})
  20.  
  21. (defn add-points [& pts]
  22.   (vec (apply map + pts)))
  23.  
  24. (defn point-to-screen-rect [pt]
  25.   (map #(* point-size %)
  26.        [(pt 0) (pt 1) 1 1]))
  27.  
  28. (defn create-apple []
  29.   {:location [(rand-int width) (rand-int height)]
  30.    :color (Color. 210 50 90)
  31.    :type :apple})
  32.  
  33. (defn create-snake []
  34.   {:body (list [1 1])
  35.    :dir [1 0]
  36.    :type :snake
  37.    :color (Color. 15 160 70)})
  38.  
  39. (defn move [{:keys [body dir] :as snake} & grow]
  40.   (assoc snake :body (cons (add-points (first body) dir)
  41.                            (if grow body (butlast body)))))
  42.  
  43. (defn win? [{body :body}]
  44.   (>= (count body) win-length))
  45.  
  46. (defn head-overlaps-body? [{[head & body] :body}]
  47.   (includes? body head))
  48.  
  49. (def lose? head-overlaps-body?)
  50.  
  51. (defn eats? [{[snake-head] :body} {apple :location}]
  52.   (= snake-head apple))
  53.  
  54. (defn turn [snake newdir]
  55.   (assoc snake :dir newdir))
  56.  
  57. (defn reset-game [snake apple]
  58.   (dosync (ref-set apple (create-apple))
  59.           (ref-set snake (create-snake)))
  60.   nil)
  61.  
  62. (defn update-direction [snake newdir]
  63.   (when newdir (dosync (alter snake turn newdir))))
  64.  
  65. (defn update-positions [snake apple]
  66.   (dosync
  67.     (if (eats? @snake @apple)
  68.       (do (ref-set apple (create-apple))
  69.           (alter snake move :grow))
  70.       (alter snake move)))
  71.   nil)
  72.  
  73. (defn fill-point [g pt color]
  74.   (let [[x y width height] (point-to-screen-rect pt)]
  75.     (.setColor g color)
  76.     (.fillRect g x y width height)))
  77.  
  78. (defmulti paint (fn [g object & _] (:type object)))
  79.  
  80. (defmethod paint :apple [g {:keys [location color]}]
  81.   (fill-point g location color))
  82.  
  83. (defmethod paint :snake [g {:keys [body color]}]
  84.   (doseq [point body]
  85.     (fill-point g point color)))
  86.  
  87. (defn game-panel [frame snake apple]
  88.   (proxy [JPanel ActionListener KeyListener] []
  89.     (paintComponent [g]
  90.       (proxy-super paintComponent g)
  91.       (paint g @snake)
  92.       (paint g @apple))
  93.     (actionPerformed [e]
  94.       (update-positions snake apple)
  95.       (when (lose? @snake)
  96.         (reset-game snake apple)
  97.         (JOptionPane/showMessageDialog frame "You lose!"))
  98.       (when (win? @snake)
  99.         (reset-game snake apple)
  100.         (JOptionPane/showMessageDialog frame "You win!"))
  101.       (.repaint this))
  102.     (keyPressed [e]
  103.       (update-direction snake (dirs (.getKeyCode e))))
  104.     (getPreferredSize []
  105.       (Dimension. (* (inc width) point-size)
  106.                   (* (inc height) point-size)))
  107.     (keyReleased [e])
  108.     (keyTyped [e])))
  109.  
  110. (defn game []
  111.   (let [snake (ref (create-snake))
  112.         apple (ref (create-apple))
  113.         frame (JFrame. "Snake")
  114.         panel (game-panel frame snake apple)
  115.         timer (Timer. turn-millis panel)]
  116.     (doto panel
  117.       (.setFocusable true)
  118.       (.addKeyListener panel))
  119.     (doto frame
  120.       (.add panel)
  121.       (.pack)
  122.       (.setVisible true))
  123.     (.start timer)
  124.     [snake, apple, timer]))
Add Comment
Please, Sign In to add comment