diff options
author | Jordan Russell <jordan.likes.curry@gmail.com> | 2014-07-01 19:54:11 -0700 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2014-07-03 17:49:50 -0400 |
commit | bf94a6467ffac40dae55ebef8372cfac2d6a4bbb (patch) | |
tree | 006fd09eb5eb012bb35b7482d70ddf3d29f6ec30 | |
parent | 17cb007e7ad294cf9bb8f40aa8fe30a0665bd487 (diff) |
2048: Fix board-win? and improve board-insert.
* examples/2048/2048 (board-win?): Check the board passed in, not a new one.
(board-insert): Simplify.
(replace-at): New procedure.
-rwxr-xr-x | examples/2048/2048 | 24 |
1 files changed, 12 insertions, 12 deletions
diff --git a/examples/2048/2048 b/examples/2048/2048 index 0bda152..c7a3b8d 100755 --- a/examples/2048/2048 +++ b/examples/2048/2048 @@ -54,6 +54,11 @@ (define (enumerate lst) (zip (iota (length lst)) lst)) +(define (replace-at lst idx item) + (let-values (((f d) + (split-at lst idx))) + (append f (cons item (cdr d))))) + ;;; ;;; Game Board ;;; @@ -141,20 +146,15 @@ (define (random-tile) (list-ref '(2 4) (random 2))) -;; So gross. (define (board-insert board) (let ((x (random board-size)) (y (random board-size))) - (if (zero? (list-ref (list-ref board y) x)) - (append (take board y) - (let ((rows (drop board y))) - (cons (let ((cells (car rows))) - (append (take cells x) - (let ((rest (drop cells x))) - (cons (random-tile) - (cdr rest))))) - (cdr rows)))) - (board-insert board)))) + (let-values (((f d) + (split-at (list-ref board y) x))) + (if (zero? (car d)) + (replace-at board y + (append f (cons (random-tile) (cdr d)))) + (board-insert board))))) (define (board-find board n) (list? @@ -163,7 +163,7 @@ board))) (define (board-win? board) - (board-find (make-board) 2048)) + (board-find board 2048)) (define (board-lose? board) (define (full? row) |