389 lines
13 KiB
EmacsLisp
389 lines
13 KiB
EmacsLisp
;;; 2048.el --- Play the game 2048 in Emacs -*- lexical-binding: t -*-
|
|
|
|
;; Copyright 2014 Mark Burger
|
|
;; 2023 additions by Mitchell Marquez
|
|
|
|
;; Author: Mark Burger
|
|
;; Maintainer: Mitchell Marquez
|
|
;; Version: 0.2
|
|
;; Package-Requires: ((dash))
|
|
;; Keywords: games
|
|
|
|
;; This file is not part of GNU Emacs.
|
|
|
|
;;; Commentary:
|
|
;; 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.
|
|
;;
|
|
;; Features:
|
|
;; - NxN board size rather than hard-coded 4x4 (customize `2048--board-size')
|
|
;;
|
|
|
|
;; edits made by Mitchell Marquez <dr.m.perseos@gmail.com> on 2023-01-11
|
|
|
|
;;; Code:
|
|
|
|
(require 'dash)
|
|
|
|
(defgroup 2O48 nil
|
|
"Play a game of 2048."
|
|
:prefix "2048--"
|
|
:group 'games)
|
|
(defvar 2048--cell-width 6
|
|
"Width of number cells for 2048. Should be at least 4 to fit \"2048\".
|
|
|
|
Values other than 6 are not currently supported.")
|
|
(defcustom 2048--board-size 4
|
|
"Number of tiles on the board for 2048. 4 is the default. Can be any number."
|
|
:type 'integer
|
|
:group '2O48)
|
|
|
|
(defcustom 2048--vertical-sep-char ?│ ; 9478
|
|
"Character to use as a vertical border for 2048 cells."
|
|
:type 'character
|
|
:group '2O48)
|
|
(defcustom 2048--horizontal-sep-char ?─ ; 9472
|
|
"Character to use as a horizontal border for 2048 cells."
|
|
:type 'character
|
|
:group '2O48)
|
|
(defcustom 2048--corner-sep-char ?+
|
|
;; ?╬ ; needlessly fancy version
|
|
"Intersection of `2048--vertical-sep-char'and `2048--horizontal-sep-char'."
|
|
:type 'character
|
|
:group '2O48)
|
|
|
|
(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)
|
|
|
|
(defvar 2048-plus-sep (2048--make-sep-times
|
|
2048--corner-sep-char 2048--horizontal-sep-char
|
|
2048--board-size 2048--cell-width))
|
|
(defvar 2048-space-sep (2048--make-sep-times
|
|
2048--vertical-sep-char (string-to-char " ")
|
|
2048--board-size 2048--cell-width))
|
|
(defun 2048--pad (number)
|
|
"Pad NUMBER with spaces, to fit inside the 2048 grid.
|
|
|
|
TODO: rewrite with calculations based on `2048--cell-width's other than 6."
|
|
(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--scroll-left (&optional arg set-minmum)
|
|
(interactive) (2048-shift-left))
|
|
(defun 2048--scroll-right (&optional arg set-minmum)
|
|
(interactive) (2048-shift-right))
|
|
(defun 2048--scroll-up (&optional arg set-minmum)
|
|
(interactive) (2048-shift-up))
|
|
(defun 2048--scroll-down (&optional arg set-minmum)
|
|
(interactive) (2048-shift-down))
|
|
|
|
(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
|
|
;; Arrow keys
|
|
(local-set-key (kbd "<left>") '2048-shift-left)
|
|
(local-set-key (kbd "<right>") '2048-shift-right)
|
|
(local-set-key (kbd "<down>") '2048-shift-down)
|
|
(local-set-key (kbd "<up>") '2048-shift-up)
|
|
;; Vim keys
|
|
(local-set-key (kbd "h") '2048-shift-left)
|
|
(local-set-key (kbd "l") '2048-shift-right)
|
|
(local-set-key (kbd "j") '2048-shift-down)
|
|
(local-set-key (kbd "k") '2048-shift-up)
|
|
;; Swipe controls for termux
|
|
(setq-local mwheel-scroll-left-function '2048--scroll-left)
|
|
(setq-local mwheel-scroll-right-function '2048--scroll-right)
|
|
(setq-local mwheel-scroll-down-function '2048--scroll-down)
|
|
(setq-local mwheel-scroll-up-function '2048--scroll-up)
|
|
|
|
(2048-startup)
|
|
(setq font-lock-defaults '(2048-highlights)))
|
|
|
|
(defun play-2048 ()
|
|
"Play 2048 in Emacs!"
|
|
(interactive)
|
|
(switch-to-buffer (get-buffer-create "*2048*"))
|
|
(2048-mode))
|
|
|
|
(provide '2O48)
|
|
;;; 2048.el ends here
|