;;; maze.el --- classical implementation of maze

;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;;   2008, 2009, 2010, 2011  Free Software Foundation, Inc.

;; Author: Yuma Arakawa <cupnes@gmail.com>
;; Version: 2.0
;; Created: 2011-11-25
;; 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This is an implementation of the classical game maze.

;;; Code:

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

(require 'gamegrid)

;;; Customization

(defgroup maze nil
  "Emacs-Lisp implementation of the classical game maze."
  :tag "Maze"
  :group 'games)

(defcustom maze-buffer-name "*Maze*"
  "Name of the buffer used to play."
  :group 'maze
  :type '(string))

(defcustom maze-map
  [[1 1 1 1 1 1 0 1]
   [1 0 0 0 1 0 0 1]
   [1 0 1 0 1 1 0 1]
   [1 0 1 0 1 0 0 1]
   [1 0 1 0 1 1 0 1]
   [1 0 1 0 0 0 0 1]
   [1 0 1 1 1 1 1 1]]
  "Maze map."
  :group 'maze
  :type '(array))

(defcustom maze-width (length (elt maze-map 0))
  "Width of the playfield."
  :group 'maze
  :type '(integer))

(defcustom maze-height (length maze-map)
  "Height of the playfield."
  :group 'maze
  :type '(integer))

(defcustom maze-start-x 1
  "Maze start of x."
  :group 'maze
  :type '(integer))

(defcustom maze-start-y (1- maze-height)
  "Maze start of y."
  :group 'maze
  :type '(integer))

(defcustom maze-goal-x (- maze-width 2)
  "Maze goal of x."
  :group 'maze
  :type '(integer))

(defcustom maze-goal-y 0
  "Maze goal of y."
  :group 'maze
  :type '(integer))

(defcustom maze-blank-color "oxblood"
  "Color used for background."
  :group 'maze
  :type 'color)

(defcustom maze-border-color "gray"
  "Color used for maze borders."
  :group 'maze
  :type 'color)

(defcustom maze-player-color "ocher"
  "Color used for player."
  :group 'maze
  :type 'color)

(defcustom maze-enemy-color "green"
  "Color used for enemy."
  :group 'maze
  :type 'color)

(defcustom maze-left-key "4"
  "Alternate key to press for player to go left (primary one is [left])."
  :group 'maze
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom maze-right-key "6"
  "Alternate key to press for player to go right (primary one is [right])."
  :group 'maze
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom maze-up-key "8"
  "Alternate key to press for player to go up (primary one is [up])."
  :group 'maze
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom maze-down-key "2"
  "Alternate key to press for player to go down (primary one is [down])."
  :group 'maze
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom maze-quit-key "q"
  "Key to press to quit maze."
  :group 'maze
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom maze-pause-key "p"
  "Key to press to pause maze."
  :group 'maze
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom maze-resume-key "p"
  "*Key to press to resume maze."
  :group 'maze
  :type '(restricted-sexp :match-alternatives (stringp vectorp)))

(defcustom maze-timer-delay 1
  "*Time to wait between every cycle."
  :group 'maze
  :type 'number)


;;; This is black magic.  Define colors used

(defvar maze-blank-options
  '(((glyph colorize)
     (t ?\040))
    ((color-x color-x)
     (mono-x grid-x)
     (color-tty color-tty))
    (((glyph color-x) [0.61 0.03 0.02])
     (color-tty maze-blank-color))))

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

(defvar maze-player-options
  '(((glyph colorize)
     (emacs-tty ?O)
     (t ?\040))
    ((color-x color-x)
     (mono-x mono-x)
     (color-tty color-tty)
     (mono-tty mono-tty))
    (((glyph color-x) [0.92 0.62 0.28])
     (color-tty maze-player-color))))

(defvar maze-enemy-options
  '(((glyph colorize)
     (emacs-tty ?O)
     (t ?\040))
    ((color-x color-x)
     (mono-x mono-x)
     (color-tty color-tty)
     (mono-tty mono-tty))
    (((glyph color-x) [0.53 0.82 0.1])
     (color-tty maze-enemy-color))))

(defconst maze-blank	0)
(defconst maze-border	1)
(defconst maze-player	2)
(defconst maze-enemy	3)

(defconst maze-enemy-min-x 5)
(defconst maze-enemy-max-x 6)


;;; Determine initial positions for player and enemy

(defvar maze-player-x nil
  "Horizontal position of the player.")

(defvar maze-player-y nil
  "Vertical position of the player.")

(defvar maze-enemy-x nil
  "Horizontal position of the enemy.")

(defvar maze-enemy-y nil
  "Vertical position of the enemy.")



;;; Initialize maps

(defvar maze-mode-map
  (make-sparse-keymap 'maze-mode-map) "Modemap for maze-mode.")

(defvar maze-null-map
  (make-sparse-keymap 'maze-null-map) "Null map for maze-mode.")

(define-key maze-mode-map [left]	 'maze-move-left)
(define-key maze-mode-map [right] 	 'maze-move-right)
(define-key maze-mode-map [up]		 'maze-move-up)
(define-key maze-mode-map [down]	 'maze-move-down)
(define-key maze-mode-map "h"	 'maze-move-left)
(define-key maze-mode-map "l" 	 'maze-move-right)
(define-key maze-mode-map "k"		 'maze-move-up)
(define-key maze-mode-map "j"	 'maze-move-down)
(define-key maze-mode-map "\C-b"	 'maze-move-left)
(define-key maze-mode-map "\C-f" 	 'maze-move-right)
(define-key maze-mode-map "\C-p"		 'maze-move-up)
(define-key maze-mode-map "\C-n"	 'maze-move-down)
(define-key maze-mode-map maze-left-key  'maze-move-left)
(define-key maze-mode-map maze-right-key 'maze-move-right)
(define-key maze-mode-map maze-up-key	 'maze-move-up)
(define-key maze-mode-map maze-down-key  'maze-move-down)
(define-key maze-mode-map maze-quit-key  'maze-quit)
(define-key maze-mode-map maze-pause-key 'maze-pause)


;;; Fun stuff -- The code

(defun maze-display-options ()
  "Computes display options (required by gamegrid for colors)."
  (let ((options (make-vector 256 nil)))
    (loop for c from 0 to 255 do
      (aset options c
	    (cond ((= c maze-blank)
		   maze-blank-options)
                  ((= c maze-border)
		   maze-border-options)
                  ((= c maze-player)
		   maze-player-options)
                  ((= c maze-enemy)
		   maze-enemy-options)
                  (t
		   '(nil nil nil)))))
    options))



(defun maze-init-buffer ()
  "Initialize maze buffer and draw stuff thanks to gamegrid library."
  (interactive)
  (get-buffer-create maze-buffer-name)
  (switch-to-buffer maze-buffer-name)
  (use-local-map maze-mode-map)

  (setq gamegrid-use-glyphs t)
  (setq gamegrid-use-color t)
  (gamegrid-init (maze-display-options))

  (gamegrid-init-buffer maze-width
			(+ 2 maze-height)
			?\s)

  (let ((buffer-read-only nil))
    (loop for y from 0 to (1- maze-height) do
	  (loop for x from 0 to (1- maze-width) do
	  (cond
	   ((= maze-blank (elt (elt maze-map y) x))
	    (gamegrid-set-cell x y maze-blank))
	   ((= maze-border (elt (elt maze-map y) x))
	    (gamegrid-set-cell x y maze-border))))))

	(gamegrid-set-cell maze-player-x maze-player-y maze-player)
  (gamegrid-set-cell maze-enemy-x maze-enemy-y maze-enemy))



(defun maze-move-left ()
  "Move player left."
  (interactive)
  (if (> maze-player-x 0)
      (maze-update-player (1- maze-player-x) maze-player-y)))



(defun maze-move-right ()
  "Move player right."
  (interactive)
  (if (< maze-player-x (1- maze-width))
      (maze-update-player (1+ maze-player-x) maze-player-y)))



(defun maze-move-up ()
  "Move bat 2 up."
  (interactive)
  (if (> maze-player-y 0)
      (maze-update-player maze-player-x (1- maze-player-y))))



(defun maze-move-down ()
  "Move bat 2 down."
  (interactive)
  (if (< maze-player-y (1- maze-height))
      (maze-update-player maze-player-x (1+ maze-player-y))))


(defun maze-enemy-hit ()
  "Enemy hit check."

  (cond
   ((and (= maze-enemy-x maze-player-x) (= maze-enemy-y maze-player-y))
    (gamegrid-set-cell maze-start-x maze-start-y maze-player)
    (gamegrid-set-cell maze-player-x maze-player-y maze-blank)
    (setq maze-player-x maze-start-x)
    (setq maze-player-y maze-start-y))))


(defun maze-update-player (x y)
  "Move a player (suppress a cell and draw another one on the other side)."

  (cond
   ((string-equal (buffer-name (current-buffer)) maze-buffer-name)
    (cond
     ((maze-enemy-hit))
     ((= maze-blank (elt (elt maze-map y) x))
      (gamegrid-set-cell x y maze-player)
      (gamegrid-set-cell maze-player-x maze-player-y maze-blank)
      (setq maze-player-x x)
      (setq maze-player-y y)))
    (cond
     ((and (= maze-player-x maze-goal-x) (= maze-player-y maze-goal-y))
      (message "You get goal!")
      ;; (sit-for 3)
      )))))



(defun maze-update-enemy ()
  "Move a enemy (suppress a cell and draw another one on the other side)."

  (maze-enemy-hit)
  
  (cond
   ((= maze-enemy-min-x maze-enemy-x)
    (gamegrid-set-cell maze-enemy-max-x maze-enemy-y maze-enemy)
    (gamegrid-set-cell maze-enemy-x maze-enemy-y maze-blank)
    (setq maze-enemy-x maze-enemy-max-x))
   ((= maze-enemy-max-x maze-enemy-x)
    (gamegrid-set-cell maze-enemy-min-x maze-enemy-y maze-enemy)
    (gamegrid-set-cell maze-enemy-x maze-enemy-y maze-blank)
    (setq maze-enemy-x maze-enemy-min-x)))

  (maze-enemy-hit))



(defun maze-init ()
  "Initialize a game."

  (add-hook 'kill-buffer-hook 'maze-quit nil t)

  ;; Initialization of some variables
  (setq maze-player-x maze-start-x)
  (setq maze-player-y maze-start-y)
  (setq maze-enemy-x maze-enemy-min-x)
  (setq maze-enemy-y 1)

  (maze-init-buffer)  
  (gamegrid-kill-timer)
  (gamegrid-start-timer maze-timer-delay 'maze-update-game))



(defun maze-update-game (maze-buffer)
  "It is called every pong-cycle-delay seconds and
updates enemy positions."
  (if (not (eq (current-buffer) maze-buffer))
      (maze-pause)

    (maze-update-enemy)))



(defun maze-pause ()
  "Pause the game."
  (interactive)
  (gamegrid-kill-timer)
  ;; Oooohhh ugly.  I don't know why, gamegrid-kill-timer don't do the
  ;; jobs it is made for.  So I have to do it "by hand".  Anyway, next
  ;; line is harmless.
  (cancel-function-timers 'maze-update-game)
  (define-key maze-mode-map maze-resume-key 'maze-resume))



(defun maze-resume ()
  "Resume a paused game."
  (interactive)
  (define-key maze-mode-map maze-pause-key 'maze-pause)
  (gamegrid-start-timer maze-timer-delay 'maze-update-game))



(defun maze-quit ()
  "Quit the game and kill the maze buffer."
  (interactive)
  (gamegrid-kill-timer)
  ;; Be sure not to draw things in another buffer and wait for some
  ;; time.
  ;; (kill-buffer maze-buffer-name)
  (run-with-timer maze-timer-delay nil 'kill-buffer maze-buffer-name))



;;;###autoload
(defun maze ()
  "Play maze and waste time.
This is an implementation of the classical game maze.
Move left and right bats and try to bounce the ball to your opponent.

maze-mode keybindings:\\<maze-mode-map>

\\{maze-mode-map}"
  (interactive)
  (maze-init))



(provide 'maze)

;;; maze.el ends here