Exercise 178: Equip the program from exercise 177 with a stop-when clause.

Exercise 178: Equip the program from exercise 177 with a stop-when clause. The game ends when one of the columns contains HEIGHT blocks.

Download code for this exercise here.

I implemented the stop-when handler slightly differently than suggested in the book. The way it was described did not make sense to me. The suggestion was to 1) create a function that will create a column of blocks/landscape to determine the end of the game. 2) Create a function to function to get the height  of a particular column, and 3) stop when the height of a column exceeds HEIGHT. 

It seems that if you do steps 2 and 3, then you don't need step 1) at all. All you need to do is to check each column for the height. This is how I have chosen to implement it.

The score function was reasonably straight forward to create - we just needed to count all the blocks in the landscape and then convert that number to a string.

In the end we have a reasonably functional game. I did contemplate trying to extend this to do shapes, but the next exercise (creating a space invaders game) looked too interesting to be put off!

Code

(require racket/base)
(define-struct block (x y) #:transparent)
(define-struct tetris (block landscape))


; physical constants
(define WIDTH 10) ; the maximal number of blocks horizontally


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


; this is just an example/test Tetris scene.
(define TETRIS  (make-tetris (make-block 10 60)
                             (list (make-block 20 40) )))


(define SCENE-SIZE  (* WIDTH SIZE) )


; new function
(define (game-over-scene tetris)
  (place-image (text (string-append "Score: " (score tetris)) 15 "black") 50 70
               (place-image (text "game over" 20 "black") 50 50
                            (tetris-render tetris))))
 
; Returns the score - the number of blocks in the landscape
(define (score tetris);
 (number->string (length (tetris-landscape tetris))))




; takes in a landscape and an x co-ordinate.
; produces a list (landscape) of blocks with that co-ordinate. 
; standard recursion - if the landscape is empty, we're at the end so return it.
; if the block at the top has the right x co-ordinate, create a list out of it
; + the recursion
; if the block at the top doesn't match, just recurse further
; landscape, number -> landscape
(define (get-column landscape x)
  (cond ((empty? landscape) landscape)
        ((= x (block-x (first landscape)))
         (cons (first landscape)
               (get-column (rest landscape) x)))
        (else (get-column (rest landscape) x))))
; test the happy case - should get all the blocks in the 10 x-cordinate
(check-expect (get-column (list (make-block 10 10)
                                (make-block 10 20)
                                (make-block 20 20)) 10)
              (list (make-block 10 10)
                    (make-block 10 20)))

; returns true any of the columns in the landscape exceed the maximum height
; landscape: the game landscape
; height: the max height
; column: the current column as we recurse down. Start at the far right column
(define (height-exceeded landscape height column)
  ; if we reach last column without finding an exceeded column then return false
  ; if the current column exceeds the height, return true
  ; else recurse....
  (cond
        ((empty? landscape) false)
        ((= 0 column) false)
        ; get the column for the current co-ordinates
        ((= height (length (get-column landscape (* column SIZE)))) true)
        (else (height-exceeded landscape height (- column 1)))))




; test the happy case - should get all the blocks in the 10 x-cordinate
(check-expect (height-exceeded empty 10 1) false)
(check-expect (height-exceeded  (list (make-block 10 10)
                                (make-block 10 20)
                                (make-block 10 20)) 3 1)
              true)


(define (end-game? tetris)
  (height-exceeded (tetris-landscape tetris) 2 WIDTH))




; start the block in the middle
(define INITIAL-BLOCK (make-block (/ SCENE-SIZE 2) 0))


; Block -> Block
; Creates a new block at random, anywhere but the current column
(define (block-create b)
  (block-check-create b (make-block (* (random WIDTH) SIZE) 0)))


; Block Bloc -> Block
; generative recursion
; 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))




; Handle keyboard events.
; The move-block function is called by both handle-key-events and progress world. ; To keep  it simple it only takes in a block . This means we
; need  to construct the new tetris around the cond clauses - if the user hasn't
; pressed left or right, we just pass the unaltered block straight back in
; Also we are checking to see if the moved block (left/right) would collide with
; an existing block. Without this check, you can move inside a column of blocks.
; This probably shouldn't be handled here - it would be better extracted out and
; handled in a dedicated function.
(define (handle-key-events tetris ke)
  (make-tetris
  (cond
    [(string=? "left" ke)
     (cond ((landscape-collision? tetris "left") (tetris-block tetris))
           (else  (move-block (tetris-block tetris) "left")))]
    [(string=? "right" ke)
     (cond ((landscape-collision? tetris "right") (tetris-block tetris))
           (else  (move-block (tetris-block tetris) "right"))) ] )
  (tetris-landscape tetris)))




; On each clock tick, move the world further in time.
(define (progress-world tetris)
  (check-collisions
   (make-tetris (move-block (tetris-block tetris) "down")
                (tetris-landscape tetris)
    )))




; moves the block and returns a new block.
; we do bounds checking for each direction - make sure we can't go off the
; right or the left of  the screen.
(define (move-block block direction)
   (cond ((string=? direction "left")
         (cond ((> SIZE (block-x block)) block)
               (else (make-block  (- (block-x block) SIZE) (block-y block)))))
       
         ((string=? direction "right")
          (cond ((= (- SCENE-SIZE SIZE) (block-x block)) block)
                (else (make-block (+ (block-x block) SIZE ) (block-y block)))))
                                 
         ((string=? direction "down")
          (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)
; I'm not overly happy with this - I need a special case 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 (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 "down") (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
(define (landscape-collision? tetris direction)
  (and (not (empty? (tetris-landscape tetris)))
       (member? (move-block (tetris-block tetris) direction)
                (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-key     handle-key-events)
            (on-tick    progress-world rate)      
            (stop-when  end-game? game-over-scene)
            ))


(tetris-main 0.2)


; ## 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))) "down")
              false)






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

Exercise 177: Modify the program from exercise 176 so that a player can control the left or right movement of the dropping block.

Modify the program from exercise 176 so that a player can control the left or right movement of the dropping block. 

Each time the player presses the "left" arrow key, the dropping block should shift one column to the left unless it is in column 0 or there is already a stack of resting blocks to its left. Similarly, each time the player presses the "right" arrow key, the dropping block should move one column to the right if possible.

Download code for this exercise here.

Code

(require racket/base)
(define-struct block (x y) #:transparent)
(define-struct tetris (block landscape))

; physical constants
(define WIDTH 10) ; the maximal number of blocks horizontally


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


; this is just an example/test Tetris scene.
(define TETRIS  (make-tetris (make-block 10 60)
                             (list (make-block 20 40) )))


(define SCENE-SIZE  (* WIDTH SIZE) )




; start the block in the middle
(define INITIAL-BLOCK (make-block (/ SCENE-SIZE 2) 0))


; Block -> Block
; Creates a new block at random, anywhere but the current column
(define (block-create b)
  (block-check-create b (make-block (* (random WIDTH) SIZE) 0)))


; Block Bloc -> Block
; generative recursion
; 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))




; Handle keyboard events. 
; The move-block function is called by both handle-key-events and progress world. ; ; To keep  it simple it only takes in a block (rather than a tetris). This means we
; need  to construct the new tetris around the cond clauses - if the user hasn't 
; pressed left or right, we just pass the unaltered block straight back in


; Also we are checking to see if the moved block (left/right) would collide with 
; an existing block. Without this check, you can move 'inside' a column of blocks.
; This probably shouldn't be handled here - it would be better extracted out and
; handled in a dedicated function.
(define (handle-key-events tetris ke)
  (make-tetris 
  (cond
    [(string=? "left" ke)  
     (cond ((landscape-collision? tetris "left") (tetris-block tetris))
           (else  (move-block (tetris-block tetris) "left")))]
    [(string=? "right" ke) 
     (cond ((landscape-collision? tetris "right") (tetris-block tetris))
           (else  (move-block (tetris-block tetris) "right"))) ] ) 
  (tetris-landscape tetris)))




; On each clock tick, move the world further in time. 
(define (progress-world tetris)
  (check-collisions
   (make-tetris (move-block (tetris-block tetris) "down")
                (tetris-landscape tetris)
    )))




; moves the block and returns a new block. 
; we do bounds checking for each direction - make sure we can't go off the 
; right or the left of  the screen.
(define (move-block block direction)
   (cond ((string=? direction "left")
         (cond ((> SIZE (block-x block)) block)
               (else (make-block  (- (block-x block) SIZE) (block-y block)))))
        
         ((string=? direction "right")
          (cond ((= (- SCENE-SIZE SIZE) (block-x block)) block)
                (else (make-block (+ (block-x block) SIZE ) (block-y block)))))
                                  
         ((string=? direction "down")
          (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)
; I'm not overly happy with this - I need a special case 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 (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 "down") (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
(define (landscape-collision? tetris direction)
  (and (not (empty? (tetris-landscape tetris)))
       (member? (move-block (tetris-block tetris) direction)
                (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-key     handle-key-events)
            (on-tick    progress-world rate)        
            ))


(tetris-main 0.2)


; ## 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))) "down")
              false)






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

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)