summaryrefslogtreecommitdiffstats
path: root/net/ricketyspace/ror/six
diff options
context:
space:
mode:
Diffstat (limited to 'net/ricketyspace/ror/six')
-rw-r--r--net/ricketyspace/ror/six/resources/body.gifbin0 -> 1079 bytes
-rw-r--r--net/ricketyspace/ror/six/resources/goo.gifbin0 -> 878 bytes
-rw-r--r--net/ricketyspace/ror/six/resources/head.gifbin0 -> 776 bytes
-rw-r--r--net/ricketyspace/ror/six/resources/tail.gifbin0 -> 1079 bytes
-rw-r--r--net/ricketyspace/ror/six/snake.rkt216
5 files changed, 216 insertions, 0 deletions
diff --git a/net/ricketyspace/ror/six/resources/body.gif b/net/ricketyspace/ror/six/resources/body.gif
new file mode 100644
index 0000000..94a0956
--- /dev/null
+++ b/net/ricketyspace/ror/six/resources/body.gif
Binary files differ
diff --git a/net/ricketyspace/ror/six/resources/goo.gif b/net/ricketyspace/ror/six/resources/goo.gif
new file mode 100644
index 0000000..cb0d98b
--- /dev/null
+++ b/net/ricketyspace/ror/six/resources/goo.gif
Binary files differ
diff --git a/net/ricketyspace/ror/six/resources/head.gif b/net/ricketyspace/ror/six/resources/head.gif
new file mode 100644
index 0000000..664f679
--- /dev/null
+++ b/net/ricketyspace/ror/six/resources/head.gif
Binary files differ
diff --git a/net/ricketyspace/ror/six/resources/tail.gif b/net/ricketyspace/ror/six/resources/tail.gif
new file mode 100644
index 0000000..6fbd317
--- /dev/null
+++ b/net/ricketyspace/ror/six/resources/tail.gif
Binary files differ
diff --git a/net/ricketyspace/ror/six/snake.rkt b/net/ricketyspace/ror/six/snake.rkt
new file mode 100644
index 0000000..90d40d3
--- /dev/null
+++ b/net/ricketyspace/ror/six/snake.rkt
@@ -0,0 +1,216 @@
+#lang racket
+(require 2htdp/universe 2htdp/image)
+
+;; data
+(struct pit (snake goos))
+(struct snake (dir segs))
+(struct goo (loc expire))
+(struct posn (x y))
+
+;; constants
+(define TICK-RATE 1/10)
+
+(define SIZE 30)
+
+(define SEG-SIZE 15)
+
+(define EXPIRATION-TIME 150)
+
+(define WIDTH-PX (* SEG-SIZE 30))
+(define HEIGHT-PX (* SEG-SIZE 30))
+
+(define MT-SCENE (empty-scene WIDTH-PX HEIGHT-PX))
+(define GOO-IMG (bitmap "resources/goo.gif"))
+(define SEG-IMG (bitmap "resources/body.gif"))
+(define HEAD-IMG (bitmap "resources/head.gif"))
+
+(define HEAD-LEFT-IMG HEAD-IMG)
+(define HEAD-DOWN-IMG (rotate 90 HEAD-LEFT-IMG))
+(define HEAD-RIGHT-IMG (flip-horizontal HEAD-LEFT-IMG))
+(define HEAD-UP-IMG (flip-vertical HEAD-DOWN-IMG))
+
+(define ENDGAME-TEXT-SIZE 15)
+
+;; main
+(define (start-snake)
+ (big-bang (pit (snake "right" (list (posn 1 1)))
+ (list (fresh-goo)
+ (fresh-goo)
+ (fresh-goo)
+ (fresh-goo)
+ (fresh-goo)
+ (fresh-goo)))
+ (on-tick next-pit TICK-RATE)
+ (on-key direct-snake)
+ (to-draw render-pit)
+ (stop-when dead? render-end)))
+
+(define (next-pit w)
+ (define snake (pit-snake w))
+ (define goos (pit-goos w))
+ (define goo-to-eat (can-eat snake goos))
+ (if goo-to-eat
+ (pit (grow snake) (age-goo (eat goos goo-to-eat)))
+ (pit (slither snake) (age-goo goos))))
+
+(define (direct-snake w ke)
+ (cond [(dir? ke) (world-change-dir w ke)]
+ [else w]))
+
+(define (render-pit w)
+ (snake+scene (pit-snake w)
+ (goo-list+scene (pit-goos w) MT-SCENE)))
+
+(define (dead? w)
+ (define snake (pit-snake w))
+ (or (self-colliding? snake) (wall-colliding? snake)))
+
+(define (render-end w)
+ (overlay (text "Game Over" ENDGAME-TEXT-SIZE "black")
+ (render-pit w)))
+
+
+;; clock
+(define (can-eat snake goos)
+ (cond [(empty? goos) #f]
+ [else (if (close? (snake-head snake) (first goos))
+ (first goos)
+ (can-eat snake (rest goos)))]))
+
+(define (eat goos goo-to-eat)
+ (cons (fresh-goo) (remove goo-to-eat goos)))
+
+(define (close? s g)
+ (posn=? s (goo-loc g)))
+
+(define (grow sn)
+ (snake (snake-dir sn)
+ (cons (next-head sn) (snake-segs sn))))
+
+(define (slither sn)
+ (snake (snake-dir sn)
+ (cons (next-head sn) (all-but-last (snake-segs sn)))))
+
+(define (next-head sn)
+ (define head (snake-head sn))
+ (define dir (snake-dir sn))
+ (cond [(string=? dir "up") (posn-move head 0 -1)]
+ [(string=? dir "down") (posn-move head 0 1)]
+ [(string=? dir "left") (posn-move head -1 0)]
+ [(string=? dir "right") (posn-move head 1 0)]))
+
+(define (posn-move p dx dy)
+ (posn (+ (posn-x p) dx)
+ (+ (posn-y p) dy)))
+
+(define (all-but-last segs)
+ (cond [(empty? (rest segs)) empty]
+ [else (cons (first segs) (all-but-last (rest segs)))]))
+
+(define (age-goo goos)
+ (rot (renew goos)))
+
+(define (renew goos)
+ (cond [(empty? goos) empty]
+ [(rotten? (first goos))
+ (cons (fresh-goo) (renew (rest goos)))]
+ [else
+ (cons (first goos) (renew (rest goos)))]))
+
+(define (rot goos)
+ (cond [(empty? goos) empty]
+ [else (cons (decay (first goos)) (rot (rest goos)))]))
+
+(define (rotten? g)
+ (zero? (goo-expire g)))
+
+(define (decay g)
+ (goo (goo-loc g) (sub1 (goo-expire g))))
+
+(define (fresh-goo)
+ (goo (posn (add1 (random (sub1 SIZE)))
+ (add1 (random (sub1 SIZE))))
+ EXPIRATION-TIME))
+
+
+;; keys
+(define (dir? x)
+ (or (key=? x "up")
+ (key=? x "down")
+ (key=? x "left")
+ (key=? x "right")))
+
+(define (world-change-dir w d)
+ (define the-snake (pit-snake w))
+ (cond [(and (opposite-dir? (snake-dir the-snake) d)
+ (cons? (rest (snake-segs the-snake))))
+ (stop-with w)]
+ [else
+ (pit (snake-change-dir the-snake d) (pit-goos w))]))
+
+(define (opposite-dir? d1 d2)
+ (cond [(string=? d1 "up") (string=? d2 "down")]
+ [(string=? d1 "down") (string=? d2 "up")]
+ [(string=? d1 "left") (string=? d2 "right")]
+ [(string=? d1 "right") (string=? d2 "left")]))
+
+
+;; render
+(define (snake+scene snake scene)
+ (define snake-body-scene
+ (img-list+scene (snake-body snake) SEG-IMG scene))
+ (define dir (snake-dir snake))
+ (img+scene (snake-head snake)
+ (cond [(string=? "up" dir) HEAD-UP-IMG]
+ [(string=? "down" dir) HEAD-DOWN-IMG]
+ [(string=? "left" dir) HEAD-LEFT-IMG]
+ [(string=? "right" dir) HEAD-RIGHT-IMG])
+ snake-body-scene))
+
+(define (goo-list+scene goos scene)
+ (define (get-posns-from-goo goos)
+ (cond [(empty? goos) empty]
+ [else (cons (goo-loc (first goos))
+ (get-posns-from-goo (rest goos)))]))
+ (img-list+scene (get-posns-from-goo goos) GOO-IMG scene))
+
+(define (img-list+scene posns img scene)
+ (cond [(empty? posns) scene]
+ [else (img+scene
+ (first posns)
+ img
+ (img-list+scene (rest posns) img scene))]))
+
+(define (img+scene posn img scene)
+ (place-image img
+ (* (posn-x posn) SEG-SIZE)
+ (* (posn-y posn) SEG-SIZE)
+ scene))
+
+
+;; end game
+(define (self-colliding? snake)
+ (cons? (member (snake-head snake) (snake-body snake))))
+
+(define (wall-colliding? snake)
+ (define x (posn-x (snake-head snake)))
+ (define y (posn-y (snake-head snake)))
+ (or (= 0 x) (= x SIZE)
+ (= 0 y) (= y SIZE)))
+
+;; aux
+(define (posn=? p1 p2)
+ (and (= (posn-x p1) (posn-x p2))
+ (= (posn-y p1) (posn-y p2))))
+
+(define (snake-head sn)
+ (first (snake-segs sn)))
+
+(define (snake-body sn)
+ (rest (snake-segs sn)))
+
+(define (snake-tail sn)
+ (last (snake-segs sn)))
+
+(define (snake-change-dir sn d)
+ (snake d (snake-segs sn)))