X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=base.lisp;h=f47126c941604b657358846fd0072f4e52007e48;hp=a6a79469ac7a9aa0c4cdd5e0e2aacdaddf3ebd9d;hb=a8b65e823b3a59faba717887aee3a8a4a8cf0a28;hpb=062d6c95c94ac969bd49083dea184c9bb81d6fea

diff --git a/base.lisp b/base.lisp
index a6a7946..f47126c 100644
--- a/base.lisp
+++ b/base.lisp
@@ -2,7 +2,7 @@
 ;;;;***************************************************************************
 ;;;;
 ;;;; FILE IDENTIFICATION
-;;;; 
+;;;;
 ;;;;  Name:           base.lisp
 ;;;;  Purpose:        Basic functions for reversi
 ;;;;  Programer:      Kevin Rosenberg based on code by Peter Norvig
@@ -10,7 +10,7 @@
 ;;;;
 ;;;; $Id$
 ;;;;
-;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg 
+;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1998-2002 Peter Norvig
 ;;;;
 ;;;; Reversi users are granted the rights to distribute and use this software
@@ -48,45 +48,45 @@
 
 (defun make-moves ()
   (make-array 60 :element-type 'cons :fill-pointer 0
-	      :adjustable nil))
+              :adjustable nil))
 (deftype moves () '(array cons (60)))
 
 
 (defclass reversi-game ()
   ((bl-strategy :initarg :bl-strategy
-		:documentation "Strategy function for black"
-		:reader bl-strategy)
+                :documentation "Strategy function for black"
+                :reader bl-strategy)
    (wh-strategy :initarg :wh-strategy
-		:documentation "Strategy function for white"
-		:reader wh-strategy)
+                :documentation "Strategy function for white"
+                :reader wh-strategy)
    (board :type board :initarg :board
-	  :documentation "The board configuration"
-	  :reader board)
-   (move-number :type fixnum :initarg :move-number 
-		:documentation "The number of the move to be played"
-		:accessor move-number)
+          :documentation "The board configuration"
+          :reader board)
+   (move-number :type fixnum :initarg :move-number
+                :documentation "The number of the move to be played"
+                :accessor move-number)
    (player :type player :initarg :player
-		:documentation "ID of next player to move"
-		:accessor player)
+                :documentation "ID of next player to move"
+                :accessor player)
    (moves :type moves :initarg :moves
-	  :documentation "An array of moves played in the game"
-	  :accessor moves)
+          :documentation "An array of moves played in the game"
+          :accessor moves)
    (print? :type boolean :initarg :print?
-	   :documentation "Whether to print progress of this game"
-	   :reader print?)
+           :documentation "Whether to print progress of this game"
+           :reader print?)
    (record-game? :type boolean :initarg :record-game?
-	   :documentation "Whether to record moves and clcck of this game"
-	   :reader record-game?)
+           :documentation "Whether to record moves and clcck of this game"
+           :reader record-game?)
    (final-result :type (or null fixnum) :initarg :final-result
-		 :documentation "Final count, is NIL while game in play"
-		 :accessor final-result)
+                 :documentation "Final count, is NIL while game in play"
+                 :accessor final-result)
    (max-minutes :type fixnum :initarg :max-minutes
-		:documentation "Maximum minites for each player"
-		:reader max-minutes)
+                :documentation "Maximum minites for each player"
+                :reader max-minutes)
    (clock :type clock :initarg :clock :initform nil
-	  :documentation "An array of time-units left"
-	  :accessor clock))
-  (:default-initargs 
+          :documentation "An array of time-units left"
+          :accessor clock))
+  (:default-initargs
       :bl-strategy nil
     :wh-strategy nil
     :board (initial-board)
@@ -104,8 +104,8 @@
 (defun title-of (piece)
   (declare (fixnum piece))
   (nth (the fixnum (1- piece)) '("Black" "White")) )
-       
-(defmacro opponent (player) 
+
+(defmacro opponent (player)
   `(if (= ,player black) white black))
 
 (defmacro bref (board square)
@@ -113,8 +113,8 @@
 
 (defparameter all-squares
     (loop for i fixnum from 11 to 88
-	  when (<= 1 (the fixnum (mod i 10)) 8)
-	  collect i)
+          when (<= 1 (the fixnum (mod i 10)) 8)
+          collect i)
   "A list of all squares")
 
 (defun initial-board ()
@@ -124,7 +124,7 @@
   ;; the 4 center squares are taken, the others empty.
   (let ((board (make-array 100 :element-type 'fixnum
                            :initial-element outer
-			   :adjustable nil :fill-pointer nil)))
+                           :adjustable nil :fill-pointer nil)))
     (declare (type board board))
     (dolist (square all-squares)
       (declare (fixnum square))
@@ -139,31 +139,31 @@
 (defgeneric make-clock (clock))
 (defmethod make-clock ((clock array))
   (make-array (+ 1 (max black white))
-	      :element-type 'integer
-	      :initial-contents clock
-	      :adjustable nil
-	      :fill-pointer nil))
+              :element-type 'integer
+              :initial-contents clock
+              :adjustable nil
+              :fill-pointer nil))
 
 (defmethod make-clock ((minutes integer))
   (make-array (+ 1 (max black white))
-	      :element-type 'integer
-	      :initial-element 
-	      (* minutes 60 
-		 internal-time-units-per-second)
-	      :adjustable nil
-	      :fill-pointer nil))
+              :element-type 'integer
+              :initial-element
+              (* minutes 60
+                 internal-time-units-per-second)
+              :adjustable nil
+              :fill-pointer nil))
 
 (defun count-difference (player board)
   "Count player's pieces minus opponent's pieces."
   (declare (type board board)
-	   (type fixnum player)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (type fixnum player)
+           (optimize (speed 3) (safety 0) (space 0)))
   (the fixnum (- (the fixnum (count player board))
-		 (the fixnum (count (opponent player) board)))))
+                 (the fixnum (count (opponent player) board)))))
 
 (defun valid-p (move)
   (declare (type move move)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (optimize (speed 3) (safety 0) (space 0)))
   "Valid moves are numbers in the range 11-88 that end in 1-8."
   (and (typep move 'move) (<= 11 move 88) (<= 1 (mod move 10) 8)))
 
@@ -172,8 +172,8 @@
   "A Legal move must be into an empty square, and it must
   flip at least one opponent piece."
   (declare (type board board)
-	   (type move move)
-	   (type player player))
+           (type move move)
+           (type player player))
   (and (= (the piece (bref board move)) empty)
        (some #'(lambda (dir) (declare (type dir dir)) (would-flip? move player board dir))
              +all-directions+)))
@@ -183,35 +183,35 @@
   "A Legal move must be into an empty square, and it must
   flip at least one opponent piece."
   (declare (type board board)
-	   (type move move)
-	   (type player player)
-	   (optimize speed (safety 0) (space 0)))
+           (type move move)
+           (type player player)
+           (optimize speed (safety 0) (space 0)))
   (if (= (bref board move) empty)
       (block search
-	(let ((i 0))
-	  (declare (fixnum i))
-	  (tagbody t
-	    (when (>= i 8) (return-from search nil))
-	    (when (would-flip? move player board (aref +all-directions+ i))
-	      (return-from search t))
-	    (incf i)
-	    (go t))))
+        (let ((i 0))
+          (declare (fixnum i))
+          (tagbody t
+            (when (>= i 8) (return-from search nil))
+            (when (would-flip? move player board (aref +all-directions+ i))
+              (return-from search t))
+            (incf i)
+            (go t))))
     nil))
 
 (defun legal-p (move player board)
   "A Legal move must be into an empty square, and it must
   flip at least one opponent piece."
   (declare (type board board)
-	   (type move move)
-	   (type player player)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (type move move)
+           (type player player)
+           (optimize (speed 3) (safety 0) (space 0)))
   (if (= (the piece (bref board move)) empty)
       (block search
-	(dolist (dir +all-directions+)
-	  (declare (type dir dir))
-	  (when (would-flip? move player board dir)
-	    (return-from search t)))
-	(return-from search nil))
+        (dolist (dir +all-directions+)
+          (declare (type dir dir))
+          (when (would-flip? move player board dir)
+            (return-from search t)))
+        (return-from search nil))
     nil))
 
 (defstruct (state (:constructor make-state-struct))
@@ -223,31 +223,31 @@
 (defun make-game-move (game move player)
   (when (record-game? game)
     (vector-push (make-state move player (clock game) (board game))
-		 (moves game)))
+                 (moves game)))
   (make-move move player (board game))
   (incf (move-number game)))
 
 (defun reset-game (game &optional (move-number 1))
   (if (record-game? game)
       (when (< move-number (move-number game))
-	(let ((old-state (aref (moves game) (1- move-number))))
-	  (if old-state
-	      (progn
-		(setf (player game) (state-player old-state))
-		(replace-board (board game) (state-board old-state))
-		(replace (clock game) (state-clock old-state))
-		(setf (fill-pointer (moves game)) (1- move-number))
-		(setf (move-number game) move-number))
-	    (warn "Couldn't find old state"))))
+        (let ((old-state (aref (moves game) (1- move-number))))
+          (if old-state
+              (progn
+                (setf (player game) (state-player old-state))
+                (replace-board (board game) (state-board old-state))
+                (replace (clock game) (state-clock old-state))
+                (setf (fill-pointer (moves game)) (1- move-number))
+                (setf (move-number game) move-number))
+            (warn "Couldn't find old state"))))
   (warn "Tried to reset game, but game is not being recorded")))
-  
+
 (defun make-move (move player board)
   "Update board to reflect move by player"
   ;; First make the move, then make any flips
   (declare (type board board)
-	   (type move move)
-	   (type player)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (type move move)
+           (type player)
+           (optimize (speed 3) (safety 0) (space 0)))
   (setf (bref board move) player)
   (dolist (dir +all-directions+)
     (declare (type dir dir))
@@ -257,10 +257,10 @@
 (defun make-flips (move player board dir)
   "Make any flips in the given direction."
   (declare (type board board)
-	   (type move move)
-	   (type player player)
-	   (type dir dir)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (type move move)
+           (type player player)
+           (type dir dir)
+           (optimize (speed 3) (safety 0) (space 0)))
   (let ((bracketer (would-flip? move player board dir)))
     (when bracketer
       (loop for c from (+ move dir) by dir until (= c (the fixnum bracketer))
@@ -270,13 +270,13 @@
   "Would this move result in any flips in this direction?
   If so, return the square number of the bracketing piece."
   ;; A flip occurs if, starting at the adjacent square, c, there
-  ;; is a string of at least one opponent pieces, bracketed by 
+  ;; is a string of at least one opponent pieces, bracketed by
   ;; one of player's pieces
   (declare (type board board)
-	   (type move move)
-	   (type player player)
-	   (type dir dir)
-	   (optimize (speed 3) (safety 0) (space 0)))
+           (type move move)
+           (type player player)
+           (type dir dir)
+           (optimize (speed 3) (safety 0) (space 0)))
   (let ((c (+ move dir)))
     (declare (type square c))
     (and (= (the piece (bref board c)) (the player (opponent player)))
@@ -285,10 +285,10 @@
 (defun find-bracketing-piece (square player board dir)
   "Return the square number of the bracketing piece."
   (declare (type board board)
-	   (type square square)
-	   (type player player)
-	   (type dir dir)
-	   (optimize (speed 3) (safety 0))
+           (type square square)
+           (type player player)
+           (type dir dir)
+           (optimize (speed 3) (safety 0))
 )
   (cond ((= (bref board square) player) square)
         ((= (bref board square) (the player (opponent player)))
@@ -298,11 +298,11 @@
 (defun next-to-play (board previous-player &optional (print nil))
   "Compute the player to move next, or NIL if nobody can move."
   (declare (type board board)
-	   (type player previous-player)
-	   (type boolean print))
+           (type player previous-player)
+           (type boolean print))
   (let ((opp (opponent previous-player)))
     (cond ((any-legal-move? opp board) opp)
-          ((any-legal-move? previous-player board) 
+          ((any-legal-move? previous-player board)
            (when print
              (format t "~&~c has no moves and must pass."
                      (name-of opp)))
@@ -312,7 +312,7 @@
 (defun any-legal-move? (player board)
   "Does player have any legal moves in this position?"
   (declare (type player player)
-	   (type board board))
+           (type board board))
   (some #'(lambda (move) (declare (type move move)) (legal-p move player board))
         all-squares))
 
@@ -321,7 +321,7 @@
   "Returns a list of legal moves for player"
   ;;*** fix, segre, 3/30/93.  Was remove-if, which can share with all-squares.
   (declare (type player player)
-	   (type board board))
+           (type board board))
   (loop for move in all-squares
       when (legal-p move player board) collect move))
 
@@ -335,43 +335,43 @@
 (defvar *move-number* 1 "The number of the move to be played")
 (declaim (type fixnum *move-number*))
 
-(defun make-game (bl-strategy wh-strategy 
-		  &key 
-		  (print t) 
-		  (minutes +default-max-minutes+)
-		  (record-game nil))
+(defun make-game (bl-strategy wh-strategy
+                  &key
+                  (print t)
+                  (minutes +default-max-minutes+)
+                  (record-game nil))
   (let ((game
-	 (make-instance 'reversi-game :bl-strategy bl-strategy
-			:wh-strategy wh-strategy
-			:print? print
-			:record-game? record-game
-			:max-minutes minutes)))
+         (make-instance 'reversi-game :bl-strategy bl-strategy
+                        :wh-strategy wh-strategy
+                        :print? print
+                        :record-game? record-game
+                        :max-minutes minutes)))
     (setf (clock game) (make-clock minutes))
     game))
 
 (defun play-game (game)
   (catch 'game-over
     (until (null (player game))
-	   (setq *move-number* (move-number game))
-	   (get-move game
-		     (if (= (player game) black) 
-			 (bl-strategy game)
-		       (wh-strategy game))
-		     (player game)
-		     (board game) (print? game) (clock game))
-	   (setf (player game) 
-	     (next-to-play (board game) (player game) (print? game)))
-	   (incf (move-number game))))
+           (setq *move-number* (move-number game))
+           (get-move game
+                     (if (= (player game) black)
+                         (bl-strategy game)
+                       (wh-strategy game))
+                     (player game)
+                     (board game) (print? game) (clock game))
+           (setf (player game)
+             (next-to-play (board game) (player game) (print? game)))
+           (incf (move-number game))))
   (when (print? game)
     (format t "~&The game is over.  Final result:")
     (print-board (board game) (clock game)))
   (count-difference black (board game)))
 
 
-(defun reversi (bl-strategy wh-strategy 
+(defun reversi (bl-strategy wh-strategy
                 &optional (print t) (minutes +default-max-minutes+))
   (play-game (make-game bl-strategy wh-strategy :print print
-			:record-game nil :minutes minutes)))
+                        :record-game nil :minutes minutes)))
 
 (defvar *clock* (make-clock +default-max-minutes+) "A copy of the game clock")
 (defvar *board* (initial-board) "A copy of the game board")
@@ -396,14 +396,14 @@
        (throw 'game-over (if (eql player black) -64 64)))
       ((and (valid-p move) (legal-p move player board))
        (when print
-         (format t "~&~c moves to ~a." 
+         (format t "~&~c moves to ~a."
                  (name-of player) (88->h8 move)))
        (make-game-move game move player))
       (t (warn "Illegal move: ~a" (88->h8 move))
          (get-move game strategy player board print clock)))))
 
 
-(defun random-reversi-series (strategy1 strategy2 
+(defun random-reversi-series (strategy1 strategy2
                               n-pairs &optional (n-random 10))
   "Play a series of 2*n games, starting from a random position."
   (reversi-series
@@ -446,7 +446,7 @@
                              :initial-element 0)))
     ;; Play the games
     (dotimes (i N)
-      (loop for j from (+ i 1) to (- N 1) do 
+      (loop for j from (+ i 1) to (- N 1) do
           (let* ((wins (random-reversi-series
                          (elt strategies i)
                          (elt strategies j)
@@ -461,5 +461,5 @@
       (format t "~&~a~20T ~4f: " (elt names i) (elt totals i))
       (dotimes (j N)
         (format t "~4f " (if (eql i j) '---
-			   (aref scores i j)))))))
+                           (aref scores i j)))))))