You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

99 lines
3.9 KiB

(in-package :gtp-handler)
(defparameter *quit?* nil)
;(defparameter *cputime* 0)
(defmacro inc-cpu-timer (body)
`(let ((start (get-internal-run-time))
(val ,body)
(end (get-internal-run-time)))
(setf go-bot:*cputime* (+ go-bot:*cputime* (float (/ (- end start) 1000))))
(defun gtp-net-client (server port)
(setf *quit?* nil)
(let ((socket (netpipe:tcp-connect server port)))
(if (eql socket nil)
; (format t "Connection establish, playing...~%")
(do ()
((or (eql socket nil) (eql *quit?* t)))
(let ((cmd (netpipe:tcp-read socket)))
;(format t "cmd: '~a'~%" cmd)
(let ((resp (inc-cpu-timer (dispatch-gtp-command cmd))))
;(format t "resp: '~a'~%" resp)
(netpipe:tcp-print socket (concatenate 'string "= " resp (string #\newline) (string #\newline))))))))))
(defun gtp-client ()
(setf *quit?* nil)
(do ()
((eql *quit?* t))
(format t "= ~a~%~%" (inc-cpu-timer (dispatch-gtp-command (read-line t))))))
(defun split-string (string pivot-str)
(do ((pivot (char pivot-str 0))
(i 0 (+ i 1))
(beg 0)
(strings '()))
((> i (length string)) (reverse strings))
(if (or (eql (length string) i) (eql (aref string i) pivot))
(progn (push (subseq string beg i) strings) (setf beg (+ i 1))))))
(defparameter *supported_commands* '("name" "version" "protocol_version" "komi" "boardsize" "clear_board" "play" "genmove" "cputime" "quit" "game_score" "list_commands" "known_command" "gogui-analyze_commands" ))
(defparameter *analyze_commands* '("gfx/Stones/stones" "gfx/Liberties/liberties" "gfx/Shapes/shapes" "gfx/Shape-Liberties/shape-liberties" "gfx/Shape-Stone-Liberties/shape-stone-liberties"))
(defun match-string (str)
(lambda (elem) (string-equal str elem)))
(defun dispatch-gtp-command (command-string)
(pdebug "dispatch-gtp-command ~a~%" command-string)
(let* ((commands (split-string (string-trim #(#\newline #\space) (string-upcase command-string)) " "))
;(cl-ppcre:split "[\\s\\n]+" (string-upcase command-string)))
(command (intern (first commands) :gtp-handler)))
;(format t "~a~%" commands)
(case command
(name go-bot:*name*)
(version go-bot:*version*)
(protocol_version "gtp2ip-0.1")
(boardsize (go-bot:set-boardsize (parse-integer (second commands)))
; warning: read-from-string pulls full reader. not safe
(komi (go-bot:set-komi (read-from-string (second commands)))
(clear_board (go-bot:init) "")
(play (go-bot:do-play (char (second commands) 0) (third commands)) "")
(genmove (go-bot:do-genmove (char (second commands) 0)))
(genmove_black (go-bot:do-genmove #\b))
(genmove_white (go-bot:do-genmove #\w))
(cputime (write-to-string go-bot:*cputime*))
;(get_random_seed "0")
(known_command (write-to-string (count-if (match-string (second commands)) *supported_commands*)))
(list_commands (let ((str ""))
(loop for command in *supported_commands* do (setf str (concatenate 'string str command " ")))
(gogui-analyze_commands (let ((str ""))
(loop for command in *analyze_commands* do (setf str (concatenate 'string str command (string #\newline))))
(string-trim #(#\newline) str)))
(game_score (format t "Score for ~c: ~s~%" go-bot:*player* (string-trim (string #\newline) (second commands))) "")
(stones (string-trim #(#\newline) (analyze-stones)))
(liberties (string-trim #(#\newline) (analyze-liberty)))
(shapes (string-trim #(#\newline) (analyze-shapes)))
(shape-liberties (string-trim #(#\newline) (analyze-shape-liberties)))
(shape-stone-liberties (string-trim #(#\newline) (analyze-shape-stone-liberties)))
;(scores (string-trim #(#\newline)(analyze-score)))
(quit (setf *quit?* t) "")
(otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands)))))))