From 4978f48ca3455e59c1e7a867b3c62e2fd2c76dd2 Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Wed, 13 Jun 2018 01:06:23 +0000 Subject: net: snake.rkt: Add obstacles. * net/ricketyspace/ror/six/resources/obstacle.gif: New file. * net/ricketyspace/ror/six/snake.rkt (pit): Update struct. (obstactle): New struct. (OBSTACLE-EXPIRATION-TIME, OBSTACLE-IMG): New constants. (start-snake, next-pit, render-pit, dead?, world-change-dir): Update functions. (age-obstacle, renew-obstacles, rot-obstacles, obstacle-expired?) (decay-obstacle, fresh-obstacle, obstacle-list+scene) (obstacle-colliding?): New functions. --- net/ricketyspace/ror/six/resources/obstacle.gif | Bin 0 -> 667 bytes net/ricketyspace/ror/six/snake.rkt | 71 +++++++++++++++++++++--- 2 files changed, 64 insertions(+), 7 deletions(-) create mode 100644 net/ricketyspace/ror/six/resources/obstacle.gif diff --git a/net/ricketyspace/ror/six/resources/obstacle.gif b/net/ricketyspace/ror/six/resources/obstacle.gif new file mode 100644 index 0000000..6ff288e Binary files /dev/null and b/net/ricketyspace/ror/six/resources/obstacle.gif differ diff --git a/net/ricketyspace/ror/six/snake.rkt b/net/ricketyspace/ror/six/snake.rkt index 7472609..c57b01c 100644 --- a/net/ricketyspace/ror/six/snake.rkt +++ b/net/ricketyspace/ror/six/snake.rkt @@ -2,9 +2,10 @@ (require 2htdp/universe 2htdp/image) ;; data -(struct pit (snake goos dinged)) +(struct pit (snake goos obstacles dinged)) (struct snake (dir segs)) (struct goo (loc expire type)) +(struct obstacle (loc expire)) (struct posn (x y)) ;; constants @@ -15,6 +16,7 @@ (define SEG-SIZE 15) (define EXPIRATION-TIME 150) +(define OBSTACLE-EXPIRATION-TIME 250) (define WIDTH-PX (* SEG-SIZE 30)) (define HEIGHT-PX (* SEG-SIZE 30)) @@ -22,6 +24,7 @@ (define MT-SCENE (empty-scene WIDTH-PX HEIGHT-PX)) (define GOO-IMG (bitmap "resources/goo.gif")) (define GOO-RED-IMG (bitmap "resources/goo-red.gif")) +(define OBSTACLE-IMG (bitmap "resources/obstacle.gif")) (define SEG-IMG (bitmap "resources/body.gif")) (define HEAD-IMG (bitmap "resources/head.gif")) @@ -40,7 +43,10 @@ (fresh-goo) (fresh-goo) (fresh-goo) - (fresh-goo)) 0) + (fresh-goo)) + (list (fresh-obstacle) + (fresh-obstacle)) + 0) (on-tick next-pit TICK-RATE) (on-key direct-snake) (to-draw render-pit) @@ -49,12 +55,16 @@ (define (next-pit w) (define snake (pit-snake w)) (define goos (pit-goos w)) + (define obstacles (pit-obstacles w)) (define dinged (pit-dinged w)) (define goo-to-eat (can-eat snake goos)) (if goo-to-eat (pit (grow-size snake (goo-type goo-to-eat)) - (age-goo (eat goos goo-to-eat)) (+ 1 dinged)) - (pit (slither snake) (age-goo goos) dinged))) + (age-goo (eat goos goo-to-eat)) + (age-obstacle obstacles) (+ 1 dinged)) + (pit (slither snake) + (age-goo goos) + (age-obstacle obstacles) dinged))) (define (direct-snake w ke) (cond [(dir? ke) (world-change-dir w ke)] @@ -62,11 +72,15 @@ (define (render-pit w) (snake+scene (pit-snake w) - (goo-list+scene (pit-goos w) MT-SCENE))) + (goo-list+scene (pit-goos w) + (obstacle-list+scene + (pit-obstacles w) MT-SCENE)))) (define (dead? w) (define snake (pit-snake w)) - (or (self-colliding? snake) (wall-colliding? snake))) + (or (self-colliding? snake) + (wall-colliding? snake) + (obstacle-colliding? snake (pit-obstacles w)))) (define (render-end w) (overlay (above (text "Game Over" ENDGAME-TEXT-SIZE "black") @@ -151,6 +165,32 @@ (let ((n (random 3))) (gen-goos n))) +(define (age-obstacle obstacles) + (rot-obstacles (renew-obstacles obstacles))) + +(define (renew-obstacles obstacles) + (cond [(empty? obstacles) empty] + [(obstacle-expired? (first obstacles)) + (cons (fresh-obstacle) (renew-obstacles (rest obstacles)))] + [else + (cons (first obstacles) (renew-obstacles (rest obstacles)))])) + +(define (rot-obstacles obstacles) + (cond [(empty? obstacles) empty] + [else (cons (decay-obstacle (first obstacles)) + (rot-obstacles (rest obstacles)))])) + +(define (obstacle-expired? obs) + (zero? (obstacle-expire obs))) + +(define (decay-obstacle obs) + (obstacle (obstacle-loc obs) (sub1 (obstacle-expire obs)))) + +(define (fresh-obstacle) + (obstacle (posn (add1 (random (sub1 SIZE))) + (add1 (random (sub1 SIZE)))) + OBSTACLE-EXPIRATION-TIME)) + ;; keys (define (dir? x) (or (key=? x "up") @@ -164,7 +204,10 @@ (cons? (rest (snake-segs the-snake)))) (stop-with w)] [else - (pit (snake-change-dir the-snake d) (pit-goos w) (pit-dinged w))])) + (pit (snake-change-dir the-snake d) + (pit-goos w) + (pit-obstacles w) + (pit-dinged w))])) (define (opposite-dir? d1 d2) (cond [(string=? d1 "up") (string=? d2 "down")] @@ -196,6 +239,14 @@ (img-list+scene (get-posns-from-goo goos 2) GOO-RED-IMG scene))) +(define (obstacle-list+scene obstacles scene) + (define (get-posns-from-obstacle obstacles) + (cond [(empty? obstacles) empty] + [else (cons (obstacle-loc (first obstacles)) + (get-posns-from-obstacle (rest obstacles)))])) + (img-list+scene (get-posns-from-obstacle obstacles) + OBSTACLE-IMG scene)) + (define (img-list+scene posns img scene) (cond [(empty? posns) scene] [else (img+scene @@ -220,6 +271,12 @@ (or (= 0 x) (= x SIZE) (= 0 y) (= y SIZE))) +(define (obstacle-colliding? snake obstacles) + (cond [(empty? obstacles) #f] + [(posn=? (snake-head snake) + (obstacle-loc (first obstacles))) #t] + [else (obstacle-colliding? snake (rest obstacles))])) + ;; aux (define (posn=? p1 p2) (and (= (posn-x p1) (posn-x p2)) -- cgit v1.2.3