start of remove stone and shape support
This commit is contained in:
parent
bbd9f6d9e5
commit
7ce213be7a
|
@ -91,6 +91,10 @@
|
|||
(defmacro get-player (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
|
||||
|
||||
|
|
|
@ -105,6 +105,14 @@
|
|||
(if (eql (get-stone board coords-var) nil)
|
||||
(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)
|
||||
(let ((free-points (aref (shapes-free-points board) sid)))
|
||||
(if (> (length free-points) 0)
|
||||
|
@ -125,7 +133,9 @@
|
|||
(inc-player-shape-liberty board player (* (length free-points) (shape-size board 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)))
|
||||
(return))))))))
|
||||
(return))))
|
||||
(if (= 0 (length free-points))
|
||||
(remove-shape board sid))))))
|
||||
|
||||
|
||||
|
||||
|
|
17
liberty.lisp
17
liberty.lisp
|
@ -46,16 +46,27 @@
|
|||
(if (eql player #\W)
|
||||
(incf (white-liberties board) delta)))))
|
||||
|
||||
(defmacro dec-liberty (board coords)
|
||||
(defmacro mod-liberty (board coords delta)
|
||||
`(progn
|
||||
(set-2d-stone (liberty-board ,board) ,coords (1- (get-2d-stone (liberty-board ,board) ,coords)))
|
||||
(inc-liberties ,board ,coords -1)))
|
||||
(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))
|
||||
|
||||
|
||||
|
||||
(defmethod set-stone :after ((board liberty-board) coords val)
|
||||
(inc-liberties board coords (get-2d-stone (liberty-board board) coords))
|
||||
(do-over-adjacent (coords-var board coords)
|
||||
(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)
|
||||
(if (eql player #\B)
|
||||
|
|
|
@ -30,6 +30,7 @@
|
|||
:ranked-board
|
||||
:get-stone
|
||||
:set-stone
|
||||
:remove-stone
|
||||
:get-player
|
||||
:coord-to-str
|
||||
:str-to-coord
|
||||
|
|
Loading…
Reference in New Issue