Blog sobre software libre

Posts tagged "libre,":

23 ene 2024

Tetris

Introducción

Últimamente le he echado muchas horas al Tetris 99 en la Switch, y, aunque parezca mentira, las distintas versiones del Tetris que existen en el mundo pueden llegar a ser muy diferentes. Hay incluso una serie de normas estándar para poder homogeneizar los distintos juegos.

En Emacs hay una implementación del Tetris (tetris.el), pero le falta la mecánica de reservar una pieza y algunos pequeños detalles para que se parezca más al resto de versiones.

Configurando tetris.el

En primer lugar, tocando opciones de tetris.el se puede hacer que la generación de piezas sea tal que nunca se puedan repetir las piezas más de dos veces (se van creando bolsas de 7 piezas).

Desactivando la opción de permitir repeticiones de piezas tenemos ya un generador de piezas aleatorio estándar.

(setq tetris-allow-repetitions nil)

Los colores de las piezas también siguen un estándar.

;;Shape 1 (O) Yellow
;;Shape 2 (L) Orange
;;Shape 3 (J) Dark blue
;;Shape 4 (S) Green
;;Shape 5 (Z) Red
;;Shape 6 (T) Magenta
;;Shape 7 (I) Light blue

  (setq tetris-x-colors [[1 1 0]
   [1 0.27 0]
   [0 0 0.55]
   [1 0 0]
   [0 1 0]
   [1 0 1]
   [0 0.86 0.9]]
  )

Con estos dos cambios podemos usar el tetris.el de Emacs y jugar con los colores estándar y la generación de piezas, pero queda por implementar la funcionalidad de reservar piezas.

Reservar piezas

Como quiero aprender Emacs Lisp y poder jugar al Tetris en Emacs con la reserva de piezas, he improvisado sobre la marcha una solución chapucera y rápida para poder jugar a mi manera.

Funciones modificadas

Lamentablemente ni la librería que usa tetris.el (gamegrid.el), ni el propio tetris.el están bien documentados. Así que me miré el código por encima, y con ayuda de una explicación de la librería que encontré en internet, me puse a toquetear cosas hasta conseguir lo que quería.

En primer lugar, estuve probando funciones que cogí del código y las fui probando y modificando en el búfer de Scratch para que fueran haciendo lo que quería.

(defun tetris-hold-shape ()
  "Con esta función se puede dibujar una pieza cualquiera por la cara en el tetris. Pones setq tetris-shape al número de la pieza que quieras y listo."
  (interactive)
  (setq tetris-next-holded-piece tetris-shape)
  (setq tetris-shape tetris-holded-piece)
  (setq tetris-rot 0)
  (setq tetris-next-shape (if tetris-allow-repetitions
                              (random 7)
                            (tetris--seven-bag)))
  (setq tetris-pos-x (/ (- tetris-width (tetris-shape-width)) 2))
  (setq tetris-pos-y 0)
  (if (tetris-test-shape)
      (tetris-end-game)
    (tetris-draw-shape)
    (tetris-draw-next-shape)
    (tetris-update-score))
  (setq tetris-holded-piece tetris-next-holded-piece))

(defun tetris-erase-shape ()
  "Con esta función se puede eliminar una pieza cualquiera del juego."
  (interactive)
  (dotimes (i 4)
    (let ((c (tetris-get-shape-cell i)))
      (gamegrid-set-cell (+ tetris-top-left-x
                            tetris-pos-x
                            (aref c 0))
                         (+ tetris-top-left-y
                            tetris-pos-y
                            (aref c 1))
                         tetris-blank))))
(defun tetris-reserva()
  "Función para implementar la reserva de piezas en el tetris."
  (interactive)
  (progn
    (tetris-erase-shape)
    (tetris-hold-shape)
    (tetris-update-score)
    )
  )

(global-set-key (kbd "C-ñ") 'tetris-reserva)
;;Shape 0 (O) Yellow
;;Shape 1 (L) Orange
;;Shape 2 (J) Dark Blue
;;Shape 3 (S) Green
;;Shape 4 (Z) Red
;;Shape 5 (T) Magenta
;;Shape 6 (I) Light Blue

Estuve probando cómo se ponen y se quitan piezas y luego hice una función más simple que hacía todo lo necesario para implementar la mecánica de reserva.

Modificación del archivo tetris.el

Además, cogí el código original, y lo copié en otro archivo, mitetris.el, y sobre este archivo definí algunas nuevas variables y creé la "previsualización" en ASCII de la pieza en reserva, ya que era lo más rápido.

;;; etris.el ---implementation of Tetris for Emacs  -*- lexical-binding:t -*-

;; Copyright (C) 1997, 2001-2024 Free Software Foundation, Inc.

;; Author: Glynn Clements <glynn@sensei.co.uk>
;; Old-Version: 2.01
;; Created: 1997-08-13
;; Keywords: games

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl-lib))

(require 'gamegrid)

;; ;;;;;;;;;;;;; customization variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defgroup tetris nil
  "Play a game of Tetris."
  :prefix "tetris-"
  :group 'games)

(defcustom tetris-use-glyphs t
  "Non-nil means use glyphs when available."
  :type 'boolean)

(defcustom tetris-use-color t
  "Non-nil means use color when available."
  :type 'boolean)

(defcustom tetris-draw-border-with-glyphs t
  "Non-nil means draw a border even when using glyphs."
  :type 'boolean)

(defcustom tetris-default-tick-period 0.3
  "The default time taken for a shape to drop one row."
  :type 'number)

(defcustom tetris-update-speed-function
  'tetris-default-update-speed-function
  "Function run whenever the Tetris score changes.
Called with two arguments: (SHAPES ROWS)
SHAPES is the number of shapes which have been dropped.
ROWS is the number of rows which have been completed.

If the return value is a number, it is used as the timer period."
  :type 'function)

(defcustom tetris-mode-hook nil
  "Hook run upon starting Tetris."
  :type 'hook)

(defcustom tetris-tty-colors
  ["blue" "white" "yellow" "magenta" "cyan" "green" "red"]
  "Vector of colors of the various shapes in text mode."
  :type '(vector (color :tag "Shape 1")
                 (color :tag "Shape 2")
                 (color :tag "Shape 3")
                 (color :tag "Shape 4")
                 (color :tag "Shape 5")
                 (color :tag "Shape 6")
                 (color :tag "Shape 7")))

(defcustom tetris-x-colors
  [[0 0 1] [0.7 0 1] [1 1 0] [1 0 1] [0 1 1] [0 1 0] [1 0 0]]
  "Vector of RGB colors of the various shapes."
  :type '(vector (vector :tag "Shape 1" number number number)
                 (vector :tag "Shape 2" number number number)
                 (vector :tag "Shape 3" number number number)
                 (vector :tag "Shape 4" number number number)
                 (vector :tag "Shape 5" number number number)
                 (vector :tag "Shape 6" number number number)
                 (vector :tag "Shape 7" number number number)))

(defcustom tetris-buffer-name "*Tetris*"
  "Name used for Tetris buffer."
  :type 'string)

(defcustom tetris-buffer-width 30
  "Width of used portion of buffer."
  :type 'natnum)

(defcustom tetris-buffer-height 22
  "Height of used portion of buffer."
  :type 'natnum)

(defcustom tetris-width 10
  "Width of playing area."
  :type 'natnum)

(defcustom tetris-height 20
  "Height of playing area."
  :type 'natnum)

(defcustom tetris-top-left-x 3
  "X position of top left of playing area."
  :type 'natnum)

(defcustom tetris-top-left-y 1
  "Y position of top left of playing area."
  :type 'natnum)

(defcustom tetris-allow-repetitions t
  "If non-nil, use a random selection for each shape.
If nil, put the shapes into a bag and select without putting
back (until empty, when the bag is repopulated."
  :type 'boolean
  :version "29.1")

(defvar tetris-next-x (+ (* 2 tetris-top-left-x) tetris-width)
  "X position of next shape.")

(defvar tetris-next-y tetris-top-left-y
  "Y position of next shape.")

(defvar tetris-score-x tetris-next-x
  "X position of score.")

(defvar tetris-score-y (+ tetris-next-y 6)
  "Y position of score.")

;; It is not safe to put this in /tmp.
;; Someone could make a symlink in /tmp
;; pointing to a file you don't want to clobber.
(defvar tetris-score-file "tetris-scores"
;; anybody with a well-connected server want to host this?
;(defvar tetris-score-file "/anonymous@ftp.pgt.com:/pub/cgw/tetris-scores"
  "File for holding high scores.")

;; ;;;;;;;;;;;;; display options ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar tetris-blank-options
  '(((glyph colorize)
     (t ?\040))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [0 0 0])
     (color-tty "black"))))

(defvar tetris-cell-options
  '(((glyph colorize)
     (emacs-tty ?O)
     (t ?\040))
    ((color-x color-x)
     (mono-x mono-x)
     (color-tty color-tty)
     (mono-tty mono-tty))
    ;; color information is taken from tetris-x-colors and tetris-tty-colors
    ))

(defvar tetris-border-options
  '(((glyph colorize)
     (t ?\+))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [0.5 0.5 0.5])
     (color-tty "white"))))

(defvar tetris-space-options
  '(((t ?\040))
    nil
    nil))

;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst tetris-shapes
  [[[[0  0] [1  0] [0  1] [1  1]]]

   [[[0  0] [1  0] [2  0] [2  1]]
    [[1 -1] [1  0] [1  1] [0  1]]
    [[0 -1] [0  0] [1  0] [2  0]]
    [[1 -1] [2 -1] [1  0] [1  1]]]

   [[[0  0] [1  0] [2  0] [0  1]]
    [[0 -1] [1 -1] [1  0] [1  1]]
    [[2 -1] [0  0] [1  0] [2  0]]
    [[1 -1] [1  0] [1  1] [2  1]]]

   [[[0  0] [1  0] [1  1] [2  1]]
    [[1  0] [0  1] [1  1] [0  2]]]

   [[[1  0] [2  0] [0  1] [1  1]]
    [[0  0] [0  1] [1  1] [1  2]]]

   [[[1  0] [0  1] [1  1] [2  1]]
    [[1  0] [1  1] [2  1] [1  2]]
    [[0  1] [1  1] [2  1] [1  2]]
    [[1  0] [0  1] [1  1] [1  2]]]

   [[[0  0] [1  0] [2  0] [3  0]]
    [[1 -1] [1  0] [1  1] [1  2]]]]
  "Each shape is described by a vector that contains the coordinates of
each one of its four blocks.")

;;the scoring rules were taken from "xtetris".  Blocks score differently
;;depending on their rotation

(defconst tetris-shape-scores
  [[6] [6 7 6 7] [6 7 6 7] [6 7] [6 7] [5 5 6 5] [5 8]] )

(defconst tetris-shape-dimensions
  [[2 2] [3 2] [3 2] [3 2] [3 2] [3 2] [4 1]])

(defconst tetris-blank 7)

(defconst tetris-border 8)

(defconst tetris-space 9)

(defun tetris-default-update-speed-function (_shapes rows)
  (/ 20.0 (+ 50.0 rows)))

;; ;;;;;;;;;;;;; variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar-local tetris-shape 0)
(defvar-local tetris-rot 0)
(defvar-local tetris-next-shape 0)
(defvar-local tetris-n-shapes 0)
(defvar-local tetris-n-rows 0)
(defvar-local tetris-score 0)
(defvar-local tetris-pos-x 0)
(defvar-local tetris-pos-y 0)
(defvar-local tetris-paused nil)
(defvar-local tetris--bag nil)

;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defvar-keymap tetris-mode-map
  :doc "Keymap for Tetris games."
  :name 'tetris-mode-map
  "n"       #'tetris-start-game
  "q"       #'tetris-end-game
  "p"       #'tetris-pause-game

  "SPC"     #'tetris-move-bottom
  "<left>"  #'tetris-move-left
  "<right>" #'tetris-move-right
  "<up>"    #'tetris-rotate-prev
  "<down>"  #'tetris-move-down)

(defvar-keymap tetris-null-map
  :doc "Keymap for finished Tetris games."
  :name 'tetris-null-map
  "n"       #'tetris-start-game
  "q"       #'quit-window)

(defconst tetris--menu-def
  '("Tetris"
    ["Start new game"    tetris-start-game
     :help "Start a new Tetris game"]
    ["End game"          tetris-end-game
     :active (tetris-active-p)
     :help "End the current Tetris game"]
    ;; FIXME: Pause and resume from the menu currently doesn't work
    ;;        very well and is therefore disabled.  The game continues
    ;;        running while navigating the menu.  See also
    ;;        `snake--menu-def' which has the same problem.
    ;; ["Pause"             tetris-pause-game
    ;;  :active (and (tetris-active-p) (not tetris-paused))
    ;;  :help "Pause running Tetris game"]
    ;; ["Resume"            tetris-pause-game
    ;;  :active (and (tetris-active-p) tetris-paused)
    ;;  :help "Resume paused Tetris game"]
    )
  "Menu for `tetris'.  Used to initialize menus.")

(easy-menu-define
  tetris-mode-menu tetris-mode-map
  "Menu for running Tetris games."
  tetris--menu-def)

(easy-menu-define
  tetris-null-menu tetris-null-map
  "Menu for finished Tetris games."
  tetris--menu-def)
(setq tetris-holded-piece 1)
(setq tetris-next-holded-piece 1)
(setq tetris-holded-siguiente "s")
;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tetris-display-options ()
  (let ((options (make-vector 256 nil)))
    (dotimes (c 256)
      (aset options c
            (cond ((= c tetris-blank)
                   tetris-blank-options)
                  ((and (>= c 0) (<= c 6))
                   (append
                    tetris-cell-options
                    `((((glyph color-x) ,(aref tetris-x-colors c))
                       (color-tty ,(aref tetris-tty-colors c))
                       (t nil)))))
                  ((= c tetris-border)
                   tetris-border-options)
                  ((= c tetris-space)
                   tetris-space-options)
                  (t
                   '(nil nil nil)))))
    options))

(defun tetris-get-tick-period ()
  (let ((period (apply tetris-update-speed-function
                       tetris-n-shapes
                       tetris-n-rows nil)))
    (and (numberp period) period)))

(defun tetris-get-shape-cell (block)
  (aref (aref  (aref tetris-shapes
                     tetris-shape) tetris-rot)
        block))

(defun tetris-shape-width ()
  (aref (aref tetris-shape-dimensions tetris-shape) 0))

(defun tetris-shape-rotations ()
  (length (aref tetris-shapes tetris-shape)))

(defun tetris-draw-score ()
  (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes)
                         (format "Rows:   %05d" tetris-n-rows)
                         (format "Score:  %05d" tetris-score))))
    (dotimes (y 3)
      (let* ((string (aref strings y))
             (len (length string)))
        (dotimes (x len)
          (gamegrid-set-cell (+ tetris-score-x x)
                             (+ tetris-score-y y)
                             (aref string x)))))))
(defun tetris-draw-hold ()
  (if (eq tetris-holded-piece 0)
      (setq tetris-holded-siguiente "O")
      )
  (if (eq tetris-holded-piece 1)
          (setq tetris-holded-siguiente "J")
      )
  (if (eq tetris-holded-piece 2)
          (setq tetris-holded-siguiente "L")
      )
  (if (eq tetris-holded-piece 3)
          (setq tetris-holded-siguiente "Z")
      )
  (if (eq tetris-holded-piece 4)
          (setq tetris-holded-siguiente "S")
      )
  (if (eq tetris-holded-piece 5)
          (setq tetris-holded-siguiente "T")
      )
  (if (eq tetris-holded-piece 6)
          (setq tetris-holded-siguiente "I")
      )

  (let ((strings (vector (format "Shapes: %05d" tetris-n-shapes)
                         (format "Rows:   %05d" tetris-n-rows)
                         (format "Hodl:  %05s" tetris-holded-siguiente))))
    (dotimes (y 3)
      (let* ((string (aref strings y))
             (len (length string)))
        (dotimes (x len)
          (gamegrid-set-cell (+ 15 x)
                             (+ 15 y)
                             (aref string x)))))))

(defun tetris-update-score ()
  (tetris-draw-score)
  (tetris-draw-hold)
  (let ((period (tetris-get-tick-period)))
    (if period (gamegrid-set-timer period))))

(defun tetris--shuffle (sequence)
  (cl-loop for i from (length sequence) downto 2
           do (cl-rotatef (elt sequence (random i))
                          (elt sequence (1- i))))
  sequence)

(defun tetris--seven-bag ()
  (when (not tetris--bag)
    (setq tetris--bag (tetris--shuffle (list 0 1 2 3 4 5 6))))
  (pop tetris--bag))

(defun tetris-new-shape ()
  (setq tetris-shape tetris-next-shape)
  (setq tetris-rot 0)
  (setq tetris-next-shape (if tetris-allow-repetitions
                              (random 7)
                            (tetris--seven-bag)))
  (setq tetris-pos-x (/ (- tetris-width (tetris-shape-width)) 2))
  (setq tetris-pos-y 0)
  (if (tetris-test-shape)
      (tetris-end-game)
    (tetris-draw-shape)
    (tetris-draw-next-shape)
    (tetris-update-score)))

(defun tetris-draw-next-shape ()
  (dotimes (x 4)
    (dotimes (y 4)
      (gamegrid-set-cell (+ tetris-next-x x)
                         (+ tetris-next-y y)
                         tetris-blank)))
  (dotimes (i 4)
    (let ((tetris-shape tetris-next-shape)
          (tetris-rot 0))
      (gamegrid-set-cell (+ tetris-next-x
                            (aref (tetris-get-shape-cell i) 0))
                         (+ tetris-next-y
                            (aref (tetris-get-shape-cell i) 1))
                         tetris-shape))))

(defun tetris-draw-shape ()
  (dotimes (i 4)
    (let ((c (tetris-get-shape-cell i)))
      (gamegrid-set-cell (+ tetris-top-left-x
                            tetris-pos-x
                            (aref c 0))
                         (+ tetris-top-left-y
                            tetris-pos-y
                            (aref c 1))
                         tetris-shape))))

(defun tetris-erase-shape ()
  (interactive)
  (dotimes (i 4)
    (let ((c (tetris-get-shape-cell i)))
      (gamegrid-set-cell (+ tetris-top-left-x
                            tetris-pos-x
                            (aref c 0))
                         (+ tetris-top-left-y
                            tetris-pos-y
                            (aref c 1))
                         tetris-blank))))

(defun tetris-test-shape ()
  (let ((hit nil))
    (dotimes (i 4)
      (unless hit
        (setq hit
              (let* ((c (tetris-get-shape-cell i))
                     (xx (+ tetris-pos-x
                            (aref c 0)))
                     (yy (+ tetris-pos-y
                            (aref c 1))))
                (or (>= xx tetris-width)
                    (>= yy tetris-height)
                    (/= (gamegrid-get-cell
                         (+ xx tetris-top-left-x)
                         (+ yy tetris-top-left-y))
                        tetris-blank))))))
    hit))

(defun tetris-full-row (y)
  (let ((full t))
    (dotimes (x tetris-width)
      (if (= (gamegrid-get-cell (+ tetris-top-left-x x)
                                (+ tetris-top-left-y y))
             tetris-blank)
          (setq full nil)))
    full))

(defun tetris-shift-row (y)
  (if (= y 0)
      (dotimes (x tetris-width)
        (gamegrid-set-cell (+ tetris-top-left-x x)
                           (+ tetris-top-left-y y)
                           tetris-blank))
    (dotimes (x tetris-width)
      (let ((c (gamegrid-get-cell (+ tetris-top-left-x x)
                                  (+ tetris-top-left-y y -1))))
        (gamegrid-set-cell (+ tetris-top-left-x x)
                           (+ tetris-top-left-y y)
                           c)))))

(defun tetris-shift-down ()
  (dotimes (y0 tetris-height)
    (when (tetris-full-row y0)
      (setq tetris-n-rows (1+ tetris-n-rows))
      (cl-loop for y from y0 downto 0 do
               (tetris-shift-row y)))))

(defun tetris-draw-border-p ()
  (or (not (eq gamegrid-display-mode 'glyph))
      tetris-draw-border-with-glyphs))

(defun tetris-init-buffer ()
  (gamegrid-init-buffer tetris-buffer-width
                        tetris-buffer-height
                        tetris-space)
  (let ((buffer-read-only nil))
    (if (tetris-draw-border-p)
        (cl-loop for y from -1 to tetris-height do
                 (cl-loop for x from -1 to tetris-width do
                          (gamegrid-set-cell (+ tetris-top-left-x x)
                                             (+ tetris-top-left-y y)
                                             tetris-border))))
    (dotimes (y tetris-height)
      (dotimes (x tetris-width)
        (gamegrid-set-cell (+ tetris-top-left-x x)
                           (+ tetris-top-left-y y)
                           tetris-blank)))
    (if (tetris-draw-border-p)
        (cl-loop for y from -1 to 4 do
                 (cl-loop for x from -1 to 4 do
                          (gamegrid-set-cell (+ tetris-next-x x)
                                             (+ tetris-next-y y)
                                             tetris-border))))))

(defun tetris-reset-game ()
  (gamegrid-kill-timer)
  (tetris-init-buffer)
  (setq tetris-next-shape (random 7))
  (setq tetris-shape    0
        tetris-rot      0
        tetris-pos-x    0
        tetris-pos-y    0
        tetris-n-shapes 0
        tetris-n-rows   0
        tetris-score    0
        tetris-paused   nil)
  (tetris-new-shape))

(defun tetris-shape-done ()
  (tetris-shift-down)
  (setq tetris-n-shapes (1+ tetris-n-shapes))
  (setq tetris-score
        (+ tetris-score
           (aref (aref tetris-shape-scores tetris-shape) tetris-rot)))
  (tetris-update-score)
  (tetris-new-shape))

(defun tetris-update-game (tetris-buffer)
  "Called on each clock tick.
Drops the shape one square, testing for collision."
  (if (and (not tetris-paused)
           (eq (current-buffer) tetris-buffer))
      (let (hit)
        (tetris-erase-shape)
        (setq tetris-pos-y (1+ tetris-pos-y))
        (setq hit (tetris-test-shape))
        (if hit
            (setq tetris-pos-y (1- tetris-pos-y)))
        (tetris-draw-shape)
        (if hit
            (tetris-shape-done)))))

(defun tetris-move-bottom ()
  "Drop the shape to the bottom of the playing area."
  (interactive nil tetris-mode)
  (unless tetris-paused
    (let ((hit nil))
      (tetris-erase-shape)
      (while (not hit)
        (setq tetris-pos-y (1+ tetris-pos-y))
        (setq hit (tetris-test-shape)))
      (setq tetris-pos-y (1- tetris-pos-y))
      (tetris-draw-shape)
      (tetris-shape-done))))

(defun tetris-move-left ()
  "Move the shape one square to the left."
  (interactive nil tetris-mode)
  (unless tetris-paused
    (tetris-erase-shape)
    (setq tetris-pos-x (1- tetris-pos-x))
    (if (tetris-test-shape)
        (setq tetris-pos-x (1+ tetris-pos-x)))
    (tetris-draw-shape)))

(defun tetris-move-right ()
  "Move the shape one square to the right."
  (interactive nil tetris-mode)
  (unless tetris-paused
    (tetris-erase-shape)
    (setq tetris-pos-x (1+ tetris-pos-x))
    (if (tetris-test-shape)
        (setq tetris-pos-x (1- tetris-pos-x)))
    (tetris-draw-shape)))

(defun tetris-move-down ()
  "Move the shape one square to the bottom."
  (interactive nil tetris-mode)
  (unless tetris-paused
    (tetris-erase-shape)
    (setq tetris-pos-y (1+ tetris-pos-y))
    (if (tetris-test-shape)
        (setq tetris-pos-y (1- tetris-pos-y)))
    (tetris-draw-shape)))

(defun tetris-rotate-prev ()
  "Rotate the shape clockwise."
  (interactive nil tetris-mode)
  (unless tetris-paused
      (tetris-erase-shape)
      (setq tetris-rot (% (+ 1 tetris-rot)
                          (tetris-shape-rotations)))
      (if (tetris-test-shape)
          (setq tetris-rot (% (+ 3 tetris-rot)
                              (tetris-shape-rotations))))
      (tetris-draw-shape)))

(defun tetris-rotate-next ()
  "Rotate the shape anticlockwise."
  (interactive nil tetris-mode)
  (unless tetris-paused
        (tetris-erase-shape)
        (setq tetris-rot (% (+ 3 tetris-rot)
                            (tetris-shape-rotations)))
        (if (tetris-test-shape)
            (setq tetris-rot (% (+ 1 tetris-rot)
                                (tetris-shape-rotations))))
        (tetris-draw-shape)))

(defun tetris-end-game ()
  "Terminate the current game."
  (interactive nil tetris-mode)
  (gamegrid-kill-timer)
  (use-local-map tetris-null-map)
  (gamegrid-add-score tetris-score-file tetris-score))

(defun tetris-start-game ()
  "Start a new game of Tetris."
  (interactive nil tetris-mode)
  (tetris-reset-game)
  (use-local-map tetris-mode-map)
  (let ((period (or (tetris-get-tick-period)
                    tetris-default-tick-period)))
    (gamegrid-start-timer period 'tetris-update-game)))

(defun tetris-pause-game ()
  "Pause (or resume) the current game."
  (interactive nil tetris-mode)
  (setq tetris-paused (not tetris-paused))
  (message (and tetris-paused "Game paused (press p to resume)")))

(setq tetris-current-shape nil
      tetris-hold-shape nil)

(defun tetris-hold-piece ()
  (interactive nil tetris-mode)
    (let ((current-shape tetris-current-shape)
          (current-rot tetris-rot))
      (if tetris-hold-shape
          (progn
            (setq tetris-current-shape tetris-hold-shape
                  tetris-rot 0)
            (setq tetris-hold-shape current-shape
                  tetris-piece-held t))
          (progn
            (tetris-draw-next-shape)
            (setq tetris-hold-shape current-shape
                  tetris-rot 0
                  tetris-piece-held t))))
)

(defun tetris-active-p ()
  (eq (current-local-map) tetris-mode-map))

(put 'tetris-mode 'mode-class 'special)

(define-derived-mode tetris-mode nil "Tetris"
  "A mode for playing Tetris."
  :interactive nil

  (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t)

  (use-local-map tetris-null-map)

  (setq show-trailing-whitespace nil)

  (setq gamegrid-use-glyphs tetris-use-glyphs)
  (setq gamegrid-use-color tetris-use-color)

  (gamegrid-init (tetris-display-options)))

;;;###autoload
(defun mitetris ()
  "Play the Tetris game.
Shapes drop from the top of the screen, and the user has to move and
rotate the shape to fit in with those at the bottom of the screen so
as to form complete rows.

`tetris-mode' keybindings:
\\<tetris-mode-map>
\\[tetris-start-game]   Start a new game of Tetris
\\[tetris-end-game]     Terminate the current game
\\[tetris-pause-game]   Pause (or resume) the current game
\\[tetris-move-left]    Move the shape one square to the left
\\[tetris-move-right]   Move the shape one square to the right
\\[tetris-rotate-prev]  Rotate the shape clockwise
\\[tetris-rotate-next]  Rotate the shape anticlockwise
\\[tetris-move-bottom]  Drop the shape to the bottom of the playing area"
  (interactive)

  (select-window (or (get-buffer-window tetris-buffer-name)
                     (selected-window)))
  (switch-to-buffer tetris-buffer-name)
  (gamegrid-kill-timer)
  (tetris-mode)
  (tetris-start-game))

(provide 'mitetris)

;;; tetris.el ends here

Conclusión

Finalmente, para poder probarlo todo, basta con evaluar los trozos de Elisp que he ido poniendo a lo largo del post, y ejecutar M-x mitetris. Funciona por lo menos en las versiones 29.1.9 y 29.2 de Emacs, que son en las que lo he probado.

Así que, en tan sólo un rato, y sin tener mucha idea de Elisp, he conseguido hacer una solución chapucera que me permite jugar con una funcionalidad extra al Tetris de Emacs.

Me he divertido mucho haciéndolo, y además tengo muchas ideas de cómo mejorarlo para poder convertirlo en código en condiciones. Junto con mi modo menor, ya tengo una experiencia de juego completamente personalizada :).

Tags: emacs, software libre, tetris
Other posts
Other posts
Creative Commons License
www.finaprosadigital.com by Carlos Pajuelo is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.