Permalink
Browse files

Pong more or less works - match vars don't propagate across condition…

…s yet, so the rules are pretty verbose.
  • Loading branch information...
1 parent 39d85ce commit 8a2b35b9afaad59312cd869adbbf82f3cca8519e @hraberg committed Aug 18, 2012
Showing with 74 additions and 36 deletions.
  1. +3 −1 README.md
  2. BIN resources/pong.png
  3. +1 −1 src/mimir/match.clj
  4. +1 −0 src/mimir/well.clj
  5. +69 −34 test/mimir/test/pong.clj
View
@@ -131,9 +131,11 @@ For more, see [`mimir.test`](https://github.com/hraberg/mimir/tree/master/test/m
[This example](https://github.com/hraberg/mimir/blob/master/test/mimir/test/pong.clj) is an attempt to write something less trivial where the working memory keeps changing. It doesn't fully work yet but has shown many weaknesses in the assumptions made in Mímir which needs addressing. It uses [`clojure-lanterna`](https://github.com/sjl/clojure-lanterna/) for text UI.
+Its pretty buggy for many different reasons, as well as verbose.
+
lein trampoline run -m mimir.test.pong
-(The ball doesn't collide with the paddles yet.)
+<img src=https://github.com/hraberg/mimir/raw/master/resources/pong.png alt="Mímir Pong" title="Mímir Pong" />
#### Pattern Matching
View
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
View
@@ -17,7 +17,7 @@
(defn maybe-singleton-coll [x]
(if (singleton-coll? x) (first x) x))
-(def ^:dynamic *match-var?* #(and (symbol? %) (not (or (resolve %) (re-matches #".*#"(name %))))))
+(def ^:dynamic *match-var?* #(and (symbol? %) (not (or (resolve %) ('#{do fn* let* if} %) (re-matches #".*#"(name %))))))
(def ^:dynamic *var-symbol* symbol)
View
@@ -97,6 +97,7 @@
(alter-var-root #'*match-var?* (constantly #(and (symbol? %)
(not (or (resolve %) (is-var? %)
+ ('#{do fn* let* if} %)
(re-matches #"\..*"(name %))
(re-matches #".*\."(name %))
(re-matches #".*#"(name %)))))))
View
@@ -1,37 +1,34 @@
(ns mimir.test.pong
- (:use [mimir.well :only (update rule fact facts retract reset run* run-once is-not)]
+ (:use [mimir.well :only (update rule fact facts reset run* is-not)]
[mimir.match :only (condm truth)]
[mimir.test.common]
[clojure.test])
- (:require [lanterna.screen :as s]
- [lanterna.terminal :as t]))
+ (:require [lanterna.screen :as s]))
(reset)
(def x 0)
(def y 1)
-(defn bounce [axis]
- (update :speed [:speed axis] -))
-
-(defn place-ball [width height]
- (update :ball [:ball] [(int (/ width 2)) (rand-int height)]))
-
-(defn score [who width height]
- (place-ball width height)
- (update {:player who} [:score] inc))
+(def paddle-size 5)
-(facts {:ball [0 0]}
+(facts {:ball [10 10]}
{:speed [1 1]})
-(rule move
+(rule move-ball
{:speed [dx dy]}
=>
(update :ball [:ball] #(mapv + [dx dy] %)))
+(defn place-ball [width height]
+ (update :ball [:ball] [(int (/ width 2)) (rand-int height)]))
+
+(defn score [who]
+ (update {:player who} [:score] inc))
+
(rule left-wall
{:screen [width height]}
@@ -40,7 +37,8 @@
=>
- (score :computer width height))
+ (place-ball width height)
+ (score :computer))
(rule right-wall
@@ -50,8 +48,24 @@
=>
- (score :human width height))
+ (place-ball width height)
+ (score :human))
+
+
+(defn bounce [axis]
+ (update :speed [:speed axis] -))
+
+(rule ball-hits-paddle
+ ?ball :ball
+ ?speed :speed
+ {:paddle [(+ (get-in ?speed [:speed x])
+ (get-in ?ball [:ball x]))
+ #(<= % (get-in ?ball [:ball y]) (+ paddle-size %))]}
+
+ =>
+
+ (bounce x))
(rule floor
@@ -72,18 +86,6 @@
(bounce y))
-(declare screen)
-
-(def colors {:fg :white :bg :black})
-(def reverse-video {:fg (:bg colors) :bg (:fg colors)})
-
-(def paddle-size 5)
-(def paddle-margin 2)
-(def score-line 2)
-
-(defn above-bottom? [y py]
- (and (> (- y paddle-size) py)))
-
(defn move-paddle [who direction]
(update {:player who} [:paddle y] direction))
@@ -99,14 +101,40 @@
(rule paddle-down
{:key :down}
- {:screen [_ height]}
-; {:player :human :paddle [_ (partial above-bottom? height)]}
-; (< py (- height paddle-size))
+ ?screen :screen
+ ?paddle {:player :human}
+
+ (<= (+ paddle-size (get-in ?paddle [:paddle y])) (get-in ?screen [:screen y]))
=>
(move-paddle :human inc))
+(defn middle-of-paddle [y]
+ (+ (int (/ paddle-size 2)) y))
+
+(rule paddle-up-ai
+
+ ?ball :ball
+ {:player :computer :paddle [_ #(< (get-in ?ball [:ball y]) (middle-of-paddle %))]}
+ {:player :computer :paddle [_ pos?]}
+
+ =>
+
+ (move-paddle :computer dec))
+
+(rule paddle-down-ai
+
+ ?ball :ball
+ ?screen :screen
+
+ ?paddle {:player :computer :paddle [_ #(> (get-in ?ball [:ball y]) (middle-of-paddle %))]}
+ (<= (+ paddle-size (get-in ?paddle [:paddle y])) (get-in ?screen [:screen y]))
+
+ =>
+
+ (move-paddle :computer inc))
+
(rule exit
{:key :escape}
@@ -115,6 +143,11 @@
:exit)
+(declare screen)
+
+(def colors {:fg :white :bg :black})
+(def reverse-video {:fg (:bg colors) :bg (:fg colors)})
+
(defn blank []
(s/clear screen)
(s/redraw screen)
@@ -169,15 +202,17 @@
(place-ball x y)
- (paddle :human paddle-margin (center y paddle-size))
- (paddle :computer (- x paddle-margin) (center y paddle-size))
+ (paddle :human 2 (center y paddle-size))
+ (paddle :computer (- x 2) (center y paddle-size))
(s/redraw screen))
(defn frame [events]
(Thread/sleep 25)
(s/redraw screen)
- (update {:key truth} [:key] (s/get-key screen))
+ (update {:key truth} [:key] (->> (repeatedly #(s/get-key screen))
+ (take-while identity)
+ last))
events)
(defn handle-event [e]

0 comments on commit 8a2b35b

Please sign in to comment.