;;;; bttt-master.lisp -- Spielleiter fuer das Spiel Blind Tic Tac Toe

;;; History
;;; 
;;; 2003/07/18, afiedler@cs.uni-sb.de:
;;;   Funktionen hinzugefuegt, die Spielablauf in eigenem Emacs-buffer
;;;   anzeigen.
;;; 2003/06/25, afiedler@cs.uni-sb.de:
;;;   player-could-know implementiert
;;;   switch implementiert, um Anzeige des geheimen Spielfelds an- und
;;;   auszuschalten. 
;;; 1997/05/14, schairer@dfki.uni-sb.de:
;;;   Datei angelegt, player-could-know ist nicht implementiert

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Interface
;;;

;;; Wenn wir diese Datei in unser Lisp-System laden, dann haben wir
;;; folgende Funktionen zur Verfuegung: 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (bttt:get-strategy-from-file <filename>)
;;;
;;; Diese Funktion liefert als Ergebnis die Closure, die in der Datei
;;; mit dem Namen <filename> steht.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (bttt:next-move <whose-turn> <action> <count> <board>
;;;                 <player-1> <player-2>)
;;;
;;; Diese Funktion spielt ein komplettes Spiel bis zum Spielende.
;;; <whose-turn> ist entweder A oder B und gibt an, welcher Spieler
;;; als naechstes ziehen darf.  <action> ist entweder NIL oder eine
;;; Liste (r c) bestehend aus zwei Zahlen r und c (0 <= r < 3; 0 <= c
;;; < 3).  Im Falle NIL darf der Spieler <whose-move> einen normalen
;;; Zug ausfuehren.  Im anderen Fall wollte der Spieler <whose-turn>
;;; das Feld <action> markieren, aber es war schon vom Gegner
;;; markiert.  Er darf einen weiteren Zug ausfuehren.  In jedem Fall
;;; gibt <count> an, wieviele Felder des Spielfeldes insgesamt schon
;;; belegt sind.  <board> ist das aktuelle (geheime) Spielfeld des
;;; Spielleiters.  <player-1> und <player-2> sind die
;;; Strategie-Funktionen zweier Spieler.
;;;
;;; Die Funktion sollte nur fuer den Startzutand aufgerufen werden,
;;; das heisst:
;;;
;;;    <action> == NIL
;;;    <count> == 0
;;;    <board> == `leeres Spielfeld'


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (bttt: play <filename-1> <filename-2>)
;;;
;;; Diese Funktion liest die Strategie s1 aus der Datei mit dem
;;; Dateinamen <filename-1> und die Strategie s2 aus der Datei mit dem
;;; Dateinamen <filename-2>.  Sie spielt dann eine komplette Partie
;;; Blind Tic Tac Toe bis eine der folgenden Bedingungen erfuellt ist.
;;; (1) Einer der Spieler hat gewonnen.
;;; (2) Das Brett ist voll und keiner der Spieler hat gewonnen.
;;;
;;; BUGS: Die Funktion muesste abbrechen, wenn einer der Spieler ein
;;; Feld besetzen will, von dem er wissen muesste, dass es belegt ist.
;;; Ausserdem muesste sie abbrechen, wenn eine der Strategiefunktionen
;;; laenger als eine Minute braucht. (Terminierung!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Code
;;;

;;; Zuerst definieren wir die Package BLIND-TIC-TAC-TOE.  (DEFPACKAGE
;;; schaut nach, ob sie schon existiert, was z. B. der Fall ist, wenn
;;; wir diese Datei zum zweiten Mal laden, und erzeugt sie, falls das
;;; nicht der Fall ist.)  Das EVAL-WHEN-Konstrukt stellt sicher, dass
;;; sich die Datei richtig kompilieren laesst, ohne vorher geladen
;;; worden zu sein.

(eval-when (compile eval load)
  (defpackage "BLIND-TIC-TAC-TOE"
    (:nicknames "BTTT")
    (:use "COMMON-LISP")
    (:export "GET-STRATEGY-FROM-FILE"
	     "NEXT-MOVE"
	     "PLAY"
	     "EMPTY-BOARD"
	     "SET-POS"
	     "GET-POS"
	     "A"
	     "B"
	     )))

;;; Dann legen wir fest, dass alle Ausdruecke dieser Datei im
;;; Namespace der Package BTTT ausgewertet werden.

(in-package "BLIND-TIC-TAC-TOE")

;;;
;;; Abschnitt 0: Anzeigefunktionen
;;;
;;; Wir definieren Funktionen, die Informationen ueber den Spielverlauf
;;; anzeigen. Wenn tournament.lisp mitgeladen wird, dann ist es (mithilfe des
;;; Files bttt.el) moeglich, die Ausgabe in zwei eigenen Emacs-Buffer zu
;;; lenken. Dazu definieren wir eine Variable:
;;;

(defvar user::*emacs-buffers* nil
  "Variable that indicates if output should be send to special emacs buffers.")

;;;
;;; Nun die Anzeigefunktionen:
;;;

(defun print-move (row col player)
  (if user::*emacs-buffers*
      (user::set-mark row col player)
    (format t "~&<~A: ~A ~A>" player  row col)))

(defun print-tried-move (row col player)
  (if user::*emacs-buffers*
      (user::tried row col player)
    (format t "~&<~A tried: ~A ~A>" player  row col)))

(defun print-could-know (row col player)
  (if user::*emacs-buffers*
      (user::could-know row col player)
    (format t "> Player ~A could know" player)))

(defun print-raised-error (player)
  (if user::*emacs-buffers*
      (user::raised-error player)
    (format t "Error in strategy ~A!" player)))


;;;
;;; Abschnitt 1: Repraesentation des Spielfeldes
;;;
;;; Dann definieren wir den Datentypen zur Repraesentation des
;;; Spielfeldes.  Wir verwenden ein zweidimensionales Array, dessen
;;; Indizes beide von 0 bis 2 einschliesslich laufen koennen.  Jedes
;;; Element des Feldes ist entweder gleich der Konstanten +FREE+ oder
;;; hat als Wert das Symbol A oder das Symbol B.  Die Bedeutung ist
;;; die, dass das entsprechende Feld entweder frei ist, oder von dem
;;; entsprechenden Spieler markiert ist.

;;; Zuerst die Konstante +FREE+:

(defconstant +free+ "."
  "Element value for free square.")

;;; Die Funktion (EMPTY-BOARD) liefert ein leeres Spielbrett als
;;; Ergebnis.

(defun empty-board ()
  "Return empty board."
  (make-array '(3 3)
	      :initial-element +free+))

;;; Die Funktion (SET-POS <row> <col> <mark> <board>) liefert ein
;;; neues Spielbrett, wobei die Position (row col) mit <mark> belegt
;;; wird, unabhaengig davon, welchen Wert das Element im alten Brett
;;; hatte.  Das alte Spielbrett wird dabei zerstoert.

(defun set-pos (row col mark board)
  "Return board with position (row, col) marked with mark,
   board is destroyed."
  (setf (aref board row col) mark)
  board)

;;; Entsprechend wollen wir abfragen koennen, ob ein bestimmtes Feld
;;; belegt ist.

(defun get-pos (row col board)
  "Returns the constant +free+ if square is free, its mark otherwise."
  (aref board row col))

;;; Fuer Testzwecke wollen wir uns ein Spielfeld anschauen koennen.
;;; Dafuer definieren wir die Funktion (PRINT-BOARD <board>), die eine
;;; Textdarstellung des Spielfeldes als String zurueckliefert.

(defun print-board (board)
  "Return pretty representation of board."
  (format nil "~& | 0 1 2~&--------~&0| ~a ~a ~a~&1| ~a ~a ~a~&2| ~a ~a ~a~&"
	  (get-pos 0 0 board) (get-pos 0 1 board) (get-pos 0 2 board)
	  (get-pos 1 0 board) (get-pos 1 1 board) (get-pos 1 2 board)
	  (get-pos 2 0 board) (get-pos 2 1 board) (get-pos 2 2 board)))

(defvar *show-board* t
  "Flag, if the board should be shown.")

(defun toggle-show-board ()
  "Switch showing the board on and off."
  (setf *show-board* (not *show-board*))
  )

;;; Liefert den Namen des Spielers, der gewonnen hat, nil, falls
;;; keiner gewonnen hat.

(defun winner? (board)
  "Has one of them won?"
  (cond ((has-won? 'a board) 'a)
	((has-won? 'b board) 'b)
	(t                   nil)))

;;; Liefert Wahr, falls der Spieler mit der Markierung mark
;;; gewonnen hat.

(defun has-won? (mark board)
  (or (owns-row? 0 board mark)		;Reihen
      (owns-row? 1 board mark)
      (owns-row? 2 board mark)
      (owns-col? 0 board mark)		;Spalten
      (owns-col? 1 board mark)
      (owns-col? 2 board mark)
      (owns-diag? 0 board mark)
      (owns-diag? 1 board mark)))	;Diagonalen

;;; Liefert wahr, falls der Spieler who die which-te 
;;; Reihe/Spalte/Diagonale besetzt.

(defun owns-row? (which board who)
  (and (equal (get-pos which 0 board) who)
       (equal (get-pos which 1 board) who)
       (equal (get-pos which 2 board) who)))

(defun owns-col? (which board who)
  (and (equal (get-pos 0 which board) who)
       (equal (get-pos 1 which board) who)
       (equal (get-pos 2 which board) who)))

(defun owns-diag? (which board who)
  (cond ((= which 0) (and (equal (get-pos 0 0 board) who)
			  (equal (get-pos 1 1 board) who)
			  (equal (get-pos 2 2 board) who)))
	(t           (and (equal (get-pos 0 2 board) who)
			  (equal (get-pos 1 1 board) who)
			  (equal (get-pos 2 0 board) who)))))
	
   
;;;
;;; Abschnitt 2: Einlesen einer Strategie
;;;
;;; Eine Datei, die sich an die Schnittstelle haelt, enthaelt genau
;;; einen LISP-Ausdruck: die Closure.  Diesen Ausdruck lesen wir ein
;;; und werten ihn aus.  Dadurch entsteht (wenn alles gutgeht) die
;;; Closure. Diese liefern wir als Ergebnis.

(defun get-strategy-from-file (filename)
  "Read and evaluate the stratgy closure from file filename."
  (with-open-file (stream filename)
    (eval (read stream))))


;;;
;;; Abschnitt 3:  Das Spiel
;;;

;;; PLAYER-COULD-KNOW liefert wahr, wenn der Spieler wissen koennte,
;;; dass sein Gegner das Feld bereits besetzt hat.  Das fuehrt zum 
;;; Verlust des Spieles.
;;; Dazu definieren wir eine Hashtable, in der wir alle versuchten Zuege
;;; eintragen.

(defvar *tried-moves* (make-hash-table)
  "Hash table to store the moves tried by both players.")

(defun init-tried-moves ()
  (clrhash *tried-moves*))

(defun player-could-know (row col whose-turn board)
  "Could player have known that the square is already marked?"
  (declare (ignore board))
  (let ((tried (gethash (+ (* 10 row) col) *tried-moves*)))
    (if (find whose-turn tried)
	(progn #+old(format t "> Player ~A could know" whose-turn)
	       t)
      (progn (setf (gethash (+ (* 10 row) col) *tried-moves*)
		   (cons whose-turn tried))
	     nil))))

;;; PLAY ruft NEXT-MOVE mit sinnvollen Startparametern auf.  Damit
;;; beginnt das eigentliche Spiel.

(defun play (filename-1 filename-2)
  "Read strategies and let them play against each other."
  (let ((player-a (get-strategy-from-file filename-1))
	(player-b (get-strategy-from-file filename-2))
	)
    (init-tried-moves) ; initialisiere Hashtable
    (next-move 'a			;Spieler A darf als erster
	       'nil			;Normaler Zug
	       0			;Noch kein Stein auf dem Brett
	       (empty-board)		;Leeres Brett am Anfang
	       player-a player-b)))	;Die Strategie-Closures




(defun next-move (whose-turn action count board
		  player-a player-b)
  ;; Anzeigen, was der Spielleiter weiss?
  (when (and (not user::*emacs-buffers*) *show-board* (not action)) ; nicht wenn vorheriger Zug illegal
    (format t "~&Geheimes Spielbrett des Spielleiters:~&~a~&~%"
	    (print-board board)))
  (cond 
   ;; Hat schon jemand gewonnen
   ((winner? board) (winner? board))
   ;; Ist das Brett voll? => Dann gewinnt keiner
   ((>= count 9) 'nil)
   ;; Nein, also muessen wir weiter spielen
   (t
    (let* (
	   ;; Strategiefunktion desjenigen, der dran ist
	   (player (if (eq whose-turn 'a) player-a player-b))
	   ;; Das Markierungszeichen des anderen
	   (other  (if (eq whose-turn 'a) 'b 'a))
	   ;; Die Position, die die Strategiefunktion liefert
	   (pos    (handler-case (let ((val (funcall player action count)))
				   (cond ((and (listp val)
					       (= (length val) 2)
					       (numberp (first val))
					       (numberp (second val)))
					  val)
					 (t (error "Bad return value by strategy ~A" whose-turn))))
))
;				 (error ()
;					(print-raised-error whose-turn)
;					(return-from next-move other))))
	   ;; pos aufgeteilt in Reihe und Spalte
	   (row    (first pos))
	   (col    (second pos))
	   (could-know (player-could-know row col whose-turn board)))
      ;; Jetzt enthaelt (row, col) den Zug, den der Spieler 
      ;; ausfuehren will
      (if (eq (get-pos row col board) +free+)
	  ;; Das Feld ist also noch frei => markiere das Feld, 
	  ;; und dann ist der andere dran
	  (progn
	    (print-move row col whose-turn)
	    (next-move other 'nil (+ count 1) 
		       (set-pos row col whose-turn board)
		       player-a player-b))
	;; Das Feld war also schon belegt => Gib demselben Spieler 
	;; nochmals eine Chance, falls er sie verdient
	(if could-know
	    ;; Eigentlich haette er wissen muessen, dass das Feld 
	    ;; nicht mehr frei ist => der andere gewinnt.
	    (progn
	      (print-could-know row col whose-turn)
	      other)
	  ;; Weitere Chance
	  (progn
	    (print-tried-move row col whose-turn)
	    (next-move whose-turn pos count board player-a player-b))))))))
	       


