Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;;; 2048.el --- the 2048 game -*- lexical-binding: t; -*-
- ;;; Commentary:
- ;; https://github.com/gabrielecirulli/2048
- ;; TODO:
- ;; * scoring
- ;; * fancy display
- ;; * animated display?
- ;;; Code:
- (require 'gv)
- (require 'cl-lib)
- (defvar 2048-start-count 2
- "Number of starting tiles in the game.")
- (defvar 2048-orientation 'north
- "Orientation of the board when using `2048-get' and `2048-put'.")
- (cl-defstruct (\2048 (:constructor 2048--create))
- "An instance of the game of 2048."
- (size 4)
- (grid nil)
- (gravity-func #'2048--file-gravity)
- (combine-func #'2048--file-combine))
- (cl-defun 2048-create (&optional (size 4))
- "Create a new instance of a game of 2048."
- (let ((game (2048--create :size size :grid (make-vector (* size size) 0))))
- (prog1 game
- (cl-loop repeat 2048-start-count do (2048-add-random game)))))
- (cl-defun 2048-clone (game)
- "Return a full copy of GAME."
- (let ((copy (copy-sequence game)))
- (prog1 copy
- (setf (2048-grid copy) (copy-sequence (2048-grid game))))))
- (defun 2048--index (size x y)
- "Return the index for X and Y for the current `2048-orientation'."
- (cl-ecase 2048-orientation
- (north (+ x (* y size)))
- (east (+ (- size y 1) (* x size)))
- (west (+ y (* (- size x 1) size)))
- (south (+ (- size x 1) (* (- size y 1) size)))))
- (defun 2048-get (game x y)
- "Get the value in GAME at position X and Y."
- (aref (2048-grid game) (2048--index (2048-size game) x y)))
- (defun 2048-put (game x y value)
- "Set the value in GAME at position X and Y to VALUE."
- (setf (aref (2048-grid game) (2048--index (2048-size game) x y)) value))
- (gv-define-simple-setter 2048-get 2048-put)
- (defun 2048-empty (game)
- "Return a list of empty cell positions in GAME."
- (let ((empty ())
- (size (2048-size game)))
- (dotimes (x size)
- (dotimes (y size)
- (when (zerop (2048-get game x y)) (push (cons x y) empty))))
- empty))
- (defun 2048-add-random (game)
- "Place a random value in an empty space in GAME."
- (let ((value (if (< (cl-random 1.0) 0.9) 2 4))
- (empty (2048-empty game)))
- (unless (null empty)
- (cl-destructuring-bind (x . y) (elt empty (cl-random (length empty)))
- (setf (2048-get game x y) value)))))
- (defun 2048--file-get (game x)
- "Get the file along X."
- (cl-loop for y from 0 below (2048-size game)
- collect (2048-get game x y)))
- (defun 2048--file-put (game x file)
- "Set the file along X to list FILE."
- (cl-loop for y from 0 below (2048-size game)
- do (setf (2048-get game x y) (or (nth y file) 0))))
- (defun 2048--file-apply (game func)
- "Apply FUNC to the files of GAME, updating the files."
- (let ((size (2048-size game)))
- (dotimes (x size)
- (let* ((file (2048--file-get game x))
- (result (funcall func file)))
- (2048--file-put game x result)))))
- (defalias '2048--file-gravity (apply-partially #'remove 0)
- "Slide the values in a file all the way down.")
- (defun 2048--gravity (game)
- "Slide all slots down as far as they can go (low-level)."
- (2048--file-apply game (2048-gravity-func game)))
- (defun 2048--file-combine (file)
- "Combine numbers in FILE according to the rules of 2048."
- (if (null file)
- file
- (cl-destructuring-bind (x . xs) file
- (cond ((null xs) file)
- ((= x (car xs)) (cons (* x 2) (2048--file-combine (cdr xs))))
- ((cons x (2048--file-combine (cdr file))))))))
- (defun 2048--combine (game)
- "Combine slots downward where possible (low level)."
- (2048--file-apply game (2048-combine-func game)))
- (defun 2048-slide (game direction)
- "Slide the slots of GAME in DIRECTION."
- (let ((2048-orientation direction))
- (2048--gravity game)
- (2048--combine game)
- (2048-add-random game)))
- (defun 2048--has-moves-p (game)
- "Return non-nil if GAME has moves available."
- (or (cl-find 0 (2048-grid game))
- (let ((copy (2048-clone game)))
- (cl-loop for direction in '(north south east west)
- do (2048-slide game direction)
- unless (equal (2048-grid game) (2048-grid copy))
- return t))))
- (defun 2048-state (game)
- "Return the state of GAME (:win, :loss, or nil)."
- (cond ((find 2048 (2048-grid game)) :win)
- ((not (2048--has-moves-p game)) :loss)))
- (defun 2048-print (game)
- "Print the grid of GAME (for debugging)."
- (let ((size (2048-size game)))
- (dotimes (y size)
- (dotimes (x size)
- (let ((value (2048-get game x y)))
- (princ (format "% 3d " value))))
- (princ "\n"))))
- ;; User Interface:
- (defvar 2048-buffer-name "*2048*")
- (defvar-local 2048-game nil
- "The currently running game of 2048.")
- (defvar 2048-mode-map
- (let ((map (make-sparse-keymap)))
- (prog1 map
- (define-key map (kbd "<up>") #'2048-mode-north)
- (define-key map (kbd "<down>") #'2048-mode-south)
- (define-key map (kbd "<left>") #'2048-mode-west)
- (define-key map (kbd "<right>") #'2048-mode-east))))
- (define-derived-mode 2048-mode nil "2048"
- "A mode for playing 2048."
- (when (null 2048-game)
- (setf 2048-game (2048-create)))
- (setf buffer-read-only t)
- (suppress-keymap 2048-mode-map)
- (2048-mode-draw))
- (put '2048-mode 'mode-class 'special)
- (defun \2048 ()
- (interactive)
- (switch-to-buffer 2048-buffer-name)
- (2048-mode))
- (defun 2048-mode-north ()
- (interactive)
- (2048-slide 2048-game 'north)
- (2048-mode-draw))
- (defun 2048-mode-south ()
- (interactive)
- (2048-slide 2048-game 'south)
- (2048-mode-draw))
- (defun 2048-mode-east ()
- (interactive)
- (2048-slide 2048-game 'east)
- (2048-mode-draw))
- (defun 2048-mode-west ()
- (interactive)
- (2048-slide 2048-game 'west)
- (2048-mode-draw))
- (defun 2048-mode-draw ()
- (let ((buffer-read-only nil)
- (standard-output (current-buffer)))
- (erase-buffer)
- (2048-print 2048-game)))
- (provide '\2048)
- ;;; 2048.el ends here
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement