Tuesday, 17 July 2012

Exercise 176: Design the interactive program tetris-main...


Design the interactive program tetris-main, which displays blocks dropping in a straight line from the top of the canvas and landing on the floor or on blocks that are already resting. 

Download the code for this exercise here.

This was a fairly straight forward extension to the previous exercise. The main 'gotcha' I came across involved the member? function which was used to determine if a block had collided with a landscape. The problem was that my tests were returning false (that there was no collision), when I knew that there should be a collision.  This led to two discoveries - firstly, in order for member? to be able to look into an arbitrary struct, the struct needs to be declared as #:transparent. Secondly, in order for a struct to be able to be declared as transparent, we need to specifically require  'racket/base'.

One aspect changed since my solution for exercise 175 is the use of place-image/align instead of place-image. This is to ensure that the blocks are correctly placed within the boundaries of the screen
using the native co-ordinate points stored for them. Without the use of this method I would have need to manually shift each block by 5 pixels in order to make them appear correctly.

Code

(require racket/base)


; The struct block contains the blocks that make up landscape and the 
; current falling block. We need to define this struct as transparent or 
; the member? function won't be able to look inside it.
(define-struct block (x y) #:transparent)


; A tetris consists of a block, and a landscape
(define-struct tetris (block landscape))


; physical constants
(define WIDTH 10) ; the maximal number of blocks horizontally/vertically
(define SIZE 10)  ; blocks are square


(define BLOCK     ; blocks are rendered as red squares with black rims
  (overlay (rectangle (- SIZE 1) (- SIZE 1) "solid" "red")
           (rectangle SIZE SIZE "outline" "black")))




(define SCENE-SIZE  (* WIDTH SIZE) )






; an initial block, starting the block in the middle of the screen
(define INITIAL-BLOCK (make-block (/ SCENE-SIZE 2) 0))




; Block -> Block
; Creates a new block at random, anywhere but the current column
; These are essentially the same as the generative recursion functions used in 
; the worm game exercises
(define (block-create b)
  (block-check-create b (make-block (* (random WIDTH) SIZE) 0)))


; Block Bloc -> Block
; Checks that the candidate and b are in different colums on the screen.
; If they are at the same point, create a new candiate by recursing into
; block-create, otherwise return the new candidate (which will then be returned
; via block-create)
(define (block-check-create b candidate)
  (if (equal? (block-x b) (block-x candidate))
      (block-create b) candidate))






; This tetris-render function is a wrapper around the main function.
; This just splits the tetris into the initial block/landscape tuple and
; calls the main tetris-render-helper function.
(define (tetris-render tetris)
  (tetris-render-helper (tetris-block tetris)
                        (tetris-landscape tetris)))




; Draw a tetris scene. This is the function that does the guts of the work.
; If our landscape is empty, just draw the block onto an empty scene
; otherwise recurse, and draw draw the current block on the result of drawing the rest of the
; blocks.
(define (tetris-render-helper block landscape)
  (draw-block block
              (cond ((empty? landscape )  
                     (empty-scene SCENE-SIZE SCENE-SIZE))
                    (else (tetris-render-helper  (first landscape)
                                                 (rest landscape))))))


; Draw a block on our background. I'm using place-image/align instead of 
; place-image as we need to define where our block is appearing. By default 
; place-image will center the image at the x/y co-ordinates. This would leave 
; a block drawn at 0,0 to be drawn  half off the left of the screen and half off the top of the screen.
(define (draw-block block background)
 (place-image/align BLOCK
                (block-x block)
                (block-y block) "left" "bottom"
                background))








; On each clock tick, move the world further in time. This currently just 
; moves our block down one square
; This is pretty clunky, but I'm okay with it for now as it is only moving
; the block down one square - as soon as the tetris needs to move in 3 
; directions this will be separated out into a separate function
(define (progress-world tetris)
  (check-collisions
   (make-tetris (move-block (tetris-block tetris))
                (tetris-landscape tetris)
    )))


; moves the block and returns a new block. Currently this only moves in one direction - down
(define (move-block block)
  (make-block (block-x block)
              (+ SIZE ( block-y block))))


; checks for collisions between the block and the landscape. if this is the
; case, the block becomes part of the landscape and we generate a new block.
; In order for the blocks to stack, we need to forecast a collision - ie, 
; look at where the block will be if it moved down one more square)
(define (check-collisions tetris)
  (cond
    ; collision - either with another block, or with the floor
    ; make block part of landscape and create new block
    ((or (landscape-collision? tetris) (floor-collision? tetris))
     (make-tetris (block-create (tetris-block tetris))
                   (append (tetris-landscape tetris)
                          (cons (tetris-block tetris) empty))
                  ))
    ; no collision - just return
    (else tetris)
  ))


; detects block collision with the landscape

; I'm not overly happy with this - I need a special check to handle if
; the landscape is empty (which  it will be at the start of the game).  
; I'm not sure if this means I'm structuring this wrong, or if this is a 
; genuine need...

(define (landscape-collision? tetris)
  (and (not (empty? (tetris-landscape tetris)))
       (member? (move-block (tetris-block tetris))
                (tetris-landscape tetris) ))
)






; checks for a collision with the floor
; we don't check if we've exceeded the height, we check we haven't 
; exceeded the height less the width of the block. otherwise our block 
; won't trigger the collision until they are below the floor
(define (floor-collision? tetris)
   (> (block-y (tetris-block tetris)) (- SCENE-SIZE SIZE)))


; This is the big bang function that drives the game.
(define (tetris-main rate)
  (big-bang (make-tetris INITIAL-BLOCK empty)
            (to-draw     tetris-render)
            (on-tick     progress-world rate)))




(tetris-main 0.04)


; ## TESTS ##


; simple example - a single block in an empty landscape
(check-expect (tetris-render (make-tetris (make-block 20 40) empty))
              (place-image/align BLOCK 20 40 "left" "bottom"
                                 (empty-scene SCENE-SIZE SCENE-SIZE)))


; a slightly more complex test - drawing two blocks
(check-expect (tetris-render (make-tetris (make-block 10 60)
                              (list (make-block 20 40) )))
              (place-image/align BLOCK 10 60 "left" "bottom"
                                 (place-image/align BLOCK 20 40 "left" "bottom"
                                         (empty-scene SCENE-SIZE SCENE-SIZE))))


; landscape collision - no collision
(check-expect (landscape-collision?  (make-tetris (make-block 10 60)
                                                  (list (make-block 20 40))))
              false)


; landscape collision - a collision
(check-expect (landscape-collision?  (make-tetris
                                      (make-block 20 30)
                                      (list (make-block 20 40)
                                            (make-block 30 40))))
              true)


; floor collision - no collision
(check-expect (floor-collision?  (make-tetris (make-block 10 60)
                                                  (list empty)))
              false)


; floor collision -  collision
(check-expect (floor-collision?  (make-tetris (make-block 10  SCENE-SIZE )
                                                  (list empty)))
              true)

No comments:

Post a Comment