Code Select
;---------------------------------
; Minimalistic 2048 (4x4)
; Use "W" "A" "S" "D" key to move
; (load "g2048.lsp")
;---------------------------------
(define (print-grid)
(for (i 0 3)
(for (j 0 3)
(print (format "%4d " (grid i j))))
(println)) '>)
;
(define (find-zeros)
(let (pts '())
(for (i 0 3)
(for (j 0 3)
(if (zero? (grid i j)) (push (list i j) pts -1)))) pts))
;
(define (new-game)
(setq grid (array-list (array 4 4 '(0))))
(setq zeros (randomize (find-zeros)))
(setf (grid (zeros 0)) 2)
(setf (grid (zeros 1)) 2)
(input))
;
(define (input)
(print-grid)
(case (setq key (read-key))
(87 (up)) (119 (up))
(65 (left)) (97 (left))
(85 (down)) (115 (down))
(68 (right)) (100 (right))
(48 (exit)) ; "0" --> quit the game
(true (begin (println "Wrong key.") (setq key-error true)))
)
(cond ((ref 2048 grid) (println "Bravo! You win.") (print-grid))
((= key-error true) (setq key-error nil) (input))
(true
(setq zeros (randomize (find-zeros)))
(when zeros ; put 2 or 4 in a free cell
(if (zero? (rand 2))
(setf (grid (zeros 0)) 2)
(setf (grid (zeros 0)) 4)))
(input))))
;
(define (shift-right row)
(let ((non-zero (filter (fn (x) (!= x 0)) row))
(zeroes (filter (fn (x) (= x 0)) row)))
(extend zeroes non-zero)))
;
(define (shift-left row)
(let ((non-zero (filter (fn (x) (!= x 0)) row))
(zeroes (filter (fn (x) (= x 0)) row)))
(extend non-zero zeroes)))
;
(define (matrix-left matrix) (map shift-left matrix))
;
(define (matrix-right matrix) (map shift-right matrix))
;
(define (matrix-down matrix)
(let (trans (transpose matrix))
(transpose (map shift-right trans))))
;
(define (matrix-up matrix)
(let (trans (transpose matrix))
(transpose (map shift-left trans))))
;
(define (merge-numbers row)
(let ( (result '()) (idx 0) (len (length row)) )
(while (< idx len)
(if (and (< idx (- len 1)) (= (row idx) (row (+ idx 1))))
(begin
(push (* 2 (row idx)) result -1)
(++ idx 2))
(begin
(push (row idx) result -1)
(++ idx 1))))
(extend result (dup 0 (- len (length result))))))
;
(define (matrix-merge matrix) (map merge-numbers matrix))
;
(define (right)
(println "right")
(setq grid (matrix-right grid)) ; move the numbers to right
(setq grid (matrix-merge grid)) ; merge the numbers
(setq grid (matrix-right grid))) ; move the numbers to right
;
(define (left)
(println "left")
(setq grid (matrix-left grid))
(setq grid (matrix-merge grid))
(setq grid (matrix-left grid)))
;
(define (up)
(println "up")
(setq grid (matrix-up grid))
(setq grid (transpose (matrix-merge (transpose grid))))
(setq grid (matrix-up grid)))
;
(define (down)
(println "down")
(setq grid (matrix-down grid))
(setq grid (transpose (matrix-merge (transpose grid))))
(setq grid (matrix-down grid)))
;
(new-game)