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)
No comments:
Post a Comment