htdp2e Exercise 173

htdp2e Exercise 173

; 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 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. This function recurses
; down our list of worm segments drawing each one at a time on to the background
; passed in
(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))
              )]))




; Check for collisions with either the walls or the rest of the worm.
; return true if collision detected, false otherwise
(define (collision-detected world)
  (or
   (collision-detected-wall (first (move-worm-helper world )))
   (collision-detected-worm (first (move-worm-helper world)) 
                            (world-worm world ))))


; a helper function for checking for collision with the worm. 
; This works by checking if area the worm would move into is already in the
; list of worm segments
; return true if collision detected, false otherwise
(define (collision-detected-worm segment worm)
  (member? segment worm))

; a helper function for collision detection with the wall
; returns true if a collision is detected, false otherwise
(define (collision-detected-wall segment)
 (cond [(> 0        (segment-x-pos segment)) true]  ; exceeding left edge
        [(> 0       (segment-y-pos segment)) true]  ; exceeding top edge
        [(< WIDTH   (segment-x-pos segment)) true]  ; exceeding right edge
        [(< HEIGHT  (segment-y-pos segment)) true]  ; exceeding bottom edge
        [else false]))



; Draw our final scene with the worm departing the board
; Displays a "Game Over" type message. We should probably be calculating the
; width and height of the image to calculate the offsets, but it's simpler just
; to arbitrarily put it somewhere in the bottom right of the screen
(define (final-scene world)
  (draw-worm
   (place-image (text
                  (cond  ((collision-detected-wall 
                            (first (move-worm-helper world )))
                          "worm hit border" )
                         (else "worm hit worm"))
               
                 20 "red")
                (- WIDTH 100)
                (- HEIGHT 50)
                (empty-scene WIDTH HEIGHT))
   (world-worm world)))


; Draws the current world. This consists of the snake and the food objects
(define (show world)
  (draw-worm (empty-scene WIDTH HEIGHT) (world-worm world)) )

; Move the worm in the current direction. To move the worm 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)))


; helper method to DRY up code.
(define (move-worm-helper world)
  (move-worm (world-worm world) (world-direction world)))

; returns 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 unoptimised function. just
; reverse the list, grab the rest of it, and reverse it again to get it the
; correct order. 
(define (remove-last worm)
   (reverse (rest (reverse worm))))



; On each clock tick, move the world further in time. It moves the worm
; and creates a new world based on this.
(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)


; 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)))



;; exceeding the bottom of the screen
;(check-expect (collision-detected (make-world
;                                    (make-worm (- WIDTH 10) (+ HEIGHT 10)) RIGHT))
;              true)
;; exceeding the right side of the scren
;(check-expect (collision-detected (make-world
;                                    (make-worm (+ WIDTH 10) (- HEIGHT 10)) RIGHT))
;              true)
;
;; exceeding the top of the screen
;(check-expect (collision-detected (make-world
;                                    (make-worm -10 (- HEIGHT 10)) LEFT))
;              true)
;; exceeding the left side of the screen
;(check-expect (collision-detected (make-world
;                                    (make-worm (- WIDTH 10) -10) LEFT))
;              true)
;
;;in the middle of the screen - should not collide
;(check-expect (collision-detected (make-world
;                                    (make-worm (- WIDTH 10) (- HEIGHT 10)) LEFT))
;              false)
;

;
;; 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)))))
; See http://htdp2e.blogspot.com/2012/05/exercise-173-re-design-your-program-so.html

; 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))