diff options
| -rw-r--r-- | net/ricketyspace/ror/six/resources/body.gif | bin | 0 -> 1079 bytes | |||
| -rw-r--r-- | net/ricketyspace/ror/six/resources/goo.gif | bin | 0 -> 878 bytes | |||
| -rw-r--r-- | net/ricketyspace/ror/six/resources/head.gif | bin | 0 -> 776 bytes | |||
| -rw-r--r-- | net/ricketyspace/ror/six/resources/tail.gif | bin | 0 -> 1079 bytes | |||
| -rw-r--r-- | net/ricketyspace/ror/six/snake.rkt | 216 |
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 Binary files differnew file mode 100644 index 0000000..94a0956 --- /dev/null +++ b/net/ricketyspace/ror/six/resources/body.gif diff --git a/net/ricketyspace/ror/six/resources/goo.gif b/net/ricketyspace/ror/six/resources/goo.gif Binary files differnew file mode 100644 index 0000000..cb0d98b --- /dev/null +++ b/net/ricketyspace/ror/six/resources/goo.gif diff --git a/net/ricketyspace/ror/six/resources/head.gif b/net/ricketyspace/ror/six/resources/head.gif Binary files differnew file mode 100644 index 0000000..664f679 --- /dev/null +++ b/net/ricketyspace/ror/six/resources/head.gif diff --git a/net/ricketyspace/ror/six/resources/tail.gif b/net/ricketyspace/ror/six/resources/tail.gif Binary files differnew file mode 100644 index 0000000..6fbd317 --- /dev/null +++ b/net/ricketyspace/ror/six/resources/tail.gif 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))) |
