Basic random bot functionality

env.lisp

@@ -1,5 +1,14 @@
 (in-package :common-lisp)
 
+;(setf *invoke-debugger-hook*
+;                 (lambda (condition hook)
+;                   (declare (ignore hook))
+                   ;; Uncomment to get backtraces on errors
+                   ;; (sb-debug:backtrace 20)
+;                   (format *error-output* "Error: ~A~%" condition)
+;                   (quit)))
+
+
 (defparameter *src-root* "/home/dan/src/my/gobot/")
 
 (load (compile-file (concatenate 'string *src-root* "packages.lisp")))

gobot.lisp

@@ -10,10 +10,16 @@
 
 (defparameter *board* nil)
 
-(defun make-board (size)
+(defparameter *score-functions* '( (score-unused 1)))
+
+(defparameter *passed* nil)
+(defparameter *player* nil)
+(defparameter *last-player* nil)
+
+(defun make-board (size &optional (initial nil))
   (let ((array (make-array size)))
     (dotimes (i size)
-      (setf (aref array i) (make-array size :initial-element nil)))
+      (setf (aref array i) (make-array size :initial-element initial)))
     array))
 
 (defun set-komi (new-komi)
@@ -23,20 +29,93 @@
   (setf *boardsize* newsize))
 
 (defun init-board ()
-  (setf *board* (make-board *boardsize*)))
+  (setf *board* (make-board *boardsize*))
+  (setf *passed* nil)
+  (setf *player* nil))
 
 (defun init ()
   ;(init other game specific stuff)
   (init-board))
 
-(defun str-to-coord (str)
-  `( ,(- (char-code (char (string-upcase str) 0)) 65) ,(- (parse-integer (subseq str 1)) 1)))
+(defun filter-i-number (number)
+  (if (> number 8) 
+      (1- number)
+      number))
 
-(defun get-board (board coord)
+(defun str-to-coord (str)
+  `( ,(filter-i-number (- (char-code (char (string-upcase str) 0)) 65)) ,(- (parse-integer (subseq str 1)) 1)))
+
+(defun filter-i-char (number)
+  (if (>= number 8)
+      (1+ number)
+      number))
+
+(defun coord-to-str (coord)
+  (concatenate 'string (string (code-char (+ 65 (filter-i-char (first coord)))))
+		(write-to-string (+ (second coord) 1))))
+    
+
+(defun get-stone (board coord)
   (aref (aref board (first coord)) (second coord)))
 
-(defun set-board (board coord val)
+(defun set-stone (board coord val)
   (setf (aref (aref board (first coord)) (second coord)) val))
   
 
-(defun play (player coord-str)
+(defun play (player coord-str)
+  (setf *last-player* player)
+  (if (string= coord-str "PASS")
+      (setf *passed* t)
+      (set-stone *board* (str-to-coord coord-str) player)))
+
+(defun genmove (player)
+  (setf *player* player)
+  (if (or (eql *passed* t) (eql *last-player* player))
+      "pass"
+      (let ((move (coord-to-str (make-move *board* player))))
+	(play player move)
+	move)))
+
+(defun make-move (board player)
+  (select-move (score board player)))
+
+(defun score (board player)
+  (let ((score-board (make-board (length board) 0)))
+    (dolist (slist *score-functions*)
+      (merge-score-board score-board (funcall (first slist) board player) (second slist)))
+    score-board))
+    
+(defun merge-score-board (score-board scores weight)
+  (dotimes (x (length score-board))
+    (dotimes (y (length score-board))
+      (set-stone score-board `(,x ,y) (+ (get-stone score-board `(,x ,y)) (* weight (get-stone scores `(,x ,y))))))))
+      
+
+(defun select-move (board)
+  (let ((highest (get-stone board '(0 0)))
+	(coords (make-array 10 :fill-pointer 0 :adjustable t)))
+    (do ((x 0 (1+ x)))
+	((>= x (length board)) (aref coords (random (length coords))))
+      (do ((y 0 (1+ y)))
+	  ((>= y (length board)))
+	(let ((score (get-stone board `(,x ,y))))
+	  (if (> score highest)
+	      (progn
+		(setf highest score)
+		(setf coords (make-array 10 :fill-pointer 0 :adjustable t ))
+		(vector-push-extend `(,x ,y) coords))
+	      (if (= score highest)
+		  (if (= (random 2) 1)
+		      (vector-push-extend `(,x ,y) coords)))))))))
+      
+
+(defun score-unused (board player)
+  (let ((scores (make-board (length board) 0)))
+    (dotimes (x (length board))
+      (dotimes (y (length board))
+	;body
+	(if (eql (get-stone board `(,x ,y)) nil)
+	    (set-stone scores `(,x ,y) 1))
+	;end
+	))
+    scores))

gtp.lisp

@@ -1,8 +1,65 @@
 (in-package :gtp-handler)
 
+(require :sb-bsd-sockets)
+
 (defparameter *quit?* nil)
 
+
+(defun nslookup (hostname)
+   "Performs a DNS look up for HOSTNAME and returns the address as a
+   four element array, suitable for socket-connect.  If HOSTNAME is
+   not found, a host-not-found-error condition is thrown."
+   (if hostname
+       (host-ent-address (get-host-by-name hostname))
+       nil)) 
+
+(defun tcp-connect (server port &optional (timeout 10))
+  (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type  
+:stream :protocol :tcp))) 
+    (sb-bsd-sockets:socket-connect socket  (nslookup server) port) 
+    socket))
+		
+
+(defun tcp-print-raw (socket line)
+  (when (and socket line)
+    (socket-send socket line nil)))
+
+(defun tcp-print (socket line)
+  (tcp-print-raw socket (concatenate 'string (format nil "~04d" (length line)) line)))
+
+(defun tcp-read-raw (socket &key (maxsize 65536) (timeout 10))
+   (when socket
+     (values (socket-receive socket nil maxsize))))
+
+;(if-timeout (timeout (format t "socket-receive timed out after ~A seconds.~%" timeout) (force-output) nil)
+
+(defun tcp-read (socket &key (timeout 10))
+   (when socket
+     (let ((len (parse-integer (tcp-read-raw socket :maxsize 4 :timeout timeout))))
+       (tcp-read-raw socket :maxsize len :timeout timeout))))
+	
+       
+
+
+(defun gtp-net-client (server port)
+  (go-bot:init)
+  ;(print "bot inited")
+  (setf *quit?* nil)
+  ;(print "get connection")
+  (let ((socket (tcp-connect server port)))
+    ;(print "got socket")
+    (do ()
+	((eql *quit?* t))
+      (let ((cmd (tcp-read socket)))
+;	(print cmd)
+	(let ((resp (dispatch-gtp-command cmd)))
+	;  (print resp)
+	  (tcp-print socket (concatenate 'string "= " resp (string #\newline) (string #\newline))))))))
+
+;      (tcp-print socket (concatenate 'string "= " (dispatch-gtp-command (tcp-read socket)) "\n\n")))))
+
 (defun gtp-client ()
+  (go-bot:init)
   (setf *quit?* nil)
    (do ()
       ((eql *quit?* t))
@@ -20,22 +77,28 @@
 
 
 (defun dispatch-gtp-command (command-string)
-  (let* ((commands (cl-ppcre:split "\\s+" (string-upcase command-string)))
-	 (command (intern (first commands))))
+  (let* ((commands (split-string (string-upcase command-string) " "))
+					;(cl-ppcre:split "\\s+" (string-upcase command-string)))
+	 (command (intern (first commands) :gtp-handler)))
     (case command
       (name go-bot:*name*)
       (version go-bot:*version*)
+      (protocol_version "gtp2ip-0.1")
       (boardsize (go-bot:set-boardsize (parse-integer (second commands)))
 		 (go-bot:init-board)
 		 "")
       ; warning: read-from-string pulls full reader. not safe
       (komi (go-bot:set-komi (read-from-string (second commands))) 
 	    "")
-      (clearboard (go-bot:init) "")
-      (play (go-bot:play (char (second commands) 0) (third commands)))
-      ;(genmove (go-bot:genmove (char (second commands) 0)))
+      (clear_board (go-bot:init) "")
+      (play (go-bot:play (char (second commands) 0) (third commands)) "")
+      (genmove (go-bot:genmove (char (second commands) 0)))
+      (genmove_black (go-bot:genmove #\b))
+      (genmove_white (go-bot:genmove #\w))
+      ;(get_random_seed "0")
       ;(known_command)
-      ;(list_commands
+      ;(list_commands)
+      (game_score (format t "Score for ~c: ~s~%" go-bot:*player* (string-trim (string #\newline) (second commands))) "")
       (quit (setf *quit?* t) "")
-      (otherwise (concatenate 'string "Unkown command '" (first commands) "'")))))
+      (otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands)))))))
   

packages.lisp

@@ -1,9 +1,11 @@
-(in-package :cl-user)
+(in-package :common-lisp)
 
-(clc:clc-require :cl-ppcre)
+;(clc:clc-require :cl-ppcre)
+(asdf:oos 'asdf:load-op :cl-ppcre)
+(require :sb-bsd-sockets)
 
 (defpackage gtp-handler
-  (:use :common-lisp)
+  (:use :common-lisp :sb-bsd-sockets)
   (:export :gtp-client))
 
 (defpackage go-bot
@@ -15,4 +17,6 @@
 	    :set-boardsize
 	    :init-board
 	    :init
+	    :play
+	    :genmove
 	    ))