H2DP2E: Exercise 175

gistfile1.scm

; See http://htdp2e.blogspot.co.nz/2012/07/exercise-175-design-program-tetris.html

(define-struct block (x y))
(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))


; 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 our block on supplied background. 
(define (draw-block block background)
 (place-image BLOCK
                (block-x block) (block-y block)
                background))

(tetris-render  TETRIS)

; ## TESTS ##

; simple example - a single block in an empty landscape
(check-expect (tetris-render (make-tetris (make-block 20 40) empty))
              (place-image BLOCK 20 40 (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 BLOCK 10 60 (place-image BLOCK 20 40 
                              (empty-scene SCENE-SIZE SCENE-SIZE))))