From 0333a3ccd302bed2db5d863b79c189be6f78ab7f Mon Sep 17 00:00:00 2001 From: MitchMarq42 Date: Thu, 12 Jan 2023 08:48:36 -0900 Subject: [PATCH] Add 2048.el file - see https://github.com/ScottishPig/Elisp/blob/master/2048.el --- lisp/2048.el | 360 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 360 insertions(+) create mode 100644 lisp/2048.el diff --git a/lisp/2048.el b/lisp/2048.el new file mode 100644 index 0000000..ef52f5b --- /dev/null +++ b/lisp/2048.el @@ -0,0 +1,360 @@ +;; -*- lexical-binding: t -*- +;; E L I S P ,6*"*VA. +;; dN V8 +;; pd*"*b. ,pP""Yq. ,AM `MN. ,g9 +;; (O) j8 6W' `Wb AVMM ,MMMMq. +;; ,;j9 8M M8 ,W' MM 6P `YMb +;; ,-=' YA. ,A9 ,W' MM 8b `M9 +;; Ammmmmmm 'Ybmmd7* AmmmmmMMmm `MmmmmM9 +;; MM +;; Mark Burger, 2014 MM +;; +;; 1. Load this up with M-x eval-buffer OR put (load ".../2048.el") in your +;; ~/.emacs file +;; 2. Use M-x play-2048 to start playing. +;; +;; Possible future additions: NxN board size rather than hard-coded 4x4 +;; + +;; edits made by Mitchell Marquez on 2023-01-11 + +(defvar 2048--cell-width 6 + "Width of number cells for 2048. Should be at least 4 to fit \"2048\".") +(defvar 2048--board-size 4 + "Number of tiles on the board for 2048. 4 is the default.") + +(defvar 2048--vertical-sep-char ?│ + "Character to use as a vertical border for 2048 cells.") +(defvar 2048--horizontal-sep-char ?─ + "Character to use as a horizontal border for 2048 cells.") +(defvar 2048--corner-sep-char ?+ + "Character to use as the intersection between `2048--vertical-sep-char' +and `2048--horizontal-sep-char'.") + +(defun 2048--make-sep-times (delimiter filler cells cellwidth) + "Return a string of CELLS number of cells, each with width CELLWIDTH. +The cells consist of FILLER and are separated by DELIMITER." + (let* ((filler-list (make-list cellwidth filler)) + (rh-list (append filler-list delimiter)) + (skeleton-list (make-list cells nil)) + (almost-done-list (-replace nil rh-list skeleton-list))) + (concat (flatten-tree (list delimiter almost-done-list))))) +;; (2048--make-sep-times ?> ?- 5 2) + +(setq 2048-plus-sep (2048--make-sep-times + 2048--corner-sep-char 2048--horizontal-sep-char + ;; ?╬ ?─ ; needlessly fancy version + 2048--board-size 2048--cell-width)) +(setq 2048-space-sep (2048--make-sep-times + 2048--vertical-sep-char (string-to-char " ") + 2048--board-size 2048--cell-width)) +(defun 2048--pad (number) + (cond + ((= number 0) " ") + ((< number 10) (format " %i " number)) + ((< number 100) (format " %i " number)) + ((< number 1000) (format " %i " number)) + (t (format " %i " number))) ) + +(defface 2048-2 + '((t :weight bold + :foreground "#888")) + "Face for number 2 in 2048." + :group '2048-mode) +(defface 2048-4 + '((t :weight bold + :foreground "#666")) + "Face for number 4 in 2048." + :group '2048-mode) +(defface 2048-8 + '((t :weight bold + :foreground "#FA3")) + "Face for number 8 in 2048." + :group '2048-mode) +(defface 2048-16 + '((t :weight bold + :foreground "#F99")) + "Face for number 16 in 2048." + :group '2048-mode) +(defface 2048-32 + '((t :weight bold + :foreground "#F66")) + "Face for number 32 in 2048." + :group '2048-mode) +(defface 2048-64 + '((t :weight bold + :foreground "#F00")) + "Face for number 64 in 2048." + :group '2048-mode) +(defface 2048-128 + '((t :weight bold + :foreground "#AA8")) + "Face for number 128 in 2048." + :group '2048-mode) +(defface 2048-256 + '((t :weight bold + :foreground "#CC6")) + "Face for number 256 in 2048." + :group '2048-mode) +(defface 2048-512 + '((t :weight bold + :foreground "#AA4")) + "Face for number 512 in 2048." + :group '2048-mode) +(defface 2048-1024 + '((t :weight bold + :foreground "#883")) + "Face for number 1024 in 2048." + :group '2048-mode) +(defface 2048-2048 + '((t :weight bold + :foreground "#0A6")) + "Face for number 2048 in 2048." + :group '2048-mode) +(defface 2048-4096 + '((t :weight bold + :foreground "#0F0")) + "Face for number 4096 in 2048." +:group '2048-mode) +(setq 2048-highlights + '( + (" 2 " . '2048-2) + (" 4 " . '2048-4) + (" 8 " . '2048-8) + (" 16 " . '2048-16) + (" 32 " . '2048-32) + (" 64 " . '2048-64) + (" 128 " . '2048-128) + (" 256 " . '2048-256) + (" 512 " . '2048-512) + (" 1024 " . '2048-1024) + (" 2048 " . '2048-2048) + (" 4096 " . '2048-4096) + )) + +(defun 2048-draw-board () + "Draws the 4x4 gaming grid." + (dotimes (j 2048--board-size) + (insert (concat 2048-plus-sep "\n") ) + (insert (concat 2048-space-sep "\n") ) + (dotimes (i 2048--board-size) + (let ( (k (2048-get-num-at i j)) (o "") ) + (insert 2048--vertical-sep-char) + (setq o (2048--pad k)) + (insert o) + ) + ) + (insert ;(concat "|\n" 2048-space-sep "\n") + (concat (string 2048--vertical-sep-char ?\n) 2048-space-sep "\n") + ) + ) + (insert 2048-plus-sep) + ) + +(defun 2048-get-num-at (x y) "0, 0 is top-left" (aref (aref 2048-board y) x) ) + +(defun 2048-slide-single-piece (x y direction) + "Handles the movement of a single block at x,y in direction passed from +the 2048-shift function. Slides and merges for four directions." + ;; THIS IS THE MOST TEDIUS THING FUCKING EVER. + (catch 'breaker + (when (2048-check-diff x y) (throw 'breaker 0)) + (let ((i x) + (j y)) + (cond + ;; DONE. Blessed? + ((string= direction "r") + (while (< i (1- 2048--board-size)) + (cond + ;; Next space is empty + ((= (2048-get-num-at (+ i 1) j) 0) + (aset (aref 2048-board j) (+ i 1) + (2048-get-num-at i j)) + (aset (aref 2048-board j) i 0)) + ;; Next space is not current space (stop) + ((/= (2048-get-num-at i j) + (2048-get-num-at (+ i 1) j)) + (throw 'breaker 0)) + ;; Otherwise, squish the blocks + (t (aset (aref 2048-board j) (+ i 1) + (* (2048-get-num-at i j) 2)) + (aset (aref 2048-board j) i 0) + (throw 'breaker 0))) + (setq i (+ i 1)))) + ;; This 'un looks good, too. + ((string= direction "l") + (while (> i 0) + (cond + ;; Next space is empty + ((= (2048-get-num-at (- i 1) j) 0) + (aset (aref 2048-board j) (- i 1) + (2048-get-num-at i j)) + (aset (aref 2048-board j) i 0)) + ;; Next space is not current space (stop) + ((/= (2048-get-num-at i j) + (2048-get-num-at (- i 1) j)) + (throw 'breaker 0)) + ;; Otherwise, squish the blocks + (t (aset (aref 2048-board j) (- i 1) + (* (2048-get-num-at i j) 2)) + (aset (aref 2048-board j) i 0) + (throw 'breaker 0))) + (setq i (- i 1)))) + ;; Up! Lookin' OK + ((string= direction "u") + (while (> j 0) + (cond + ;; Next space is empty + ((= (2048-get-num-at i (- j 1) ) 0) + (aset (aref 2048-board (- j 1) ) i + (2048-get-num-at i j)) + (aset (aref 2048-board j) i 0)) + ;; Next space is not current space (stop) + ((/= (2048-get-num-at i j) + (2048-get-num-at i (- j 1) )) + (throw 'breaker 0)) + ;; Otherwise, squish the blocks + (t (aset (aref 2048-board (- j 1)) i + (* (2048-get-num-at i j) 2)) + (aset (aref 2048-board j) i 0) + (throw 'breaker 0))) + (setq j (- j 1)))) + ;; Down! Test. + ((string= direction "d") + (while (< j (1- 2048--board-size)) + (cond + ;; Next space is empty + ((= (2048-get-num-at i (+ j 1) ) 0) + (aset (aref 2048-board (+ j 1) ) i + (2048-get-num-at i j)) + (aset (aref 2048-board j) i 0)) + ;; Next space is not current space (stop) + ((/= (2048-get-num-at i j) + (2048-get-num-at i (+ j 1) )) + (throw 'breaker 0)) + ;; Otherwise, squish the blocks + (t (aset (aref 2048-board (+ j 1)) i + (* (2048-get-num-at i j) 2)) + (aset (aref 2048-board j) i 0) + (throw 'breaker 0))) + (setq j (+ j 1)))))))) + +(defun 2048-count-empties () + "Return the number of non-zero spaces in 2048-board array." + (let ((k 0)) + (dotimes (j 2048--board-size) + (dotimes (i 2048--board-size) + (when (= (2048-get-num-at i j) 0) (setq k (+ k 1))) + ) + ) + k + ) + ) + +(defun 2048-check-total-diff () + "Run 2048-check-diff on the whole board. Return t/nil if board has changed +or not. Only relevant after 2048-push-board is called and modifications are +made to the 2048-board array." + (catch 'breaker + (dotimes (j 2048--board-size) + (dotimes (i 2048--board-size) + (when (2048-check-diff i j) (throw 'breaker t)) + ) + ) + (throw 'breaker nil) + ) + ) + +(defun 2048-check-diff (x y) + "Returns t if board has changed since beginning of shift." + (/= (aref (aref 2048-board y) x) + (aref (aref 2048-board-old y) x)) + ) + +(defun 2048-push-board() + "Push 2048-board to 2048-board-old. Essentially makes a snapshot of the +game board to detect modifications later." + (dotimes (j 2048--board-size) + (dotimes (i 2048--board-size) + (aset (aref 2048-board-old j) i (aref (aref 2048-board j) i)) + ) + ) + ) + +(defun 2048-spawn () + "Add either a 2 or 4 to the 2048-board array at a random, free space." + (catch 'breaker + (when (= (2048-count-empties) 0) (throw 'breaker 0)) + (let ((j (random 2048--board-size)) (i (random 2048--board-size)) (k (random 100))) + (while (/= (2048-get-num-at i j) 0) + (setq i (random 2048--board-size)) + (setq j (random 2048--board-size)) + ) + (cond ( (< k 75) (aset (aref 2048-board j) i 2 )) + ( t (aset (aref 2048-board j) i 4))) + ) + ) + ) + +(defun 2048-shift (direction) + "Entry point for shifting. All the keypresses get mapped to this function with +different arguments. This iterates across the board and slides the tiles +individually." + (2048-push-board) + (cond + ((or (string= direction "l") (string= direction "u")) + (dotimes (j 2048--board-size) + (dotimes (i 2048--board-size) + (2048-slide-single-piece i j direction) + ) + ) + ) + + ((or (string= direction "r") (string= direction "d")) + (dotimes (j 2048--board-size) + (dotimes (i 2048--board-size) + (2048-slide-single-piece (- (1- 2048--board-size) i) (- (1- 2048--board-size) j) direction) + ) + ) + ) + ) + + (when + (2048-check-total-diff) (2048-spawn)) + ;; Redraw... even if stuff don't need it. + (erase-buffer) + (2048-draw-board) + ) + +(defun 2048-shift-left () (interactive) (2048-shift "l") ) +(defun 2048-shift-right () (interactive) (2048-shift "r")) +(defun 2048-shift-up () (interactive) (2048-shift "u")) +(defun 2048-shift-down () (interactive) (2048-shift "d")) + +(defun 2048-startup () + "Starts up the game mode for 2048!" + (interactive) + (setq 2048-board (make-vector 2048--board-size 0)) + (dotimes (i 2048--board-size) (aset 2048-board i (make-vector 2048--board-size 0)) ) + (setq 2048-board-old (make-vector 2048--board-size 0)) + (dotimes (i 2048--board-size) (aset 2048-board-old i (make-vector 2048--board-size 0)) ) + (dotimes (i 2) (2048-spawn)) + (2048-draw-board) + ) + +(define-derived-mode 2048-mode fundamental-mode "2048" + "Major mode for playing 2048 in Emacs." + (random t) ;; Start up the RNG + (local-set-key (kbd "") '2048-shift-left) + (local-set-key (kbd "") '2048-shift-right) + (local-set-key (kbd "") '2048-shift-down) + (local-set-key (kbd "") '2048-shift-up) + (2048-startup) + (setq font-lock-defaults '(2048-highlights)) + ) + +(defun play-2048 () + "Play 2048 in Emacs!" + (switch-to-buffer (get-buffer-create "*2048*")) + (2048-mode) + )