dan
/
fink
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

start of remove stone and shape support

This commit is contained in:
Dan 2008-07-01 11:29:14 -07:00
parent bbd9f6d9e5
commit 7ce213be7a
4 changed files with 30 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
board.lisp
View File

@ -91,6 +91,10 @@
(defmacro get-player (board coords) (defmacro get-player (board coords)
`(get-stone ,board ,coords)) `(get-stone ,board ,coords))
(defgeneric remove-stone (board coords))
(defmethod remove-stone ((board basic-board) coords)
(set-2d-stone (board board) coords nil))
;(defgeneric (setf stone) (val coords ;(defgeneric (setf stone) (val coords

12
liberty-shape.lisp
View File

@ -105,6 +105,14 @@
(if (eql (get-stone board coords-var) nil) (if (eql (get-stone board coords-var) nil)
(add-free-point board coords-var sid player))))) (add-free-point board coords-var sid player)))))
(defun remove-shape (board sid)
(pdebug "remove-shape ~a~%" sid)
(let ((stones (aref (shapes-points board) sid)))
(loop for index from 0 to (1- (length stones)) do
(progn (pdebug "removing stone ~a~%" (aref stones index))
(remove-stone board (aref stones index))))))
(defun remove-free-point (board coord sid player) (defun remove-free-point (board coord sid player)
(let ((free-points (aref (shapes-free-points board) sid))) (let ((free-points (aref (shapes-free-points board) sid)))
(if (> (length free-points) 0) (if (> (length free-points) 0)
@ -125,7 +133,9 @@
(inc-player-shape-liberty board player (* (length free-points) (shape-size board sid))) (inc-player-shape-liberty board player (* (length free-points) (shape-size board sid)))
; (pdebug "set shapes-free-scores new score for ~a~%" sid) ; (pdebug "set shapes-free-scores new score for ~a~%" sid)
(setf (aref (shapes-free-scores board) sid) (* (length free-points) (shape-size board sid))) (setf (aref (shapes-free-scores board) sid) (* (length free-points) (shape-size board sid)))
(return)))))))) (return))))
(if (= 0 (length free-points))
(remove-shape board sid))))))

17
liberty.lisp
View File

@ -46,16 +46,27 @@
(if (eql player #\W) (if (eql player #\W)
(incf (white-liberties board) delta))))) (incf (white-liberties board) delta)))))
(defmacro dec-liberty (board coords) (defmacro mod-liberty (board coords delta)
`(progn `(progn
(set-2d-stone (liberty-board ,board) ,coords (1- (get-2d-stone (liberty-board ,board) ,coords))) (set-2d-stone (liberty-board ,board) ,coords (+ (get-2d-stone (liberty-board ,board) ,coords) ,delta))
(inc-liberties ,board ,coords -1))) (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))
(defmethod set-stone :after ((board liberty-board) coords val) (defmethod set-stone :after ((board liberty-board) coords val)
(inc-liberties board coords (get-2d-stone (liberty-board board) coords)) (inc-liberties board coords (get-2d-stone (liberty-board board) coords))
(do-over-adjacent (coords-var board coords) (do-over-adjacent (coords-var board coords)
(dec-liberty board coords-var))) (dec-liberty board coords-var)))
(defmethod remove-stone :after ((board liberty-board) coords)
(do-over-adjacent (coords-var board coords)
(inc-liberty board coords-var)))
(defmethod score + ((board liberty-board) player) (defmethod score + ((board liberty-board) player)
(if (eql player #\B) (if (eql player #\B)

1
packages.lisp
View File

@ -30,6 +30,7 @@
:ranked-board :ranked-board
:get-stone :get-stone
:set-stone :set-stone
:remove-stone
:get-player :get-player
:coord-to-str :coord-to-str
:str-to-coord :str-to-coord