Miroirs/emstar
1
0
Fork 0
mirror of https://github.com/gwenhael-le-moine/emstar.git synced 2024-12-26 09:59:11 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions
emstar/emstar.el
Gwenhael Le Moine b4f719db8a upgraded
2012-03-18 16:48:11 +01:00

570 lines
18 KiB
EmacsLisp
Raw Blame History

;;; emstar.el --- Emstar Game
;; Version: 1.3
;; Copyright
;; © Gwenhael Le Moine
;; Author: Gwenhael Le Moine <gwenhael.le.moine@gmail.com>
;; Keywords: games
;; URL: https://github.com/cycojesus/emstar
;; This file 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, or (at your option)
;; any later version.
;; This file 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Play Emstar in emacs.
;; Heavily based on emacs-sokoban
;; (require 'emstar)
;;; Code:
(require 'cl)
(defconst emstar-version "0.1"
"Version string for this version of GNU-Emacs Emstar.")
(defconst emstar-left '(-1 . 0))
(defconst emstar-right '( 1 . 0))
(defconst emstar-down '( 0 . 1))
(defconst emstar-up '( 0 . -1))
(defconst emstar-eater "eater")
(defconst emstar-stopper "stopper")
(defgroup emstar nil
"Emstar game for GNU Emacs."
:prefix "emstar-"
:group 'games)
(defcustom emstar-playerfiles-dir "/tmp/"
"*The directory holding the emstar playerfiles.
Emstar saves the information from `emstar-player-stats' to a
playerfile in this directory. If you don't want to use
playerfiles, set value to NIL."
:group 'emstar
:type 'string)
(defvar emstar-player-stats nil
"Alist with player specific information as saved in the playerfiles.
This holds the best results for each finished level and the
players current level.")
(defconst emstar-playerfile-prefix "emstar-pl-"
"The prefix used for emstar playerfiles.")
(defvar emstar-best-players-list nil
"A list with the best result for each level
generated from all available playerfiles, if `emstar-playerfiles-dir'
is none nil.")
(defcustom emstar-levels-dir (concat (file-name-directory load-file-name) "/emstar-levels")
"*Directory holding the emstar level files"
:group 'emstar
:type 'string)
(defcustom emstar-levels-basename "emstar-lvl."
"*Basename of the emstar level files"
:group 'emstar
:type 'string)
(defcustom emstar-start-level 1
"*Defines the level-numver to start with.
This might be overwritten by the last level played,
as saved in the playerfile."
:group 'emstar
:type 'integer)
(defcustom emstar-undo-penalty 3
"*Defines distance penatly for one undo."
:group 'emstar
:type 'integer)
(defvar emstar-eater-char ?@)
(defvar emstar-gift-char ?*)
(defvar emstar-stopper-char ?H)
(defvar emstar-wall-char ?#)
;; (defcustom emstar-eater-char ?@
;; "*Defines the character used to diplay the eater."
;; :group 'emstar
;; :type 'character)
;; (defcustom emstar-gift-char ?*
;; "*Defines the character used to diplay the gifts."
;; :group 'emstar
;; :type 'character)
;; (defcustom emstar-stopper-char ?H
;; "*Defines the character used to diplay the stopper."
;; :group 'emstar
;; :type 'character)
;; (defcustom emstar-wall-char ?#
;; "*Defines the character used to diplay the walls."
;; :group 'emstar
;; :type 'character)
(defface emstar-eater-face
'((t (:foreground "green"
:weight bold)))
"*Face used display the eater in emstar game."
:group 'emstar)
(defface emstar-stopper-face
'((t (:foreground "red"
:weight bold)))
"*Face used display the stopper in emstar game."
:group 'emstar)
(defface emstar-gift-face
'((t (:foreground "yellow"
:weight bold)))
"*Face used display gifts in emstar game."
:group 'emstar)
(defface emstar-wall-face
'((t (:foreground "black")))
"*Face used display walls in emstar game."
:group 'emstar)
(defvar emstar-eater-face 'emstar-eater-face)
(defvar emstar-stopper-face 'emstar-stopper-face)
(defvar emstar-gift-face 'emstar-gift-face)
(defvar emstar-wall-face 'emstar-wall-face)
(defconst emstar-font-lock-keywords
`((,(regexp-quote (char-to-string emstar-eater-char))
. emstar-eater-face)
(,(regexp-quote (char-to-string emstar-stopper-char))
. emstar-stopper-face)
(,(regexp-quote (char-to-string emstar-gift-char))
. emstar-gift-face)
(,(regexp-quote (char-to-string emstar-wall-char))
. emstar-wall-face))
"Stuff to highlight in emstar.")
(defvar emstar-mode-map nil
"Keymap for emstar.")
(defvar emstar-selected 'emstar-eater
"Currently selected piece.")
(setq emstar-mode-map (make-sparse-keymap))
(define-key emstar-mode-map [up] 'emstar-move-up)
(define-key emstar-mode-map [down] 'emstar-move-down)
(define-key emstar-mode-map [left] 'emstar-move-left)
(define-key emstar-mode-map [right] 'emstar-move-right)
(define-key emstar-mode-map "u" 'emstar-undo)
(define-key emstar-mode-map "b" 'emstar-display-best-players-list)
(define-key emstar-mode-map ">" 'emstar-goto-next-level)
(define-key emstar-mode-map "n" 'emstar-goto-next-level)
(define-key emstar-mode-map "<" 'emstar-goto-prev-level)
(define-key emstar-mode-map "p" 'emstar-goto-prev-level)
(define-key emstar-mode-map " " 'emstar-switch-selected)
(define-key emstar-mode-map "r" 'emstar-reload-level)
(defvar emstar-collected-gifts 0
"Number of gifts collected. Buffer-local in emstar-mode.")
(defvar emstar-total-gifts 0
"Total number of gifts. Buffer-local in emstar-mode.")
(defvar emstar-level nil
"Number of current level. Buffer-local in emstar games.")
(defvar emstar-distance nil
"Distance travelled by player. Buffer-local in emstar-mode.")
(defvar emstar-pos nil
"Current position of player. Buffer-local in emstar-mode.")
(defvar emstar-last-pos nil
"Backup of last player position. Buffer-local in emstar-mode.")
(defvar emstar-game-info nil
"String with infos to the current game. Buffer-local in emstar-mode.")
(defvar emstar-level-best-string nil
"String holding the best result for the current level as displayed.")
(defun emstar-forward-line (arg)
"Like forward-line but preserve the current column.
The implementation is rather simple, as we can make certain
assumptions about the structure of a valid emstar level buffer."
(let ((goal-column (current-column)))
(forward-line arg)
(move-to-column goal-column)))
(defun emstar-paint (char)
"Insert char at point, overwriting the old char.
Extreme simple, but sufficient for our needs."
(let ((inhibit-read-only t))
(delete-char 1)
(insert (char-to-string char))
(forward-char -1))
t)
(defun emstar-count-gifts ()
(setq emstar-total-gifts 0)
(goto-char (point-min))
(while (search-forward (char-to-string emstar-gift-char) nil t)
(setq emstar-total-gifts (1+ emstar-total-gifts))))
(defun emstar-refresh-collected-gifts ()
(setq emstar-collected-gifts 0)
(goto-char (point-min))
(while (search-forward (char-to-string emstar-gift-char) nil t)
(setq emstar-collected-gifts (1+ emstar-collected-gifts)))
(setq emstar-collected-gifts (- emstar-total-gifts emstar-collected-gifts )))
(defun emstar-update-score (level distance)
"Save the distance travelled for level to `emstar-player-stats'."
(let* ((level-name (concat emstar-levels-basename
(number-to-string level)))
(entry (assoc level-name emstar-player-stats)))
(if entry
(or (< (cdr entry) distance) (setcdr entry distance))
(push (cons level-name distance) emstar-player-stats))))
(defun emstar-get-level-best (level &optional list)
"Get best result for level from `emstar-player-stats'."
(if level
(let* ((level-name (concat emstar-levels-basename
(number-to-string level)))
(entry (assoc level-name
(or list emstar-player-stats))))
(if entry
(cdr entry)))))
(defun emstar-update-current-level (level)
"Save current level to `emstar-player-stats'."
(let ((entry (assoc :level emstar-player-stats)))
(if entry
(setcdr entry level)
(push (cons :level level) emstar-player-stats))))
(defun emstar-save-playerfile ()
"Save `emstar-player-stats' to playerfile."
(if emstar-playerfiles-dir
(let ((filename (concat emstar-playerfiles-dir "/"
emstar-playerfile-prefix
(user-login-name))))
(with-temp-file filename
(prin1 emstar-player-stats (current-buffer)))
(set-file-modes filename #o644))))
(defun emstar-load-playerfile ()
"Load `emstar-player-stats' from playerfile."
(if emstar-playerfiles-dir
(let ((filename (concat emstar-playerfiles-dir "/"
emstar-playerfile-prefix
(user-login-name))))
(if (file-readable-p filename)
(with-temp-buffer
(insert-file-contents filename nil)
(setq emstar-player-stats
(read (current-buffer))))))))
(defun emstar-gen-best-players-list ()
(if emstar-playerfiles-dir
(let ((files (directory-files emstar-playerfiles-dir
t (concat "^" emstar-playerfile-prefix)
t)))
(dolist (filename files)
(if (file-readable-p filename)
(with-temp-buffer
(insert-file-contents filename nil)
(let ((stats (read (current-buffer)))
(player (substring (file-name-nondirectory filename)
(1- (length emstar-levels-basename)))))
(dolist (entry stats)
(let* ((level-name (car entry))
(best-entry (assoc level-name
emstar-best-players-list)))
(if (and (stringp level-name)
(compare-strings level-name
0 (length emstar-levels-basename)
emstar-levels-basename
0 nil))
(cond ((and best-entry
(> (cadr best-entry) (cdr entry)))
(setcdr best-entry
(cons (cdr entry) player)))
((or (not best-entry)
(= (cadr best-entry) (cdr entry)))
(push (cons level-name
(cons (cdr entry) player))
emstar-best-players-list)))))))))))))
(defun emstar-display-best-players-list ()
(interactive)
(if emstar-best-players-list
(progn
(switch-to-buffer (get-buffer-create "*Emstar Best Players*"))
(erase-buffer)
(dolist (entry emstar-best-players-list)
(let ((level-name (car entry)))
(if (and (stringp level-name)
(compare-strings level-name
0 (length emstar-levels-basename)
emstar-levels-basename
0 nil))
(insert (format "%4s: %5d - %s\n"
(substring level-name
(length emstar-levels-basename))
(cadr entry)
(cddr entry))))))
(sort-columns nil (point-min) (point-max)))
(error "No best players list available")))
(defun emstar-load-next-level (&optional arg)
"Load next level, with negative arg load previous level.
If requested level doesn't exist, load `emstar-start-level'."
(when (bound-and-true-p emstar-level)
(setq emstar-level (if (and arg (< arg 0))
(1- emstar-level)
(1+ emstar-level)))
(or (emstar-load-level emstar-level)
(progn
(setq emstar-level emstar-start-level)
(emstar-load-level emstar-level)))
(emstar-init-level)
t))
(defun emstar-level-finished ()
(message
(format "You finished Level %d in %d meters. Congratulations!"
(or (bound-and-true-p emstar-level) 0)
emstar-distance))
(when (bound-and-true-p emstar-level)
(emstar-update-score emstar-level emstar-distance))
(when (emstar-load-next-level)
(emstar-update-current-level emstar-level)
(emstar-save-playerfile)))
(defun emstar-find-current-pos ()
(goto-char (point-min))
(search-forward (char-to-string (if (equal emstar-selected emstar-eater)
emstar-eater-char
emstar-stopper-char)))
(forward-char -1)
(setq emstar-pos (point)))
(defun emstar-move-here ()
"Move player to point.
Move player char to point and evaluate game status."
(interactive)
(setq emstar-pos (point))
(emstar-paint (if (equal emstar-selected emstar-eater)
emstar-eater-char
emstar-stopper-char))
(goto-char emstar-last-pos)
(emstar-paint 32)
(emstar-update-mode-line))
(defun emstar-move-eater (direction)
(goto-char emstar-pos)
(setq emstar-last-pos (point))
(while (progn
(setq emstar-pos (point))
(forward-char (car direction))
(emstar-forward-line (cdr direction))
(if (= (char-after) emstar-gift-char)
(progn
(setq emstar-collected-gifts (1+ emstar-collected-gifts))
(emstar-paint 32)))
(setq emstar-distance (1+ emstar-distance))
(= (char-after) 32)))
(setq emstar-distance (1- emstar-distance))
(goto-char emstar-pos)
(if (or
(= (char-after) 32)
(= (char-after) emstar-gift-char))
(emstar-move-here))
(if (= emstar-total-gifts emstar-collected-gifts)
(emstar-level-finished)))
(defun emstar-move-stopper (direction)
(goto-char emstar-pos)
(setq emstar-last-pos (point))
(while (progn
(setq emstar-pos (point))
(forward-char (car direction))
(emstar-forward-line (cdr direction))
(setq emstar-distance (1+ emstar-distance))
(= (char-after) 32)))
(setq emstar-distance (1- emstar-distance))
(goto-char emstar-pos)
(if (= (char-after) 32)
(emstar-move-here)))
(defun emstar-move-up ()
"Move the player up if possible."
(interactive)
(if (equal emstar-selected emstar-eater)
(emstar-move-eater emstar-up)
(emstar-move-stopper emstar-up)))
(defun emstar-move-down ()
"Move the player down if possible."
(interactive)
(if (equal emstar-selected emstar-eater)
(emstar-move-eater emstar-down)
(emstar-move-stopper emstar-down)))
(defun emstar-move-left ()
"Move the player left if possible."
(interactive)
(if (equal emstar-selected emstar-eater)
(emstar-move-eater emstar-left)
(emstar-move-stopper emstar-left)))
(defun emstar-move-right ()
"Move the player right if possible."
(interactive)
(if (equal emstar-selected emstar-eater)
(emstar-move-eater emstar-right)
(emstar-move-stopper emstar-right)))
(defun emstar-goto-next-level ()
"Jump to next level."
(interactive)
(emstar-load-next-level))
(defun emstar-goto-prev-level ()
"Jump to previous level."
(interactive)
(emstar-load-next-level -1))
(defun emstar-reload-level ()
"Jump to previous level."
(interactive)
(emstar-load-level emstar-level)
(emstar-init-level))
(defun emstar-switch-selected ()
"Switch the item moved."
(interactive)
(setq emstar-selected (if (equal emstar-selected emstar-eater)
emstar-stopper
emstar-eater))
(if (equal emstar-selected emstar-eater)
(progn
(set-face-inverse-video-p emstar-eater-face t)
(set-face-inverse-video-p emstar-stopper-face nil))
(progn
(set-face-inverse-video-p emstar-eater-face nil)
(set-face-inverse-video-p emstar-stopper-face t)))
(emstar-find-current-pos))
(defun emstar-update-mode-line ()
(setq emstar-game-info (format "Level: %d -- Gifts collected: %d/%d -- Distance: %d %s"
(or (bound-and-true-p emstar-level)
0)
emstar-collected-gifts
emstar-total-gifts
emstar-distance
(or emstar-level-best-string ""))))
(defun emstar-undo ()
(interactive)
(let ((inhibit-read-only t))
(undo))
(emstar-find-current-pos)
(setq emstar-distance (+ emstar-distance emstar-undo-penalty))
(emstar-refresh-collected-gifts)
(emstar-update-mode-line))
(defun emstar-load-level (num)
"Load emstar level num."
(let ((inhibit-read-only t)
(level-file
(concat emstar-levels-dir "/"
emstar-levels-basename (number-to-string num))))
(when (file-exists-p level-file)
(insert-file-contents level-file nil nil nil t)
t)))
(defun emstar-init-level ()
"Initialize level elements."
(setq emstar-selected emstar-eater)
(set-face-inverse-video-p emstar-eater-face t)
(set-face-inverse-video-p emstar-stopper-face nil)
(setq emstar-distance 0)
(setq emstar-collected-gifts 0)
(setq emstar-total-gifts 0)
(setq emstar-level-best-string
(let ((best (emstar-get-level-best emstar-level))
(world-best (if emstar-best-players-list
(emstar-get-level-best
emstar-level
emstar-best-players-list))))
(if (or best world-best)
(format " [Best:%s%s]"
(if best (number-to-string best) "")
(if (and world-best
(or (not best)
(< (car world-best) best)))
(format " (%s:%d)"
(cdr world-best) (car world-best))
"")))))
(emstar-count-gifts)
(emstar-update-mode-line)
(emstar-find-current-pos)
(buffer-disable-undo (current-buffer))
(buffer-enable-undo)
)
;;;###autoload
(defun emstar-mode ()
"Major mode to play emstar.
Commands:
\\{emstar-mode-map}"
(interactive)
(kill-all-local-variables)
(toggle-read-only 1)
(use-local-map emstar-mode-map)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults '(emstar-font-lock-keywords
t nil nil beginning-of-line))
(setq cursor-type nil)
(make-local-variable 'emstar-level)
(make-local-variable 'emstar-pos)
(make-local-variable 'emstar-last-pos)
(make-local-variable 'emstar-distance)
(make-local-variable 'emstar-collected-gifts)
(make-local-variable 'emstar-total-gifts)
(make-local-variable 'emstar-game-info)
(setq major-mode 'emstar-mode)
(setq mode-name "Emstar")
(setq header-line-format
(list "Emstar v" 'emstar-version
" -- " 'emstar-game-info " ~ " 'emstar-selected))
(emstar-init-level)
(run-hooks 'emstar-mode-hook))
;;;###autoload
(defun emstar ()
"Play emstar."
(interactive)
(switch-to-buffer (generate-new-buffer "*Emstar*"))
(emstar-load-playerfile)
(setq emstar-best-players-list nil)
(emstar-gen-best-players-list)
(let ((level (or (cdr (assoc :level emstar-player-stats))
emstar-start-level)))
(emstar-load-level level)
(emstar-mode)
(setq emstar-level level))
(emstar-init-level)
(emstar-update-mode-line))
(provide 'emstar)
;;; emstar.el ends here
Reference in a new issue View git blame Copy permalink