2008-06-03 16:08:30 +00:00
|
|
|
(in-package :liberty-board)
|
2008-05-27 00:46:53 +00:00
|
|
|
|
|
|
|
(defclass liberty-board (basic-board)
|
|
|
|
((liberty-board
|
2008-05-29 02:40:25 +00:00
|
|
|
:initform nil
|
2008-05-29 10:32:39 +00:00
|
|
|
:accessor liberty-board)
|
|
|
|
(black-liberties
|
|
|
|
:initform 0
|
|
|
|
:initarg black-liberties
|
|
|
|
:accessor black-liberties)
|
|
|
|
(white-liberties
|
|
|
|
:initform 0
|
|
|
|
:initarg white-liberties
|
|
|
|
:accessor white-liberties)))
|
2008-05-29 02:40:25 +00:00
|
|
|
|
2008-06-21 06:03:06 +00:00
|
|
|
(defmacro liberty (board coords)
|
|
|
|
`(get-2d-stone (liberty-board ,board) ,coords))
|
|
|
|
|
2008-05-29 02:40:25 +00:00
|
|
|
(defun set-symetric-edge (board index stone max)
|
|
|
|
(let ((coords `( (0 ,index) (,index 0) (,max ,index) (,index ,max))))
|
|
|
|
(loop for coord in coords do (set-2d-stone (liberty-board board) coord stone))))
|
|
|
|
|
|
|
|
(defun set-symetric-corner (board stone max)
|
2008-05-29 10:32:39 +00:00
|
|
|
(let ((coords `( (0 0) (,max 0) (0 ,max) (,max ,max))))
|
2008-05-29 02:40:25 +00:00
|
|
|
(loop for coord in coords do (set-2d-stone (liberty-board board) coord stone))))
|
|
|
|
|
|
|
|
(defmethod initialize-instance :after ((board liberty-board) &key from-board)
|
|
|
|
; (format t "init liberty-board~%")
|
|
|
|
(if (eql from-board nil)
|
|
|
|
(progn
|
|
|
|
(setf (liberty-board board) (make-2d-board (boardsize board) 4))
|
|
|
|
; set up walled edges to have less liberty
|
|
|
|
(loop for i from 1 to (1- (boardsize board)) do
|
|
|
|
(set-symetric-edge board i 3 (1- (boardsize board))))
|
|
|
|
(set-symetric-corner board 2 (1- (boardsize board))))
|
|
|
|
(progn
|
2008-05-29 10:32:39 +00:00
|
|
|
(setf (liberty-board board) (copy-2d-board (liberty-board from-board)))
|
|
|
|
(copy-slots (black-liberties white-liberties) board from-board))))
|
2008-05-29 02:40:25 +00:00
|
|
|
|
2008-05-29 10:32:39 +00:00
|
|
|
(defgeneric inc-liberties (board coords delta))
|
|
|
|
|
|
|
|
(defmethod inc-liberties ((board liberty-board) coords delta)
|
|
|
|
(let ((player (get-stone board coords)))
|
|
|
|
(if (eql player #\B)
|
|
|
|
(incf (black-liberties board) delta)
|
|
|
|
(if (eql player #\W)
|
|
|
|
(incf (white-liberties board) delta)))))
|
|
|
|
|
2008-07-01 18:29:14 +00:00
|
|
|
(defmacro mod-liberty (board coords delta)
|
2008-05-29 10:32:39 +00:00
|
|
|
`(progn
|
2008-07-01 18:29:14 +00:00
|
|
|
(set-2d-stone (liberty-board ,board) ,coords (+ (get-2d-stone (liberty-board ,board) ,coords) ,delta))
|
|
|
|
(inc-liberties ,board ,coords ,delta)))
|
|
|
|
|
|
|
|
(defmacro dec-liberty (board coords)
|
|
|
|
`(mod-liberty ,board ,coords -1))
|
|
|
|
|
|
|
|
(defmacro inc-liberty (board coords)
|
|
|
|
`(mod-liberty ,board ,coords 1))
|
|
|
|
|
2008-05-29 10:32:39 +00:00
|
|
|
|
2008-06-03 16:08:30 +00:00
|
|
|
|
2008-05-29 02:40:25 +00:00
|
|
|
(defmethod set-stone :after ((board liberty-board) coords val)
|
2008-05-29 10:32:39 +00:00
|
|
|
(inc-liberties board coords (get-2d-stone (liberty-board board) coords))
|
2008-06-03 16:08:30 +00:00
|
|
|
(do-over-adjacent (coords-var board coords)
|
|
|
|
(dec-liberty board coords-var)))
|
2008-07-01 18:29:14 +00:00
|
|
|
|
|
|
|
(defmethod remove-stone :after ((board liberty-board) coords)
|
2008-08-23 17:19:41 +00:00
|
|
|
(pdebug "liberty-board:remove-stone ~a~%" coords)
|
2008-07-01 18:29:14 +00:00
|
|
|
(do-over-adjacent (coords-var board coords)
|
|
|
|
(inc-liberty board coords-var)))
|
2008-05-29 02:40:25 +00:00
|
|
|
|
|
|
|
(defmethod score + ((board liberty-board) player)
|
2008-05-29 10:32:39 +00:00
|
|
|
(if (eql player #\B)
|
|
|
|
(- (black-liberties board) (white-liberties board))
|
|
|
|
(- (white-liberties board) (black-liberties board))))
|
|
|
|
|
|
|
|
|
2008-05-29 02:40:25 +00:00
|
|
|
(defun liberty-to-analyze (board)
|
2008-05-29 10:32:39 +00:00
|
|
|
(concatenate 'string (board-to-analyze (liberty-board board))
|
|
|
|
'(#\newline)
|
|
|
|
"TEXT Black Liberties: " (write-to-string (black-liberties board)) " and White Liberties: " (write-to-string (white-liberties board))))
|
2008-05-29 02:40:25 +00:00
|
|
|
|