refactoring of liberty and start of shape

env.lisp

@@ -11,15 +11,10 @@
 
 (defparameter *src-root* "/home/dan/src/my/gobot/")
 
+
+(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "gobot" "gtp"  "fink"))
 (defun recompile ()
-  (compile-file (concatenate 'string *src-root* "packages.lisp"))
+  (loop for file in *src-files* do (compile-file (concatenate 'string *src-root* file ".lisp"))))
-  (compile-file (concatenate 'string *src-root* "macro-utils.lisp"))
-  (compile-file (concatenate 'string *src-root* "netpipe.lisp"))
-  (compile-file (concatenate 'string *src-root* "board.lisp"))
-  (compile-file (concatenate 'string *src-root* "liberty-shape.lisp"))
-  (compile-file (concatenate 'string *src-root* "gobot.lisp"))
-  (compile-file (concatenate 'string *src-root* "gtp.lisp"))
-  (compile-file (concatenate 'string *src-root* "fink.lisp")))
 
 (recompile)
 

fink.lisp

@@ -2,11 +2,11 @@
 
 (defparameter *src-root* "/home/dan/src/my/gobot/")
 
+(defparameter *src-files* '("packages" "macro-utils" "netpipe" "board" "liberty" "shape" "gobot" "gtp"))
+
+(defun load-files ()
+  (loop for file in *src-files* do (load (concatenate 'string *src-root* file ".fasl"))))
+
+
+(load-files)
 
-(load (concatenate 'string *src-root* "packages.fasl"))
-(load (concatenate 'string *src-root* "macro-utils.fasl"))
-(load (concatenate 'string *src-root* "netpipe.fasl"))
-(load (concatenate 'string *src-root* "board.fasl"))
-(load (concatenate 'string *src-root* "liberty-shape.fasl"))
-(load (concatenate 'string *src-root* "gobot.fasl"))
-(load (concatenate 'string *src-root* "gtp.fasl"))

liberty.lisp

@@ -1,4 +1,4 @@
-(in-package :liberty-shape)
+(in-package :liberty-board)
 
 (defclass liberty-board (basic-board)
   ((liberty-board
@@ -35,43 +35,13 @@
 	(setf (liberty-board board) (copy-2d-board (liberty-board from-board)))
 	(copy-slots  (black-liberties white-liberties) board from-board))))
 
-;(defmacro dec-2d-stone (board coords)
-;  `(set-2d-stone ,board ,coords (1- (get-2d-stone ,board ,coords))))
-
-  
-
-;(defmethod dec-liberty (board coords)
-;  (dec-2d-stone (liberty-board board) coords)
-;  (let ((player (get-stone board coords)))
-;    (if (not (eql (get-stone board coords) nil))
-;	(set-liberties (board) (1- (liberties board player) player)
-
-;(defmethod liberties ((board liberty-board) player)
-;  (if (eql player #\b)
-;      'black-liberties
-;      'white-liberties))
-  
-;(defun (setf liberties) (liberty board player)
-;  (if (eql player #\b)
-;      (setf (black-liberties board) liberty)
-;      (setf (white-liberties board) liberty)))
-
-;(defmethod set-liberties ((board liberty-board) liberty player)
-;  (if (eql player #\b)
-;      (setf (black-liberties board) liberty)
-;      (setf (white-liberties board) liberty)))
-
-
 (defgeneric inc-liberties (board coords delta))
 
 (defmethod inc-liberties ((board liberty-board) coords delta)
   (let ((player (get-stone board coords)))
-;    (format t "inc-liberties at ~a by ~a for ~a ~%" coords delta player)
     (if (eql player #\B)
-	;(progn (format t "inc black~%")
 	(incf (black-liberties board) delta)
 	(if (eql player #\W)
-	 ;   (progn (format t "inc white ~%")
 	    (incf (white-liberties board) delta)))))
 
 (defmacro dec-liberty (board coords)
@@ -79,36 +49,29 @@
      (set-2d-stone (liberty-board ,board) ,coords (1- (get-2d-stone (liberty-board ,board) ,coords)))
     (inc-liberties ,board ,coords -1)))
 
+(defmacro do-over-adjacent  ((coords-var board coords) &body body)
+  `(let* ((x (first ,coords))
+	  (y (second ,coords))
+	  (up (1- x))
+	  (down (1+ x))
+	  (left (1- y))
+	  (right (1+ y)))
+     (if (>= up 0) (let ((,coords-var `(,up ,y))) ,@body))
+     (if (>= left 0) (let ((,coords-var `(,x ,left))) ,@body))
+     (if (< down (boardsize ,board)) (let ((,coords-var `(,down ,y))) ,@body))
+     (if (< right (boardsize ,board)) (let ((,coords-var `(,x ,right))) ,@body))))
 
 (defmethod set-stone :after ((board liberty-board) coords val)
   (inc-liberties board coords (get-2d-stone (liberty-board board) coords))
-  (let* ((x (first coords))
+  (do-over-adjacent (coords-var  board coords) 
-	 (y (second coords))
+    (dec-liberty board coords-var)))
-	 (up (1- x))
-	 (down (1+ x))
-	 (left (1- y))
-	 (right (1+ y)))
-    (if (>= up 0) (dec-liberty board `(,up ,y)))
-    (if (>= left 0) (dec-liberty board `(,x ,left)))
-    (if (< down (boardsize board)) (dec-liberty board `(,down ,y)))
-    (if (< right (boardsize board)) (dec-liberty board `(,x ,right)))))
      
 (defmethod score + ((board liberty-board) player)
-;	   (format t "player ~a~%" player)
   (if (eql player #\B)
       (- (black-liberties board) (white-liberties board))
       (- (white-liberties board) (black-liberties board))))
       
 	   
-;  (let ((liberty 0))
-;    (do-over-board (coord board)
-;      (let ((stone (get-stone board coord)))
-;      (if (eql stone player)
-;	  (incf liberty (get-2d-stone (liberty-board board) coord))
-;	  (if (eql stone (invert-player player))
-;	      (decf liberty (get-2d-stone (liberty-board board) coord))))))
-;    liberty))
-
 (defun liberty-to-analyze (board)
   (concatenate 'string (board-to-analyze (liberty-board board))
 	       '(#\newline)

packages.lisp

@@ -44,18 +44,26 @@
 	   :analyze-board-score
 	   :board-to-analyze))
 
-(defpackage liberty-shape
+(defpackage liberty-board
   (:use :common-lisp
 	:macro-utils
 	:board)
   (:export :liberty-board
 	   :liberty-to-analyze))
    
+(defpackage shape-board
+  (:use :common-lisp
+	:macro-utils
+	:board)
+  (:export :shape-board
+	   :shape-to-analyze))
+
 
 (defpackage go-bot
   (:use :common-lisp
 	:board
-	:liberty-shape)
+	:liberty-board
+	:shape-board)
   (:export :*name*
 	    :*version*
 	    :*author*

shape.lisp

@@ -0,0 +1,7 @@
+(in-package :shape-board)
+
+(defclass shape-board (basic-board)
+  (
+   ))
+
+;(defun shape-to-analyze ())