From 763245732d94f42ce2a2563cee462dfb2dd75813 Mon Sep 17 00:00:00 2001 From: Dan Date: Wed, 7 May 2008 02:07:47 -0700 Subject: [PATCH] Basic random bot functionality --- env.lisp | 9 +++++ gobot.lisp | 95 ++++++++++++++++++++++++++++++++++++++++++++++----- gtp.lisp | 77 +++++++++++++++++++++++++++++++++++++---- packages.lisp | 10 ++++-- 4 files changed, 173 insertions(+), 18 deletions(-) diff --git a/env.lisp b/env.lisp index 0727a17..940fd96 100644 --- a/env.lisp +++ b/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"))) diff --git a/gobot.lisp b/gobot.lisp index fe4501c..3a2a65f 100644 --- a/gobot.lisp +++ b/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) \ No newline at end of file +(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)) \ No newline at end of file diff --git a/gtp.lisp b/gtp.lisp index e8f8ae7..a673b22 100644 --- a/gtp.lisp +++ b/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))))))) \ No newline at end of file diff --git a/packages.lisp b/packages.lisp index 59a1cab..7762b1e 100644 --- a/packages.lisp +++ b/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 )) \ No newline at end of file