Pong

(ns pong.core
  (:gen-class))
(import '(javax.swing JFrame))
(import '(java.awt Color Toolkit Image Font GraphicsEnvironment Graphics2D))
(import '(java.awt.image BufferedImage))
(import '(java.awt.event KeyListener WindowAdapter KeyEvent))
(def width  (atom 600))
(def height (atom 300))
(defn get-time [& args] (System/currentTimeMillis))

(defn elapsed-time [t]
  (- (get-time) t))

(defn sleep [n]
  (Thread/sleep n)
  )
(defstruct paddle :y :vy :x)
(def pdl1 (atom (struct paddle (rand-int 300) 0 20)))
(def pdl2 (atom (struct paddle (rand-int 300) 0 570)))
(def keys-pressed (atom {}))

(defstruct ball :h :w :x :y :vx :vy)
(def score1 (atom 0))
(def score2 (atom 0))
(defn createball [w h x y vx vy] (struct ball w h x y vx vy))
(def mainball (atom (createball 5 5 300 150 (- (rand-int 5) 2) (- (rand-int 5) 2))))
(defn updateball [b] (swap! b assoc :x (+ (@b :vx) (@b :x)) :y (+ (@b :y) (@b :vy))))
(defn updateAI [pdle]
  (if (< (+ (@pdle :y) 15) (@mainball :y))
    (swap! pdle assoc :vy (+ (@pdle :vy) 0.3))
    0)
  (if (> (+ (@pdle :y) 15) (@mainball :y))
    (swap! pdle assoc :vy (- (@pdle :vy) 0.3))
    0)
  )
(defn updatePC [pdle]
  (if (contains? @keys-pressed (KeyEvent/VK_DOWN))
    (swap! pdle assoc :vy (+ (@pdle :vy) 0.3))
    0)
  (if (contains? @keys-pressed (KeyEvent/VK_UP))
    (swap! pdle assoc :vy (- (@pdle :vy) 0.3))
    0)
  )
(defn updatepaddle [pdl]
  (swap! pdl assoc :y (+ (@pdl :vy) (@pdl :y)))
  (if (> (@pdl :vy) 2)
    (swap! pdl assoc :vy 2)
    0)
  (if (< (@pdl :vy) -2)
    (swap! pdl assoc :vy -2)
    0)
  (if (> (+ (@pdl :y) 30) @height)
    (do
      (swap! pdl assoc :y (- @height 30))
      (swap! pdl assoc :vy (* (@pdl :vy) -1))
      )
    0
    )
  (if (< (@pdl :y) 0)
    (do
      (swap! pdl assoc :y 0)
      (swap! pdl assoc :vy (* (@pdl :vy) -1))
      )
    0
    )
  (swap! pdl assoc :vy (* (@pdl :vy) 0.95))
  )
(defn colliding? [b p]
  (let [bx (@b  :x)
        by (@b  :y)
        bw (@b  :w)
        bh (@b  :h)
        px (+ (@p  :x) (* (/ 10 2) 1.0))
        py (+ (@p  :y) (* (/ 30 2) 1.0))
        hpw (* (/ 10 2) 1.0)
        hph (* (/ 30 2) 1.0)
        ]
    (and
      (or
        (and (>= (+ bx bw) (- px hpw))  (<= (+ bx bw) (+ px hpw)))
        (and (>=  bx (- px hpw))  (<= bx (+ px hpw)))
        )
      (or
        (and (>= (+ by bh) (- py hph))  (<= (+ by bh) (+ py hph)))
        (and (>=  by (- py hph))  (<= by (+ py hph)))
        )
      )
    )
  )
(defn gmover-msg [x]
  (if (= @score1 3)
      "YOU LOSE!"
      "YOU WIN!"))
(declare disp)
(def center-msg (atom ""))
(defn update [frame bbuf]
  (if (= (@mainball :vx) 0)
    (swap! mainball assoc :vx 1)
    0)
  (if (= (@mainball :vy) 0)
    (swap! mainball assoc :vy 1)
    0)
  (updateball mainball)
  (updateAI pdl1)
  (updatePC pdl2)
  (updatepaddle pdl1)
  (updatepaddle pdl2)
  (if (>= (+ (@mainball :x) (@mainball :w)) @width)
    (do
      (def mainball (atom (createball 5 5 300 150 (- (rand-int 5) 2) (- (rand-int 5) 2 ))))
      (swap! score1 inc)
      )
    0)
  (if (<= (@mainball :x) 0)
    (do
      (def mainball (atom (createball 5 5 300 150 (- (rand-int 5) 2) (- (rand-int 5) 2 ))))
      (swap! score2 inc)
      )
    0)
  (if (>= (+ (@mainball :y) (@mainball :h)) @height)
    (swap! mainball assoc :vy (* (@mainball :vy) -1))
    0)
  (if (<= (- (@mainball :y) 0) 0)
    (swap! mainball assoc :vy (* (@mainball :vy) -1))
    0)
  (if (colliding? mainball pdl1)
    (do
      (swap! mainball assoc :vx (* (@mainball :vx) -1.2) :vy (* (@mainball :vy) 1.2))
      (swap! mainball assoc :vy (+ (@mainball :vy) (* (@pdl1 :vy) 0.2)))
      )
    0)
  (if (colliding? mainball pdl2)
    (do
      (swap! mainball assoc :vx (* (@mainball :vx) -1.2) :vy (* (@mainball :vy) 1.2))
      (swap! mainball assoc :vy (+ (@mainball :vy) (* (@pdl2 :vy) 0.2)))
      )
    0)
  (if (or (= @score1 3) (= @score2 3) (contains? @keys-pressed (KeyEvent/VK_ESCAPE)))
    (do
    (swap! center-msg gmover-msg)
      (disp frame bbuf)
      (println "TESTING")
      (Thread/sleep 3000)
      (System/exit 0))
    0)
  )


(def running (atom true))



(def exit-action (proxy [WindowAdapter] []
                   (windowClosing [e] (System/exit 0))))
(defn keypress [ch]
  (swap! keys-pressed assoc ch true))
(defn keyrelease [ch]
  (swap! keys-pressed dissoc ch ))
(def key-action (proxy [KeyListener] []
                  (keyPressed [e]  (keypress (.getKeyCode e)))
                  (keyReleased [e] (keyrelease (.getKeyCode e)))
                  (keyTyped [e] 0)
                  ))
(defn make-frame [width height title]
  (JFrame/setDefaultLookAndFeelDecorated true)
  (let [f (JFrame. title)]
    (.setBounds f width height width height)
    (.setResizable f false)
    (.setFocusable f true)
    (.setVisible f true)
    (.addWindowListener f exit-action)
    (.addKeyListener  f key-action)
    f))
(defn disp  [frame bbuf]
  (let [g (.getGraphics bbuf) gg (.getGraphics frame)]
    (.setColor g (Color/BLACK))
    (.fillRect g 0 0 @width @height)
    (.setColor g (Color/WHITE))
    (.fillRect g (@mainball :x) (@mainball :y) (@mainball :w) (@mainball :h))
    (.fillRect g (@pdl1 :x) (@pdl1 :y) 10 30)
    (.fillRect g (@pdl2 :x) (@pdl2 :y) 10 30)
    (.drawString g (str "SCORE: " @score1) 20 20)
    (.drawString g (str "SCORE: " @score2) 530 20)
    (.drawString g @center-msg  260 140)
    (.drawImage gg bbuf 0 0 frame)
    ))
(def pressed-keys (atom {}))
(defn on-keypress [ch]
  (assoc pressed-keys (keyword (str ch)) true))
(defn on-keyrelease [ch]
  (assoc pressed-keys (keyword (str ch)) nil))
(defn run [frame]
  (let [pt (atom (get-time))
        bbuf (BufferedImage. @width @height BufferedImage/TYPE_INT_RGB)
        ]
    (loop []
      (do
        (if (> (elapsed-time @pt) 15)
          (loop [ct (elapsed-time @pt)]
            (if (> ct 15)
              (do (update frame bbuf) (recur (- ct 15)))
              (swap! pt get-time)))
          0)
        (disp frame bbuf)
        (if (= @running true)
          (recur)
          (System/exit 0)
          )
        )
      )
    )
  )


(def st (atom (get-time)))
(defn -main [& args]  (run (make-frame @width @height "Pong") ))