htdp2e exercise 172

gistfile1.scm

; See http://htdp2e.blogspot.com/2012/05/exercise-172-develop-data.html

; Constants
(define WORM-SIZE 10)
(define WORM-MOVE (* WORM-SIZE 2))
(define WIDTH 800) ; width of the game
(define HEIGHT 500) ; height of the game
(define SEGMENT (circle WORM-SIZE "solid" "red")) 
 
; these structs will hold the current list of worm segments, the direction 
; the worm is travelling in, and our world object
(define-struct segment(x-pos y-pos))
(define-struct direction(x y))
(define-struct world(worm direction))
(define WORM (list (make-segment 100 100) 
 (make-segment 100 80)
 (make-segment 100 60)) )
; To save repeating these directions in tests and code, we'll define them here
(define DOWN (make-direction 0 1))
(define UP (make-direction 0 -1))
(define RIGHT (make-direction 1 0))
(define LEFT (make-direction -1 0))
; Functions
; draw worm in its current location on the screen. Instead of simply drawing a single dot 
; on the screen, we need to recurse down our list of worm segments drawing each one at a
; time
(define (draw-worm background worm)
 (cond [(empty? worm) background]
 [else (place-image 
 SEGMENT
 (segment-x-pos (first worm)) (segment-y-pos (first worm)) 
 (draw-worm background (rest worm))
 )]))

; Draws the current world. Currently this just consists of the snake.
(define (show world)
 (draw-worm (empty-scene WIDTH HEIGHT) (world-worm world)) )
 
; Move the worm in the current direction. Instead of changing the position of 
; a single segment, now we add a segment to start of the worm (in the current direction)
; and get rid of the end of the worm
(define (move-worm worm direction)
 (cons (new-segment (first worm) direction) (remove-last worm))
 )
 
; return a new segment moved in 'direction' from the segment 
; passed in
(define (new-segment segment direction)
 (make-segment (+ (segment-x-pos segment) 
 (* WORM-MOVE (direction-x direction)))
 (+ (segment-y-pos segment) 
 (* WORM-MOVE (direction-y direction)))))

; remove the last worm segment. this is a pretty optimised function. just
; reverse the list, grab the rest of it, and reverse it again to get it the 
; correct order. Is their a built in to do the same?
(define (remove-last worm)
 (reverse (rest (reverse worm))))
 
; On each clock tick, move the world further in time. This is a new function
; that takes part of the responsibily of the old move-worm function. It just
; moves the worm and creates a new world based on it.
(define (progress-world world)
 (make-world
 (move-worm (world-worm world) (world-direction world))
 (world-direction world))
 )

; handle keyboard events. 
(define (handle-key-events ws ke)
 (cond
 [(string=? "left" ke) (change-direction ws LEFT)]
 [(string=? "right" ke) (change-direction ws RIGHT)]
 [(string=? "up" ke) (change-direction ws UP )]
 [(string=? "down" ke) (change-direction ws DOWN)]
 [else ws]
 ))
; create a new world with the direction the worm is travelling in changed.
(define (change-direction world direction)
 (make-world (world-worm world) direction))
 
; This is the big bang function that drives the game.
(define (worm-main rate)
 (big-bang (make-world WORM
 (make-direction 1 0))
 (to-draw show)
 ;(stop-when collision-detected final-scene)
 (on-key handle-key-events)
 (on-tick progress-world rate) ))
; start the game off! 
;(worm-main 0.1)


;; ### NEW TESTS ###
; Test when we move the worm up, a new segment is added to the start and removed
; from the end.
(check-expect (move-worm WORM LEFT)
 (list
 (make-segment (- 100 WORM-MOVE) 100)
 (make-segment 100 100) 
 (make-segment 100 80)))
; Check the remove-last function removes the last segment correctly
(check-expect (remove-last WORM) 
 (list (make-segment 100 100) 
 (make-segment 100 80)))
; Test that new segment returns a new segment in the correct position
; (as per the current direction)
(check-expect (new-segment (make-segment 100 100) UP)
 (make-segment 100 (- 100 WORM-MOVE)))

; ### OLD TESTS

;
;; Test our worm draws as we expect it.
(check-expect (draw-worm (empty-scene 200 200) WORM)
 (place-image SEGMENT 100 100 
 (place-image SEGMENT 100 80 
 (place-image SEGMENT 100 60 (empty-scene 200 200)))))

; Test our worm moves in the direction we expect
(check-expect (move-worm (list (make-segment 50 50)) DOWN)
 (list (make-segment 50 70)))
(check-expect (move-worm (list (make-segment 50 50)) UP)
 (list (make-segment 50 30)))
(check-expect (move-worm (list (make-segment 50 50)) LEFT)
 (list (make-segment 30 50)))
(check-expect (move-worm (list (make-segment 50 50)) RIGHT)
 (list (make-segment 70 50)))
; Test our change-direction function changes the direction, but doesn't impact the postion
(check-expect (change-direction (make-world (make-segment 50 50) DOWN) UP)
 (make-world (make-segment 50 50) UP))
(check-expect (change-direction (make-world (make-segment 50 50) DOWN) RIGHT)
 (make-world (make-segment 50 50) RIGHT))