(require 2htdp/image) (require 2htdp/universe) ;; Snake game (define SNAKE-COLOR "red") (define FOOD-COLOR "green") (define CELL-SIZE 10) ; size of a grid cell. (define TICK-RATE 0.3) ; 0.3 seconds/tick (define GRID-HEIGHT/CELLS 15) (define GRID-WIDTH/CELLS 25) (define SEG-IMG (circle (/ CELL-SIZE 2) "solid" SNAKE-COLOR)) (define FOOD-IMG (circle (/ CELL-SIZE 2) "solid" FOOD-COLOR)) (define BLANK-BOARD (empty-scene (* GRID-WIDTH/CELLS CELL-SIZE) (* GRID-HEIGHT/CELLS CELL-SIZE))) ;;; All position coordinates are in terms of grid cells, not pixels. ;;; A FOOD is a Posn. ;;; A Snake is a (make-snake SegsList Dir) ;;; A Dir is one of: 'up 'down 'left 'right. ;;; A SegList is one of: ;;; - empty ;;; - (cons Posn SegList) ;;; The head of the snake is the first posn in the list. ;;; ;;; A World is (make-world snake food) (define-struct snake (segs dir)) (define-struct world (snake food)) (define food1 (make-posn 3 5)) (define segs1 (list (make-posn 2 6))) ; very short snake (define segs2 (list (make-posn 3 5) (make-posn 2 5))) (define snake1 (make-snake segs1 'up)) (define snake2 (make-snake segs2 'right)) (define world1 (make-world snake2 food1)) ; An eating situation (define world0 (make-world (make-snake (list (make-posn 3 3)) 'up) (make-posn 10 10))) #; (define (snake-template snake) ... (snake-segs snake) ... (snake-dir snake) ...) #; (define (SegList-template seglist) (cond [(empty? seglist) ...] [else (first seglist) ... (SegList-template (rest seglist)) ...])) #; (define (dir-template dir) (cond [(symbol=? dir 'up) ...] [(symbol=? dir 'down) ...] [(symbol=? dir 'left) ...] [else ...])) ;;; next-world : World -> World ;;; ;;; world->scene : World -> Image ;;; food+image : Food Image -> Image ;;; snake+image : Snake Image -> Image ;;; place-image-at-cell : Image Number Number Image -> Image ;;; ;;; key-handler .... ;;; ;;; eating? : World -> Boolean ;;; wall-collision? : World -> Boolean ;;; self-collision? : World -> Boolean ;;; ;;; snake-grow : Snake -> Snake ;;; snake-slither : Snake -> Snake ;;; place-image-at-cell : Image Number Number Image -> Image ;;; Just like place-image, but coordinates are in grid units. (define (place-image-at-cell img1 c r img2) (place-image img1 (* CELL-SIZE (+ c 1/2)) (* CELL-SIZE (- GRID-HEIGHT/CELLS (+ r 1/2))) img2)) (check-expect (place-image-at-cell SEG-IMG 3 7 (empty-scene (* GRID-WIDTH/CELLS CELL-SIZE) (* GRID-HEIGHT/CELLS CELL-SIZE))) (place-image SEG-IMG (* CELL-SIZE 3.5) (* CELL-SIZE (- GRID-HEIGHT/CELLS 7.5)) (empty-scene (* GRID-WIDTH/CELLS CELL-SIZE) (* GRID-HEIGHT/CELLS CELL-SIZE)))) ;;; food+image : Food Image -> Image ;;; Add the food to the image. (define (food+image f i) (place-image-at-cell FOOD-IMG (posn-x f) (posn-y f) i)) (check-expect (food+image (make-posn 3 5) BLANK-BOARD) (place-image-at-cell FOOD-IMG 3 5 BLANK-BOARD)) ;;; snake+image : Snake Image -> Image ;;; Render the snake onto the image. (define (snake+image snake img) (segs+image (snake-segs snake) img)) (check-expect (snake+image snake1 BLANK-BOARD) (place-image-at-cell SEG-IMG 2 6 BLANK-BOARD)) ;;; segs+image : SegList Image -> Image ;;; Render the segments onto the image. (define (segs+image seglist img) (cond [(empty? seglist) img] [else (place-image-at-cell SEG-IMG (posn-x (first seglist)) (posn-y (first seglist)) (segs+image (rest seglist) img))])) (check-expect (segs+image segs1 BLANK-BOARD) (place-image-at-cell SEG-IMG 2 6 BLANK-BOARD)) ;;; world->scene : World -> Image ;;; Renders the world into one frame of the game. (define (world->scene w) (food+image (world-food w) (snake+image (world-snake w) BLANK-BOARD))) ;;; 1-seg snake at (3,3); food is at (10,10) #; (check-expect (world->scene world0) (place-image SEG-IMG (* CELL-SIZE 3.5) (* CELL-SIZE (- GRID-HEIGHT/CELLS 3.5)) (place-image ))) ;;; snake-slither : Snake -> Snake ;;; Move the snake one cell in the current direction. ;;; (The snake "slithers" -- every segment moves up to ;;; the segment in front of it. To do this: ;;; 1. drop the last segment of the snake, then ;;; 2. cons a new head onto the front of the snake.) (define (snake-slither snake) (make-snake (cons (move-posn (first (snake-segs snake)) (snake-dir snake)) (all-but-last (snake-segs snake))) (snake-dir snake))) (check-expect (snake-slither (make-snake (list (make-posn 2 5) (make-posn 3 5)) 'up)) (make-snake (list (make-posn 2 6) (make-posn 2 5)) 'up)) ;;; snake-grow : Snake -> Snake ;;; Grow the snake by one segment. (define (snake-grow snake) (make-snake (cons (move-posn (first (snake-segs snake)) (snake-dir snake)) (snake-segs snake)) (snake-dir snake))) ;;; An NESegList is one of: ;;; - (cons Posn empty) ;;; - (cons Posn NESegList) #;(define (neseglist-template nesl) (cond [(empty? (rest nesl)) ... (first nesl) ...] [else ... (first nesl) ... (neseglist-template (rest nesl)) ...])) ;;; all-but-last : NESegList -> SegList ;;; Drop the last element of the list. (define (all-but-last nesl) (cond [(empty? (rest nesl)) empty] [else (cons (first nesl) (all-but-last (rest nesl)))])) (check-expect (all-but-last (list (make-posn 0 3) (make-posn 5 8))) (list (make-posn 0 3))) (check-expect (all-but-last (list (make-posn 8 4))) empty) ;;; move-posn : Posn Dir -> Posn ;;; Move the posn one cell in the given direction. (define (move-posn posn dir) (cond [(symbol=? dir 'up) (make-posn (posn-x posn) (add1 (posn-y posn)))] [(symbol=? dir 'down) (make-posn (posn-x posn) (sub1 (posn-y posn)))] [(symbol=? dir 'left) (make-posn (sub1 (posn-x posn)) (posn-y posn))] [else (make-posn (add1 (posn-x posn)) (posn-y posn))])) (check-expect (move-posn (make-posn 3 4) 'up) (make-posn 3 5)) (check-expect (move-posn (make-posn 3 4) 'left) (make-posn 2 4)) (define (next-world w) (make-world (snake-slither (world-snake w)) (world-food w))) (define (handle-key key w) (cond [(key=? key "up") (make-world (make-snake (snake-segs (world-snake w)) 'up) (world-food w))] [(key=? key "right") (make-world (make-snake (snake-segs (world-snake w)) 'right) (world-food w))] [else w])) (big-bang world0 (on-tick next-world TICK-RATE) (to-draw world->scene) (on-key handle-key))