;---------------------------------
; 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)
(define (create-valid-numbers current)
(if (<= current max-val)
(begin
(if (and (>= current min-val) (<= current max-val))
(push current valid-numbers))
; creates numbers recursively
(dolist (d digits)
(create-valid-numbers (+ (* current 10) d))))))
(define (random-integer min-val max-val digits)
(let (valid-numbers'())
(dolist (d digits) (create-valid-numbers d))
(valid-numbers (rand (length valid-numbers)))))
(random-integer 1 300 '(1 2 3))
;-> 21
(time (println (random-integer 1 90000000 '(1 2 3 4 5 6 7))))
;-> 44377532
;-> 6875.421
(define (randint RANGE DIGITS)
(letn ((digits (fn (X) (map int (unique (explode (string X))))))
(wrong (fn (X) (difference (digits X) DIGITS)))
(S (clean wrong (apply sequence RANGE))))
(S (rand (length S)))))
Quote from: pber on April 15, 2024, 07:13:47 AMMany thanks, itistoday, for you effort on newLISP.
Quote from: pber on April 15, 2024, 07:13:47 AMI`m studing his codebase and I`m starting to feel a profound feeling of respect and regard for him and his code, which is great (IMHO).
I hope to publish something about my project (Ike) in order to find help from you Lisp coders.