#lang scheme/base (require "typed-tetris.ss") (require htdp/testing) (require lang/htdp-advanced) "Identical blocks are equal." (check-expect (block=? (make-block 0 0 'black) (make-block 0 0 'black)) true) "Identical (modulo color) blocks are equal." (check-expect (block=? (make-block 0 0 'black) (make-block 0 0 'red)) true) "Blocks with different coordinates are different." (check-expect (block=? (make-block 0 1 'black) (make-block 0 0 'black)) false) (check-expect (block=? (make-block 0 0 'black) (make-block 0 1 'black)) false) "Block move." (check-expect (block=? (block-move 0 0 (make-block 0 0 'black)) (make-block 0 0 'black)) true) (check-expect (block=? (block-move 0 1 (make-block 0 0 'black)) (make-block 0 1 'black)) true) "Block set membership." (check-expect (blocks-contains? empty (make-block 0 0 'black)) false) (check-expect (blocks-contains? (list (make-block 0 0 'black)) (make-block 0 0 'black)) true) (check-expect (blocks-contains? (list (make-block 0 1 'black)) (make-block 0 0 'black)) false) "Block set containment." (check-expect (blocks-subset? empty empty) true) (check-expect (blocks-subset? empty (list (make-block 0 0 'black))) true) (check-expect (blocks-subset? (list (make-block 0 0 'black)) (list (make-block 0 0 'black))) true) "Block set equality." (check-expect (blocks=? (list (make-block 0 0 'black)) (list (make-block 0 0 'black))) true) (check-expect (blocks=? (list (make-block 0 0 'black)) (list (make-block 0 1 'black))) false) "Block set intersection." (check-expect (blocks=? (blocks-intersect empty empty) empty) true) (check-expect (blocks=? (blocks-intersect empty (list (make-block 0 0 'black))) empty) true) (check-expect (blocks=? (blocks-intersect (list (make-block 0 0 'black)) empty) empty) true) (check-expect (blocks=? (blocks-intersect (list (make-block 0 0 'black)) (list (make-block 0 0 'black))) (list (make-block 0 0 'black))) true) "Block set union." (check-expect (blocks=? (blocks-union empty empty) empty) true) (check-expect (blocks=? (blocks-union empty (list (make-block 0 0 'black))) (list (make-block 0 0 'black))) true) (check-expect (blocks=? (blocks-union (list (make-block 0 0 'black)) empty) (list (make-block 0 0 'black))) true) (check-expect (blocks=? (blocks-union (list (make-block 0 0 'black)) (list (make-block 0 0 'black))) (list (make-block 0 0 'black))) true) (check-expect (blocks=? (blocks-union (list (make-block 0 0 'black)) (list (make-block 0 1 'black))) (list (make-block 0 0 'black) (make-block 0 1 'black))) true) "Block set cardinality." (check-expect (blocks-count empty) 0) (check-expect (blocks-count (list (make-block 0 0 'black))) 1) (check-expect (blocks-count (blocks-union (list (make-block 0 0 'black)) (list (make-block 0 0 'black)))) 1) (check-expect (blocks-count (blocks-union (list (make-block 0 0 'black)) (list (make-block 1 1 'black)))) 2) "Block set maximal y-coordinate." (check-expect (blocks-max-y empty) 0) (check-expect (blocks-max-y (list (make-block 0 1 'black))) 1) (check-expect (blocks-max-y (list (make-block 1 0 'black))) 0) "Block set minimal x-coordinate." (check-expect (blocks-min-x empty) board-width) (check-expect (blocks-min-x (list (make-block 0 1 'black))) 0) (check-expect (blocks-min-x (list (make-block 1 0 'black))) 1) "Block set maximal x-coordinate." (check-expect (blocks-max-x empty) 0) (check-expect (blocks-max-x (list (make-block 0 1 'black))) 0) (check-expect (blocks-max-x (list (make-block 1 0 'black))) 1) "Block set move." (check-expect (blocks=? (blocks-move 0 0 empty) empty) true) (check-expect (blocks=? (blocks-move 0 0 (list (make-block 0 0 'black))) (list (make-block 0 0 'black))) true) (check-expect (blocks=? (blocks-move 1 1 (list (make-block 0 0 'black))) (list (make-block 1 1 'black))) true) "Block overflow." (check-expect (blocks-overflow? empty) false) (check-expect (blocks-overflow? (list (make-block 0 0 'black))) true) (check-expect (blocks-overflow? (list (make-block 0 1 'black))) false) "Block set row selection." (check-expect (blocks=? (blocks-row empty 0) empty) true) (check-expect (blocks=? (blocks-row (list (make-block 0 0 'black)) 1) empty) true) (check-expect (blocks=? (blocks-row (list (make-block 0 0 'black)) 0) (list (make-block 0 0 'black))) true) "Full row." (check-expect (full-row? empty 0) false) (generate-report)