(require 2htdp/image) (require 2htdp/universe) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SNAKE (define-struct world (food snake)) ;; A World is a (make-world Food Snake) ;; A Food is a Posn (in grid square coords) (define-struct snake (segs direction)) ;; A Snake is a (make-snake Segs Direction) ;; A Snake must contain at least one segment ;; The head is the first element in Segs ;; A Segs is one of: ;; - empty ;; - (cons Posn Segs) ;; where posn is in grid square coords ;; A Direction is one of: ;; - "up" ;; - "down" ;; - "left" ;; - "right" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TEMPLATES #;(define (world-temp w) ... (world-food w) ... (world-snake w) ... ) #;(define (food-temp f) ... (posn-x f) ... (posn-y f) ...) #;(define (snake-temp snk) ... (snake-segs snk) ... (snake-direction snk) ...) #;(define (segs-temp segs) (cond [(empty? segs) ...] [else ... (first segs) ... (segs-temp (rest segs)) ... ])) #;(define (dir-temp d) (cond [(string=? d "up") ...] [(string=? d "down") ...] [(string=? d "left") ...] [(string=? d "right") ...])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CONSTANTS (define GRIDSQ-SIZE 10) ;; in pixels (define BOARD-HEIGHT 20) ;; in grid squares (define BOARD-WIDTH 30) ;; in grid squares (define BACKGROUND (empty-scene (* GRIDSQ-SIZE BOARD-WIDTH) (* GRIDSQ-SIZE BOARD-HEIGHT))) (define TICK-RATE 0.3) (define SEG-RADIUS (quotient GRIDSQ-SIZE 2)) (define SEG-IMAGE (circle SEG-RADIUS "solid" "red")) (define FOOD-RADIUS (floor (* 0.9 SEG-RADIUS))) (define FOOD-IMAGE (circle FOOD-RADIUS "solid" "green")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; EXAMPLES (define food1 (make-posn 5 3)) (define snake1 (make-snake (cons (make-posn 6 10) empty) "left")) (define world1 (make-world food1 snake1)) (define snake2 (make-snake (cons (make-posn 5 3) empty) "left")) (define world2 (make-world food1 snake2)) ; an eating scenario (define food3 (make-posn 10 19)) (define snake3 (make-snake (cons (make-posn 5 3) (cons (make-posn 6 3) empty)) "left")) ; 2-segment snake (define world3 (make-world food3 snake3)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Wish List ;; snake-slither : Snake -> Snake ;; move snake in direction it's headed in ;; place-image-on-grid : Image Number Number ;; game-over? : World -> Boolean ;; wall-collide? : Snake -> Boolean ;; self-collide? : Snake -> Boolean ;; create-food : World -> World ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; IMAGE RENDERING FUNCTIONS ;; world->scene : World -> Image ;; render the current world(define (world->scene w) (define (world->scene w) (snake+scene (world-snake w) (food+scene (world-food w) BACKGROUND))) ;; food+scene : Food Image -> Image ;; adds the food to a scene (define (food+scene f scn) (place-image-on-grid FOOD-IMAGE (posn-x f) (posn-y f) scn)) ;; place-image-on-grid : Image Number Number Image -> Image ;; just like place image except take grid square coords (define (place-image-on-grid img1 x y img2) (place-image img1 (- (* GRIDSQ-SIZE x) (quotient GRIDSQ-SIZE 2)) (- (* GRIDSQ-SIZE y) (quotient GRIDSQ-SIZE 2)) img2)) (check-expect (place-image-on-grid FOOD-IMAGE 1 1 BACKGROUND) (place-image FOOD-IMAGE 5 5 BACKGROUND)) (check-expect (place-image-on-grid FOOD-IMAGE 5 10 BACKGROUND) (place-image FOOD-IMAGE 45 95 BACKGROUND)) ;; snake+scene: Snake Image -> Image ;; add the snake to the scene (define (snake+scene snk scn) (segments+scene (snake-segs snk) scn)) ;; segments+scene : Segs Image -> Image ;; draw the given segments on top of the given scene (define (segments+scene segs scn) (cond [(empty? segs) scn] [else (place-image-on-grid SEG-IMAGE (posn-x (first segs)) (posn-y (first segs)) (segments+scene (rest segs) scn))])) ; Examples/tests: Image rendering functions (check-expect (food+scene food1 BACKGROUND) (place-image FOOD-IMAGE 45 25 BACKGROUND)) (check-expect (segments+scene empty BACKGROUND) BACKGROUND) (check-expect (segments+scene (snake-segs snake1) BACKGROUND) (place-image SEG-IMAGE 55 95 BACKGROUND)) (check-expect (snake+scene snake1 BACKGROUND) (place-image SEG-IMAGE 55 95 BACKGROUND)) (check-expect (snake+scene snake3 BACKGROUND) ; 2-segment snake (place-image SEG-IMAGE 45 25 (place-image SEG-IMAGE 55 25 BACKGROUND))) (check-expect (world->scene world1) (place-image FOOD-IMAGE 45 25 (place-image SEG-IMAGE 55 95 BACKGROUND))) (check-expect (world->scene world2) ; eating scenario: food is hidden! (place-image SEG-IMAGE 45 25 BACKGROUND)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SNAKE MOTION & GROWTH ;; snake-slither : Snake -> Snake ;; move snake by one step in direction it's headed in ;; How: new head is old head moved in approp. direction ;; and new tail is old segs of snake minus last one (define (snake-slither snk) (make-snake (move-segs (snake-segs snk) (snake-direction snk)) (snake-direction snk))) ;; A NESegs is one of: ;; - (cons Posn empty) ;; - (cons Posn NESegs) ;; Template #;(define (nesegs-temp nesegs) (cond [(empty? (rest nesegs)) ... (first nesegs) ...] [else ... (first nesegs) ... (nesegs-temp (rest nesegs)) ... ])) ;; move-segs : NESegs Direction -> NESegs ;; move segments of snake in appropriate direction ;; How: new head is old head moved in approp. direction ;; and new tail is old segs of snake minus last one (define (move-segs nesegs dir) (cons (move-seg (first nesegs) dir) ;; new head (segments-all-but-last nesegs))) ;; new tail ;; move-seg : Posn Direction -> Posn ;; move a single segment in given direction (define (move-seg p d) (cond [(string=? d "up") (make-posn (posn-x p) (sub1 (posn-y p)))] [(string=? d "down") (make-posn (posn-x p) (add1 (posn-y p)))] [(string=? d "left") (make-posn (sub1 (posn-x p)) (posn-y p))] [(string=? d "right") (make-posn (add1 (posn-x p)) (posn-y p))])) (check-expect (move-segs (list (make-posn 5 10)) "left") (list (make-posn 4 10))) (check-expect (move-segs (list (make-posn 5 10)) "right") (list (make-posn 6 10))) (check-expect (move-segs (list (make-posn 5 10)) "up") (list (make-posn 5 9))) (check-expect (move-segs (list (make-posn 5 10)) "down") (list (make-posn 5 11))) #;(check-expect (snake-slither snake1) (make-snake (cons (make-posn 5 10) empty) "left")) #;(check-expect (snake-slither snake3) (make-snake (cons (make-posn 4 3) (cons (make-posn 5 3)) empty) "left")) ;; segments-all-but-last : NESegs -> Segs ;; remove the last segment from a NON-EMPTY list (define (segments-all-but-last nesegs) (cond [(empty? (rest nesegs)) empty] [else (cons (first nesegs) (segments-all-but-last (rest nesegs)))])) (check-expect (segments-all-but-last (list (make-posn 5 10))) empty) (check-expect (segments-all-but-last (list (make-posn 5 10) (make-posn 6 10))) (list (make-posn 5 10))) ;; snake-grow : Snake -> Snake ;; grow the snake (define (snake-grow snk) (make-snake (cons (move-seg (first (snake-segs snk)) (snake-direction snk)) (snake-segs snk)) (snake-direction snk))) ;; eating? : World -> Boolean ;; is this an eating scenario? (define (eating? w) (posn=? (world-food w) (first (snake-segs (world-snake w))))) ;; posn=? : Posn Posn -> Boolean ;; are the two posns equal? (define (posn=? p1 p2) (and (= (posn-x p1) (posn-x p2)) (= (posn-y p1) (posn-y p2)))) ;; key-handler : World KeyEvt -> World ;; handle key pressed ("n" for new game, dir keys, ignore rest) (define (key-handler w ke) (cond [(key=? ke "n") world1] [(or (key=? ke "up") (key=? ke "down") (key=? ke "left") (key=? ke "right")) (make-world (world-food w) (make-snake (snake-segs (world-snake w)) ke))] [else w])) ;; eat&grow : World -> World ;; Eat the current food, grow the snake, and create new food (define (eat&grow w) (make-world (make-posn (add1 (random BOARD-WIDTH)) (add1 (random BOARD-HEIGHT))) (snake-grow (world-snake w)))) ;; WHERE WE LEFT OFF IN CLASS: ;; segs-collide? : Posn Segs -> Boolean ;; Does posn head collide with any of the posns in the list segs? (define (segs-collide? head segs) ...) ;; SEE BELOW #| Here are two ways to implement segs-collide? ;; The following is what you might end up with if you follow the design ;; recipe and use your Segs template: (define (segs-collide?-version1 head segs) (cond [(empty? segs) false] [else (if (posn=? head (first segs)) true (segs-collide? head (rest segs)))])) ;; But as noted in class, if you have a cond that returns booleans, ;; you can write it using some combination of and/or/not... (define (segs-collide? head segs) (and (not (empty? segs)) (or (posn=? head (first segs)) (segs-collide? head (rest segs))))) |# ;; self-collide? : Snake -> Boolean ;; Is the head in same position as a non-head segment? (define (self-collide? snk) (segs-collide? (first (snake-segs snk)) (rest (snake-segs snk)))) ;; (TODO) wall-collide? : Snake -> Boolean ;; (TODO) game-over? : World -> Boolean ;; world->world : World -> World ;; produce the next world (define (world->world w) (cond [(eating? w) (eat&grow w)] [else (make-world (world-food w) (snake-slither (world-snake w)))])) (big-bang world1 (to-draw world->scene) (on-tick world->world TICK-RATE) (on-key key-handler)) ;(stop-when game-over?))