Klimi's new dotfiles with stow.
No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.

538 líneas
21 KiB

hace 4 años
  1. ;;; 2048-game.el --- play 2048 in Emacs
  2. ;; Copyright 2014 Zachary Kanfer
  3. ;; Author: Zachary Kanfer <zkanfer@gmail.com>
  4. ;; Version: 2014.03.27
  5. ;; Package-Version: 20151026.1933
  6. ;; URL: https://bitbucket.org/zck/2048.el
  7. ;; This file is not part of GNU Emacs
  8. ;; This program is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; This program is an implementation of 2048 for Emacs.
  20. ;; To begin playing, call `M-x 2048-game`, then use the arrow keys,
  21. ;; p/n/b/f, or C-p/C-n/C-b/C-f to move the tiles around.
  22. ;; Whenever you move the board, all tiles slide as far to that direction
  23. ;; as they can go. If a tile collides with another tile of the same value,
  24. ;; the tiles combine into a tile with double the initial value, and you
  25. ;; gain the new tile's value as your score.
  26. ;; The goal is to create a tile with value 2048.
  27. ;; The size of the board and goal value can be customized -- see the variables
  28. ;; *2048-columns*, *2048-rows*, and *2048-victory-value*.
  29. ;;; Code:
  30. (define-derived-mode 2048-mode special-mode "2048-mode"
  31. (define-key 2048-mode-map (kbd "p") '2048-up)
  32. (define-key 2048-mode-map (kbd "C-p") '2048-up)
  33. (define-key 2048-mode-map (kbd "<up>") '2048-up)
  34. (define-key 2048-mode-map (kbd "n") '2048-down)
  35. (define-key 2048-mode-map (kbd "C-n") '2048-down)
  36. (define-key 2048-mode-map (kbd "<down>") '2048-down)
  37. (define-key 2048-mode-map (kbd "b") '2048-left)
  38. (define-key 2048-mode-map (kbd "C-b") '2048-left)
  39. (define-key 2048-mode-map (kbd "<left>") '2048-left)
  40. (define-key 2048-mode-map (kbd "f") '2048-right)
  41. (define-key 2048-mode-map (kbd "C-f") '2048-right)
  42. (define-key 2048-mode-map (kbd "<right>") '2048-right)
  43. (define-key 2048-mode-map (kbd "r") '2048-random-move))
  44. ;;;###autoload
  45. (defun 2048-game () "Start playing 2048."
  46. (interactive)
  47. (switch-to-buffer "2048")
  48. (buffer-disable-undo "2048")
  49. (2048-mode)
  50. (2048-init))
  51. (require 'cl-lib)
  52. (defvar *2048-board* nil
  53. "The board itself.
  54. If a number is in the square, the number is stored. Otherwise, 0 is stored.
  55. Instead of accessing this directly, use 2048-get-cell.")
  56. (defvar *2048-combines-this-move* nil
  57. "This stores, for each cell in the board, whether the number in it was generated this turn by two numbers combining.")
  58. (defvar *2048-columns* 4
  59. "The width of the board. It could be customized, if you wanted to make the game very very hard, or very very easy.")
  60. (defvar *2048-rows* 4
  61. "The height of the board. It could be customized, if you wanted to make the game very very tall, or very very short.")
  62. (defvar *2048-possible-values-to-insert* (cons 4 (make-list 9 2))
  63. "When a new element is inserted into the board, randomly choose a number from this sequence.")
  64. (defvar *2048-victory-value* nil
  65. "When this number is reached, the user wins! Yay!")
  66. (defvar *2048-default-victory-value* 2048
  67. "When the game starts, reset *2048-victory-value* to this value.")
  68. (defvar *2048-debug* nil
  69. "When 't, print debugging information.")
  70. (defconst *2048-numbers* '(0 2 4 8 16 32 64 128 256 512 1024 2048))
  71. (defvar *2048-score* nil
  72. "Current score in the game.")
  73. (defvar *2048-hi-tile* nil
  74. "Current highest-number tile.")
  75. (defvar *2048-history* nil
  76. "Score history in this Emacs session. Each element is (SCORE HI-TILE TIME).")
  77. (defvar *2048-history-size* 10
  78. "Keep this many items in the history.")
  79. (defvar *2048-game-has-been-added-to-history* nil
  80. "Whether the current game has been added to the history yet.
  81. Right now, it's only for use when the game has been lost. Since the user can choose to not start a new game, we want to add the score to the history the first time the game is lost, but not any other time.")
  82. (defvar *2048-game-epoch* nil
  83. "The time the current game started.")
  84. ;; These are prefixed with "twentyfortyeight-face-", not "2048-face"
  85. ;; because face names starting with numbers break htmlfontify-buffer,
  86. ;; as CSS classes beginning with numbers are ignored.
  87. (defface twentyfortyeight-face-2 '((t . (:background "khaki" :foreground "black"))) "Face for the tile 2" :group '2048-faces)
  88. (defface twentyfortyeight-face-4 '((t . (:background "burlywood" :foreground "black"))) "Face for the tile 4" :group '2048-faces)
  89. (defface twentyfortyeight-face-8 '((t . (:background "orange3" :foreground "black"))) "Face for the tile 8" :group '2048-faces)
  90. (defface twentyfortyeight-face-16 '((t . (:background "orange" :foreground "black"))) "Face for the tile 16" :group '2048-faces)
  91. (defface twentyfortyeight-face-32 '((t . (:background "orange red" :foreground "black"))) "Face for the tile 32" :group '2048-faces)
  92. (defface twentyfortyeight-face-64 '((t . (:background "firebrick" :foreground "white"))) "Face for the tile 64" :group '2048-faces)
  93. (defface twentyfortyeight-face-128 '((t . (:background "dark red" :foreground "white"))) "Face for the tile 128" :group '2048-faces)
  94. (defface twentyfortyeight-face-256 '((t . (:background "dark magenta" :foreground "white"))) "Face for the tile 256" :group '2048-faces)
  95. (defface twentyfortyeight-face-512 '((t . (:background "magenta" :foreground "black"))) "Face for the tile 512" :group '2048-faces)
  96. (defface twentyfortyeight-face-1024 '((t . (:background "gold" :foreground "black"))) "Face for the tile 1024" :group '2048-faces)
  97. (defface twentyfortyeight-face-2048 '((t . (:background "yellow" :foreground "black"))) "Face for the tile 2048" :group '2048-faces)
  98. (defun 2048-get-face (number)
  99. "Return the face for squares holding NUMBER."
  100. (let ((face-symbol (2048-get-face-symbol number)))
  101. (if (facep face-symbol)
  102. face-symbol
  103. 'twentyfortyeight-face-2048)))
  104. (defun 2048-get-face-symbol (number)
  105. "Return the face symbol for squares holding NUMBER."
  106. (intern (concat "twentyfortyeight-face-"
  107. (int-to-string number))))
  108. (defun 2048-empty-tile (num)
  109. "Return the tile to be inserted for the blank part of a square holding NUM.
  110. That is, an empty string with font stuff on it."
  111. (symbol-value (2048-empty-symbol num)))
  112. (defun 2048-empty-symbol (num)
  113. "Return symbol of the variable holding empty space for number NUM."
  114. (intern (concat "2048-empty-" (int-to-string num))))
  115. (defun 2048-tile-symbol (num)
  116. "Return symbol of the variable for the tile for squares holding NUM."
  117. (intern (concat "2048-tile-" (int-to-string num))))
  118. (defun 2048-tile (num)
  119. "Return the tile to be inserted for a square holding NUM.
  120. The tile is the string, but with extra font stuff on it."
  121. (symbol-value (2048-tile-symbol num)))
  122. (defmacro 2048-game-move (&rest body)
  123. "Perform the game move indicated by BODY.
  124. This macro is used to do some housekeeping around the move."
  125. `(progn (setq *2048-combines-this-move* (make-vector (* *2048-columns* *2048-rows*)
  126. nil))
  127. ,@body
  128. (2048-print-board)
  129. (2048-check-game-end)))
  130. (defmacro 2048-debug (&rest body)
  131. "If *2048-debug* is 't, log ,@BODY as a string to the buffer named '2048-debug'."
  132. `(when *2048-debug*
  133. (print (concat ,@body)
  134. (get-buffer-create "2048-debug"))))
  135. (defun 2048-init-tiles ()
  136. "Initialize each variable 2048-empty-N and 2048-tile-N with appropriate string and face."
  137. (mapc #'2048-init-tile
  138. *2048-numbers*))
  139. (defun 2048-init-tile (number)
  140. "Initialize the tile holding NUMBER.
  141. This sets up both the tile to hold it, and the empty space around it."
  142. (set (2048-empty-symbol number) (format "%7s" " "))
  143. ;; if constant then all faces are applied to this one constant. (Symptom: all background is yellow)
  144. ;; The bytecompiler is smart enough to see that (concat...) is a constant, but not (format...) ;-)
  145. (set (2048-tile-symbol number) (format "%5s " (2048-num-to-printable number)))
  146. (when (> number 0)
  147. (let ((face (2048-get-face number)))
  148. (put-text-property 0 7 'font-lock-face face (2048-empty-tile number))
  149. (put-text-property 0 7 'font-lock-face face (2048-tile number)))))
  150. (defun 2048-test-tiles ()
  151. "Test out the tile colors."
  152. (interactive)
  153. (let ((*2048-board*
  154. (vconcat *2048-numbers*
  155. (make-vector (- (* *2048-columns* *2048-rows*)
  156. (length *2048-numbers*))
  157. 0)))
  158. (*2048-score* 123456)
  159. (*2048-history* '((123 512 "2014-06-18 12:34:56" (0 30 0 0))
  160. (456 1024 "2014-06-18 12:45:00" (0 123 0 0)))))
  161. (switch-to-buffer "2048-test")
  162. (2048-init-tiles)
  163. (2048-mode)
  164. (2048-print-board)))
  165. (defun 2048-init ()
  166. "Begin a game of 2048."
  167. (setq *2048-board* (make-vector (* *2048-columns* *2048-rows*)
  168. 0))
  169. (setq *2048-combines-this-move* (make-vector (* *2048-columns* *2048-rows*)
  170. nil))
  171. (setq *2048-score* 0
  172. *2048-hi-tile* 2)
  173. (setq *2048-victory-value* *2048-default-victory-value*)
  174. (setq *2048-game-has-been-added-to-history* nil)
  175. (setq *2048-game-epoch* (current-time))
  176. (2048-insert-random-cell)
  177. (2048-insert-random-cell)
  178. (2048-init-tiles)
  179. (2048-print-board)
  180. (message "Good luck!"))
  181. (defun 2048-get-cell (row col)
  182. "Get the value in (ROW, COL)."
  183. (elt *2048-board*
  184. (+ (* row *2048-columns*)
  185. col)))
  186. (defun 2048-set-cell (row column val)
  187. "Set the value in (ROW, COLUMN) to VAL."
  188. (when (< *2048-hi-tile* val)
  189. (setq *2048-hi-tile* val))
  190. (aset *2048-board*
  191. (+ (* row *2048-columns*)
  192. column)
  193. val))
  194. (defun 2048-num-to-printable (num)
  195. "Return NUM as a string that can be put into the board.
  196. That is, print zeros as empty strings, and all other numbers as themselves."
  197. (if (eq num 0)
  198. ""
  199. (format "%d" num)))
  200. (defun 2048-was-combined-this-turn (row column)
  201. "Return whether the number in (ROW, COLUMN) was generated this turn by two numbers combining."
  202. (elt *2048-combines-this-move*
  203. (+ (* row *2048-columns*)
  204. column)))
  205. (defun 2048-set-was-combined-this-turn (row column)
  206. "Set that the number in (ROW, COLUMN) was generated this turn by two numbers combining."
  207. (2048-debug (format "setting (%d, %d) as combined this turn." row column))
  208. (aset *2048-combines-this-move*
  209. (+ (* row *2048-columns*)
  210. column)
  211. t))
  212. (defun 2048-insert-random-cell ()
  213. "Pick a number randomly, and insert it into a random cell."
  214. (let ((number-to-insert (elt *2048-possible-values-to-insert*
  215. (random (length *2048-possible-values-to-insert*))))
  216. (row (random *2048-rows*))
  217. (column (random *2048-columns*)))
  218. (while (not (eq (2048-get-cell row column)
  219. 0))
  220. (setq row (random *2048-rows*))
  221. (setq column (random *2048-columns*)))
  222. (2048-set-cell row column number-to-insert)))
  223. (defun 2048-check-game-end ()
  224. "Check whether the game has either been won or lost. If so, notify the user and restarting."
  225. (cond ((2048-game-was-won)
  226. (2048-print-board)
  227. (if (y-or-n-p "Yay! You beat the game! y to start again; n to continue. Start again? ")
  228. (progn (2048-add-new-history-item *2048-score* *2048-hi-tile* (current-time) (time-subtract (current-time) *2048-game-epoch*))
  229. (2048-init))
  230. (setq *2048-victory-value*
  231. (* *2048-victory-value* 2))))
  232. ((2048-game-was-lost)
  233. (unless *2048-game-has-been-added-to-history*
  234. (2048-add-new-history-item *2048-score* *2048-hi-tile* (current-time) (time-subtract (current-time) *2048-game-epoch*))
  235. (setq *2048-game-has-been-added-to-history* t))
  236. (2048-print-board)
  237. (when (y-or-n-p "Aw, too bad. You lost. Want to play again? ")
  238. (2048-init)))))
  239. (defun 2048-add-new-history-item (score hi-tile game-end-time game-duration)
  240. "Generate and add a new history item to the score list.
  241. This item should have score SCORE, the highest tile reached as HI-TILE,
  242. have ended at GAME-END-TIME, and have duration GAME-DURATION"
  243. (setq *2048-history*
  244. (let ((history-length (length *2048-history*)))
  245. ;; get the history length before calling cl-sort because cl-sort is destructive.
  246. (butlast (cl-sort (cons (list *2048-score*
  247. *2048-hi-tile*
  248. (format-time-string "%Y-%m-%d" game-end-time)
  249. game-duration)
  250. *2048-history*)
  251. '>
  252. :key 'car)
  253. (max 0
  254. (- (1+ history-length)
  255. *2048-history-size*))))))
  256. (defun 2048-game-was-won ()
  257. "Return t if the game was won, nil otherwise."
  258. (let ((game-was-won nil))
  259. (dotimes (row *2048-rows*)
  260. (dotimes (column *2048-columns*)
  261. (when (eq (2048-get-cell row column)
  262. *2048-victory-value*)
  263. (setq game-was-won t))))
  264. game-was-won))
  265. (defun 2048-game-was-lost ()
  266. "Return t if the game was lost, nil otherwise."
  267. (let ((game-was-lost t))
  268. (dotimes (row *2048-rows*)
  269. (dotimes (column *2048-columns*)
  270. (when (eq (2048-get-cell row column)
  271. 0)
  272. (setq game-was-lost nil))))
  273. ;; For each square, if that square has one below it that's the same,
  274. ;; the game's not over.
  275. (dotimes (row (1- *2048-rows*))
  276. (dotimes (column *2048-columns*)
  277. (when (eq (2048-get-cell row column)
  278. (2048-get-cell (1+ row) column))
  279. (setq game-was-lost nil))))
  280. ;; For each square, if that square has one to its right that's the same,
  281. ;; the game's not over.
  282. (dotimes (row *2048-rows*)
  283. (dotimes (column (1- *2048-columns*))
  284. (when (eq (2048-get-cell row column)
  285. (2048-get-cell row (1+ column)))
  286. (setq game-was-lost nil))))
  287. game-was-lost))
  288. (defun 2048-print-board ()
  289. "Wipes the entire field, and prints the board."
  290. (let ((inhibit-read-only t))
  291. (erase-buffer)
  292. (dotimes (row *2048-rows*)
  293. ;;print the separator line on top of, and between cells
  294. (dotimes (col *2048-columns*)
  295. (insert "+-------"))
  296. (insert "+")
  297. (insert "\n")
  298. ;;print the empty line above numbers
  299. (dotimes (col *2048-columns*)
  300. (insert "|")
  301. (let ((current-value (2048-get-cell row col)))
  302. (insert (2048-empty-tile current-value))))
  303. (insert "|")
  304. (insert "\n")
  305. ;; print the number tiles
  306. (dotimes (col *2048-columns*)
  307. (insert "|")
  308. (let ((current-value (2048-get-cell row col)))
  309. (insert (2048-tile current-value))))
  310. (insert "|")
  311. (insert "\n")
  312. ;;print the empty line below numbers
  313. (dotimes (col *2048-columns*)
  314. (insert "|")
  315. (let ((current-value (2048-get-cell row col)))
  316. (insert (2048-empty-tile current-value))))
  317. (insert "|")
  318. (insert "\n"))
  319. ;;print the separator line on the bottom of the last row.
  320. (dotimes (col *2048-columns*)
  321. (insert "+-------"))
  322. (insert "+\n")
  323. (insert "\n")
  324. (let ((score-width (if (= 0 *2048-score*)
  325. 1
  326. (ceiling (log *2048-score* 10)))))
  327. (insert (format "%10s%s%s\n" "/" (make-string (+ 9
  328. score-width)
  329. ?\=) "\\"))
  330. (insert (format "%10s %s %d %s\n" "|" "Score:" *2048-score* "|"))
  331. (insert (format "%10s%s%s\n" "\\" (make-string (+ 9
  332. score-width)
  333. ?\=) "/")))
  334. (insert "\n")
  335. (2048-print-help)
  336. (insert "\n")
  337. ;; print score and history
  338. (insert (format "%10s%s%s\n" "/" (make-string 13 ?\=) "\\"))
  339. (insert (format "%24s\n" "| HIGH SCORES |"))
  340. (insert (format "%10s%s%s\n" "\\" (make-string 13 ?\=) "/"))
  341. (insert "\n")
  342. (insert (format "%8s %7s %7s %4s\n" "Score" "Hi-Tile" "Date" "Duration"))
  343. (mapc #'(lambda (x)
  344. (insert (format "%8d %7d %10s %s\n"
  345. (elt x 0) (elt x 1) (elt x 2) (format-time-string "%H:%M:%S" (elt x 3) t))))
  346. *2048-history*)
  347. (goto-char (point-min))))
  348. (defun 2048-print-help ()
  349. "Print basic help text."
  350. (insert "The goal is to create a tile with value 2048.
  351. Use the arrow keys, p/n/b/f, or C-p/C-n/C-b/C-f
  352. to move the tiles around. Press r to move randomly.
  353. If two tiles of the same value collide, the tiles
  354. combine into a tile with twice the value.\n"))
  355. (defun 2048-move (from-row from-column delta-row delta-column)
  356. "Try to move the number in (FROM-ROW, FROM-COLUMN)
  357. Move it by (DELTA-ROW, DELTA-COLUMN).
  358. This succeeds when the destination (to-row, to-column) either is 0,
  359. or is the same value as (from-row, from-column).
  360. If (to-row, to-column) is zero, cascade and try to move further.
  361. Returns t if we were able to move; otherwise nil."
  362. (let ((to-row (+ from-row delta-row))
  363. (to-column (+ from-column delta-column)))
  364. (when (in-bounds to-row to-column)
  365. (2048-debug (format "moving the cell (%d, %d) by (%d, %d) to (%d, %d)" from-row from-column delta-row delta-column to-row to-column))
  366. (let ((from-val (2048-get-cell from-row from-column))
  367. (to-val (2048-get-cell to-row to-column)))
  368. (cond ((eq from-val to-val)
  369. (unless (or (eq from-val 0)
  370. (2048-was-combined-this-turn to-row to-column))
  371. (2048-debug (format "combining (%d, %d) into (%d, %d)" from-row from-column to-row to-column))
  372. (let ((combined-value (* from-val 2)))
  373. (unless (boundp (2048-tile-symbol combined-value))
  374. (2048-init-tile combined-value))
  375. (2048-set-cell to-row to-column combined-value)
  376. (setq *2048-score* (+ *2048-score* combined-value))
  377. (2048-set-cell from-row from-column 0)
  378. (2048-set-was-combined-this-turn to-row to-column))))
  379. ((eq to-val 0)
  380. (2048-set-cell to-row to-column from-val)
  381. (2048-set-cell from-row from-column 0)
  382. (2048-move to-row to-column delta-row delta-column)
  383. t)
  384. (t nil)))))) ;;ugh, need to pass out whether something was combined, and pass that to the _next_ call to 2048-move. We see bugs on rows like 4 0 4 0.
  385. (defun in-bounds (row column)
  386. "Return t if (ROW, COLUMN) is in the bounds of the field."
  387. (and (>= row 0)
  388. (>= column 0)
  389. (< row *2048-rows*)
  390. (< column *2048-columns*)))
  391. (defun 2048-up ()
  392. "Shift the board up."
  393. (interactive)
  394. (2048-game-move
  395. (setq *2048-combines-this-move* (make-vector (* *2048-columns* *2048-rows*)
  396. nil))
  397. (let ((has-moved nil))
  398. (dotimes (col *2048-columns*)
  399. (dolist (row (number-sequence 1
  400. (1- *2048-rows*)))
  401. (setq has-moved (or (2048-move row col -1 0)
  402. has-moved))))
  403. (when has-moved
  404. (2048-insert-random-cell)))))
  405. (defun 2048-down ()
  406. "Shift the board down."
  407. (interactive)
  408. (2048-game-move
  409. (setq *2048-combines-this-move* (make-vector (* *2048-columns* *2048-rows*)
  410. nil))
  411. (let ((has-moved nil))
  412. (dotimes (col *2048-columns*)
  413. (dolist (row (number-sequence (- *2048-rows* 2) 0 -1))
  414. (setq has-moved (or (2048-move row col 1 0)
  415. has-moved))))
  416. (when has-moved
  417. (2048-insert-random-cell)))))
  418. (defun 2048-left ()
  419. "Shifts the board left."
  420. (interactive)
  421. (2048-game-move
  422. (let ((has-moved nil))
  423. (dotimes (row *2048-rows*)
  424. (dolist (col (number-sequence 1 (1- *2048-columns*)))
  425. (setq has-moved (or (2048-move row col 0 -1)
  426. has-moved))))
  427. (when has-moved
  428. (2048-insert-random-cell)))))
  429. (defun 2048-right ()
  430. "Shifts the board right."
  431. (interactive)
  432. (2048-game-move
  433. (let ((has-moved nil))
  434. (dotimes (row *2048-rows*)
  435. (dolist (col (number-sequence (- *2048-columns* 2) 0 -1))
  436. (setq has-moved (or (2048-move row col 0 1)
  437. has-moved))))
  438. (when has-moved
  439. (2048-insert-random-cell)))))
  440. (defun 2048-random-move ()
  441. "Move the board in a random direction.
  442. This may result in no changes to the board,
  443. if the move was the same as the last one."
  444. (interactive)
  445. (funcall (elt '(2048-left 2048-right 2048-up 2048-down) (random 4))))
  446. (provide '2048-game)
  447. ;;; 2048-game.el ends here