;;;; Programer: Kevin Rosenberg based on code by Peter Norvig
;;;; Date Started: 1 Nov 2001
;;;;
-;;;; $Id: base.lisp,v 1.1 2002/10/25 12:42:42 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file is Copyright (c) 2001-2002 by Kevin M. Rosenberg
;;;; and Copyright (c) 1998-2002 Peter Norvig
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;;***************************************************************************
-(in-package :reversi)
-(declaim (optimize (safety 1) (debug 3) (speed 3) (compilation-speed 0)))
-
+(in-package #:reversi)
(defparameter +all-directions+ '(-11 -10 -9 -1 1 9 10 11))
(defconstant +default-max-minutes+ 30)
(record-game? :type boolean :initarg :record-game?
:documentation "Whether to record moves and clcck of this game"
:reader record-game?)
- (final-result :type fixnum :initarg :final-result
+ (final-result :type (or null fixnum) :initarg :final-result
:documentation "Final count, is NIL while game in play"
:accessor final-result)
(max-minutes :type fixnum :initarg :max-minutes
:clock (make-clock +default-max-minutes+)))
-(defun name-of (piece) (char ".@O?" piece))
-(defun title-of (piece) (nth (1- piece) '("Black" "White")) )
+(defun name-of (piece) (schar ".@O?" piece))
+(defun title-of (piece)
+ (declare (fixnum piece))
+ (nth (the fixnum (1- piece)) '("Black" "White")) )
(defmacro opponent (player)
`(if (= ,player black) white black))
`(the piece (aref (the board ,board) (the square ,square))))
(defparameter all-squares
- (loop for i from 11 to 88 when (<= 1 (mod i 10) 8) collect i)
+ (loop for i fixnum from 11 to 88
+ when (<= 1 (the fixnum (mod i 10)) 8)
+ collect i)
"A list of all squares")
(defun initial-board ()
(defun count-difference (player board)
"Count player's pieces minus opponent's pieces."
(declare (type board board)
- (fixnum player))
- (- (count player board)
- (count (opponent player) board)))
+ (type fixnum player)
+ (optimize (speed 3) (safety 0) (space 0)))
+ (the fixnum (- (the fixnum (count player board))
+ (the fixnum (count (opponent player) board)))))
(defun valid-p (move)
- (declare (type move move))
+ (declare (type move move)
+ (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)))
(declare (type board board)
(type move move)
(type player player)
- (optimize speed (safety 0))
-)
+ (optimize speed (safety 0) (space 0)))
(if (= (bref board move) empty)
(block search
(let ((i 0))
(declare (type board board)
(type move move)
(type player player)
- (optimize (speed 3) (safety 0))
-)
+ (optimize (speed 3) (safety 0) (space 0)))
(if (= (the piece (bref board move)) empty)
(block search
(dolist (dir +all-directions+)
(declare (type board board)
(type move move)
(type player)
- (optimize (speed 3) (safety 0))
-)
+ (optimize (speed 3) (safety 0) (space 0)))
(setf (bref board move) player)
(dolist (dir +all-directions+)
(declare (type dir dir))
(type move move)
(type player player)
(type dir dir)
- (optimize (speed 3) (safety 0))
-)
+ (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))
(type move move)
(type player player)
(type dir dir)
- (optimize (speed 3) (safety 0))
-)
+ (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)))
- (find-bracketing-piece (+ c dir) player board dir))))
+ (find-bracketing-piece (the fixnum (+ c dir)) player board dir))))
(defun find-bracketing-piece (square player board dir)
"Return the square number of the bracketing piece."
(loop for move in all-squares
when (legal-p move player board) collect move))
-#-allegro
(defun replace-board (to from)
(replace to from))
-#+ignore
-(defun replace-board (to from)
- (declare (type board to from)
- (optimize (safety 0) (debug 0) (speed 3))
-)
- (dotimes (i 100)
- (declare (type 'fixnum i))
- (setf (aref to i) (aref from i)))
- to)
-
-#+allegro
-(defun replace-board (to from)
- (declare (type board to from))
- (ff::fslot-memory-copy to 0 400 from)
- to)
-
(defvar *ply-boards*
(apply #'vector (loop repeat 40 collect (initial-board))))
-
(defvar *move-number* 1 "The number of the move to be played")
(declaim (type fixnum *move-number*))
(count-difference black (board game)))
-
(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)))
-
-#+ignore
-(defun reversi (bl-strategy wh-strategy
- &optional (print t) (minutes 30))
- "Play a game of reversi. Return the score, where a positive
- difference means black, the first player, wins."
- (let ((board (initial-board))
- (clock (make-clock minutes)))
- (declare (type board board))
- (catch 'game-over
- (loop for *move-number* from 1
- for player = black then (next-to-play board player print)
- for strategy = (if (eql player black)
- bl-strategy
- wh-strategy)
- until (null player)
- do (get-move nil strategy player board print clock))
- (when print
- (format t "~&The game is over. Final result:")
- (print-board board clock))
- (count-difference black board))))
-
(defvar *clock* (make-clock +default-max-minutes+) "A copy of the game clock")
(defvar *board* (initial-board) "A copy of the game board")