;; (eval-buffer)
;; (tron)
;; (eev "emacs -fn 5x7 ~/elisp/tron.el &")

;; A tron-ish game.
;; Copyleft 2004, Eduardo Ochs <edrx@mat.puc-rio.br>.
;; First Emacs Lisp version: 2004may31.
;; This version: 2004jun03.
;;
;; Source:     <http://angg.twu.net/elisp/tron.el>
;; Htmlized:   <http://angg.twu.net/elisp/tron.el.html>
;; Screenshot: <http://angg.twu.net/elisp/tron.el.png>

;; Rules: you're yellow and you leave a yellow trail when you walk.
;; You never stop until you die. You die when you hit something
;; yellow. Use the arrow keys to change your direction. Try to make
;; the best score you can before you die. You only live once.
;;
;; In the beginning it's a black arena with yellow walls and a red
;; square 3x3 "pixels" wide somewhere. Walking over a red "pixel"
;; gives you one point and makes another 3x3 square appear somewhere.
;; So, crossing a 3x3 red square from one side to another gives you
;; three points and makes three other squares appear in random
;; positions.
;;
;; Walking over black pixels is harmless.
;;
;; Sometimes the red squares will appear over your trail. Then some
;; pixels of your trail will become red and you'll be able to cross.

;; This is an implementation is Emacs Lisp of a game that I wrote in
;; 11 lines of IBM PC BASIC in the mid 80's. Here's the original code:
;;
;; 10 KEY OFF:SCREEN 1:COLOR 0,0:CLS:RANDOMIZE TIMER
;; 20 LINE (0,0)-(319,192),,b:X=150:Y=90:DX=1:DY=0:PTS=0
;; 30 GOSUB 110:GOSUB 100
;; 40 C=POINT(X,Y):IF C=3 THEN 90 ELSE PSET(X,Y),3
;; 50 IF C=2 THEN PTS=PTS+1:GOSUB 100:GOSUB 110:SOUND 200,,2
;; 60 A$=INKEY$:IF A$="" THEN 80 ELSE ND=INSTR("WASZwasz",A$)-1:IF ND<0 GOTO 80
;; 70 MM=(ND AND 2)-1:H=ND AND 1:IF (H=1)<>(DX<>0) THEN DX=H*MM:DY=(1-H)*MM
;; 80 X=X+DX:Y=Y+DY:GOTO 40
;; 90 END
;; 100 LOCATE 25,1:PRINT "Score:";PTS;:LOCATE 1,1:RETURN
;; 110 H=RND*316+1:V=RND*188+1:LINE(H,V)-(H+2,V+2),2,BF:RETURN

;; The Elisp code is being kept as simple as possible (instead of
;; fast/generic/using gamegrid.el/etc) because I'm using this in a
;; course I'm giving (an introduction to programming). TO DO/HELP
;; NEEDED: the main loop and the timer stuff are very ugly. We should
;; run `tron-move' at each timer tick while `tron-move' returns a true
;; value, and when it returns nil we should stop and cancel the timer.

(require 'cl)				; for `loop'

(defvar tron-buffer "*Tron*")
(defvar tron-display-table (make-display-table))
(defun  tron-set-glyph (position face char)
  (aset tron-display-table
	position (vector (if face (logior char (ash (face-id face) 19))
			   char))))

(make-face 'tron-black-face)
(make-face 'tron-red-face)
(make-face 'tron-yellow-face)
(set-face-background 'tron-black-face  "black")
(set-face-background 'tron-red-face    "red")
(set-face-background 'tron-yellow-face "goldenrod")
(setq tron-black  32
      tron-red    2
      tron-yellow 3)
(tron-set-glyph tron-black  'tron-black-face  32)
(tron-set-glyph tron-red    'tron-red-face    32)
(tron-set-glyph tron-yellow 'tron-yellow-face 32)

(defun tron-init-vars (&optional width height)
  (if width  (setq tron-width width))
  (if height (setq tron-height height))
  (setq tron-x (/ (* 3 tron-width) 5)
	tron-y (/ tron-height 2)
	tron-dx 1
	tron-dy 0
	tron-fifo nil
	tron-score 0
	tron-timer nil))

(defun tron-cell-offset (x y)
  (+ 1 x (* y (1+ tron-width))))
(defun tron-set-cell (x y c)
  (with-current-buffer tron-buffer
    (goto-char (tron-cell-offset x y))
    (delete-char 1)
    (insert-char c 1)))
(defun tron-get-cell (x y)
  (with-current-buffer tron-buffer
    (char-after (tron-cell-offset x y))))

(defun tron-draw-score (&optional str)
  (with-current-buffer tron-buffer
    (goto-char (tron-cell-offset 0 tron-height))
    (kill-region (point) (progn (end-of-line) (point)))
    (insert (format "  Score: %2d" tron-score))
    (if str (insert "   " str))))

(defun tron-init-buffer ()
  (if (not (bufferp tron-buffer))
      (get-buffer-create tron-buffer))
  (with-current-buffer tron-buffer
    (erase-buffer)
    (setq buffer-display-table tron-display-table)
    (loop for y from 1 to tron-height do
	  (insert-char tron-black tron-width)
	  (insert "\n"))))

(defun tron-init-arena ()
  (loop for x from 0 to (1- tron-width) do
	(tron-set-cell x 0                 tron-yellow) ; upper wall
	(tron-set-cell x (1- tron-height) tron-yellow)) ; lower wall
  (loop for y from 0 to (1- tron-height) do
	(tron-set-cell 0                y tron-yellow)  ; left wall
	(tron-set-cell (1- tron-width) y tron-yellow))  ; right wall
  (tron-draw-score))

(defun tron-random-square ()
  (let ((x0 (1+ (random (- tron-width 4))))
	(y0 (1+ (random (- tron-height 4)))))
    (loop for x from x0 to (+ x0 2) do
	  (loop for y from y0 to (+ y0 2) do
		(tron-set-cell x y tron-red)))))

(defun tron-draw ()
  (tron-set-cell tron-x tron-y tron-yellow))

(defun tron-move ()
  (if tron-fifo
      (let ((this (car tron-fifo)))
	(setq tron-fifo (cdr tron-fifo))
	;; (message "%S" tron-fifo)
	(eval this)))
  (setq tron-x (+ tron-x tron-dx))
  (setq tron-y (+ tron-y tron-dy))
  (let ((c (tron-get-cell tron-x tron-y)))
    (cond ((= c tron-black)
	   (tron-draw))
	  ((= c tron-red)
	   (tron-random-square)
	   (setq tron-score (1+ tron-score))
	   (tron-draw-score)
	   (tron-draw))
	  ((= c tron-yellow)
	   (tron-draw-score "Game over")
	   (with-current-buffer tron-buffer
	     (tron-mode 0)
	     (setq cursor-type t))
	   (tron-stop))
	  (t (tron-stop)
	     (error "Bad color: %S" c)))))


;; (find-efunction 'run-with-timer)
;; (find-elnode "Timers")

(defun tron-stop ()
  (interactive)
  (when (and tron-timer (timerp tron-timer))
    (cancel-timer tron-timer)
    (setq tron-timer nil)))

(defun tron-start ()
  (interactive)
  (tron-stop)
  (setq tron-timer (run-with-timer 0.5 0.1 'tron-move)))

;; (define-key global-map "\M-g" 'tron-stop)

(defun tron-push-direction (dx dy)
  (setq tron-fifo
	(append tron-fifo
		`((setq tron-dx ,dx tron-dy ,dy)))))

(defun tron-up    () (interactive) (tron-push-direction  0 -1))
(defun tron-down  () (interactive) (tron-push-direction  0  1))
(defun tron-left  () (interactive) (tron-push-direction -1  0))
(defun tron-right () (interactive) (tron-push-direction  1  0))

(define-minor-mode tron-mode
  "tron keys mode" nil " tron"
  '(([up]    . tron-up)
    ([left]  . tron-left)
    ([right] . tron-right)
    ([down]  . tron-down)
    ("q" . tron-stop)))

(defun tron (&optional width height)
  (interactive)
  (tron-init-vars (or width  (- (window-width) 1))
		  (or height (- (window-height) 2)))
  (tron-init-buffer)
  (tron-init-arena)
  (tron-draw)
  (loop for i from 1 to 1 do
	(tron-random-square))
  (switch-to-buffer tron-buffer)
  (tron-mode 1)
  (setq cursor-type nil)
  (tron-start))