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)
