H2DP2E: Exercise 174

gistfile1.scm

; How to design programs 2nd ed. Question 174

; See http://htdp2e.blogspot.co.nz/2012/06/exercise-174-equip-your-program-from.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"))
(define FOOD (circle WORM-SIZE "solid" "black"))

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

; worm is a list of worm segments
; direction is the direction the worm is travelling
; segment is our current food segment
(define-struct world(worm direction segment))

(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



This first function food-create is one of the supplied functions. I have changed the dimensions for the allowed positions for the food segment. This is because we need to make sure the food is in a position that our worm can travel over completely. (Currently this is multiples of 20). If we don't do this, the food could be off by for example 5 pixels, so we could travel over it and not trigger a collision


; Posn -> Posn
; Creates a new item of food at anywhere on the screen *except* for the 
; point defined by posn p. (eg the current snake position)
(define (food-create p)
  (food-check-create
   p 
   (make-segment (* (random (/ WIDTH WORM-MOVE)) WORM-MOVE)
                 (* (random (/ HEIGHT WORM-MOVE)) WORM-MOVE))))


; Posn Posn -> Posn
; checks that the candidate and p are at different points on the screen.
; If they are at the same point, create a new candiate by recursing into
; food-create, otherwise return the new candidate (which will then be returned
; via food-create)
(define (food-check-create p candidate)
  (if (equal? p candidate) (food-create p) candidate))


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


; This is a new method for question 174.
; This draws the food on to the background of our world
; Returns a new image.
(define (draw-food background food)
  (place-image FOOD (segment-x-pos food) (segment-y-pos food) background) )

; function to determine if we have collided with a food block
; returns true if the worm's segment is on top of the food
(define (worm-hit-food? segment food)
  (cond ((and (= (segment-x-pos segment) (segment-x-pos food))
              (= (segment-y-pos segment) (segment-y-pos food))) true)
        (else false)))


; This is a new function for question 174. It grows the worm one segment.
; To do this we just append a segment in the existing foods position
; on to the worm. Another way to do this would be to append at the end of 
; the list.
; This method was simpler though (but doesn't look quite as good)
(define (grow-worm worm food)
 (cons (make-segment (segment-x-pos food) (segment-y-pos food)) worm  ))
       

; This is a new function for question 174. This method will check if we are
; in the same location as a food item, and if so, eat it. (and make the worm
; grow longer)
; returns a world state with either nothing changed, or a longer worm and
; a new food;
(define (eat-food world)
  (cond ((worm-hit-food? (first (world-worm world)) (world-segment world))
         (make-world  (grow-worm (world-worm world) (world-segment world))
                     (world-direction world)
                     (food-create (first (world-worm world)))))
        (else world)))


; Checks if the snake has collided with either itself, or with the walls
; Returns true in the event of a collision
(define (collision-detected world)
  (or
   (collision-detected-wall (first (move-worm-helper world )))
   (collision-detected-worm (first (move-worm-helper world))  (world-worm world ))))

; Returns true if the worm has collided with itself.
(define (collision-detected-worm segment worm)
  (member? segment worm))

; helper function for collision detection. Operates directly
; on a worm, rather than world object.
(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.
(define (show world)
  (draw-food
   (draw-worm (empty-scene WIDTH HEIGHT) (world-worm world))
   (world-segment 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))
)

; helper method to DRY up code when calling this from a world object
(define (move-worm-helper world)
  (move-worm (world-worm world) (world-direction world)))

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



; This has changed for question 174 - we now need to check for food 
; collisions on each clock tick.
; 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)
  (eat-food
   (make-world
    (move-worm  (world-worm world)
                (world-direction world))
    (world-direction world)
    (world-segment 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  (world-segment world)))


; This is the big bang function that drives the game.
(define (worm-main rate)
  (big-bang (make-world WORM
                        (make-direction 1 0)
                        (make-segment 300 100)
                        )
            (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

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