`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 再履修 <その9> multithreading ①

Lisp の再履修のために勉強材料としたサイトにあった別のプログラムコードを見たら、マルチスレッド化されたゲームのようだったのでちょっとつまみ食い。
でも、忘年会で食べすぎたのか、sbcl がエラーを吐きまくりで、結局つまみ食いどころか、Lisp のプログラムコードを見るのも嫌なくらい食べ過ぎてしまった。

再履修で試しに使った usocket と bordeaux-threads を組み合わせて、2人まで server にアクセスできるが、3人目は「ごめん。ムリ!」と拒否るものをでっち上げてみた。(追記:split-sequence も使ってます。便利ですね。)
ちょっと長いので何回かに分け、忘れたときのことを考え、後でメモも残しておこう。

まずは、サーバ
server-step1.lisp

;;; The Common-Blaser :server
;;; Step1 <Define Packages> <Log File> <Macro> <Spawn Player> <Handle Client> <Server Start Stop>
;;;  
;; Step1 <Define Package> :blaster-server
;; -----------------------------------------------------------------------------------------------
(defpackage :blaster-server
  (:use :common-lisp)
  (:export #:Start #:Stop))
(in-package :blaster-server)

;; Step1 <Log File>
;; -----------------------------------------------------------------------------------------------
(defparameter *log-file* "C:\\work\\gameserver.log")

(defun Level-string (level)
  (ecase level
    (:error "error")
    (:warning "warning")
    (:info "info")
    (:debug "debug")))

(defun Log-event (level strings &rest args)                 ; <-- attention! args to list 
  (multiple-value-bind (second minute hour date month year day daylight-p zone)
      (decode-universal-time (get-universal-time))          ; get time
    (declare (ignore day daylight-p zone))                  ; need not day,daylight-p,zone
    (let ((message (apply #'format nil strings args)))      ; message <-- format function
      (with-open-file (stream *log-file*                    ; open log-file 
                       :direction :output                   ; output
                       :if-does-not-exist :create           ; if not exist create
                       :if-exists :append)                  ; if exist append
        (format stream "~4,'0D-~2,'0D-~2,'0D ~2,'0D:~2,'0D:~2,'0D [~A] ~A~C~C"
                year month date hour minute second          ; output Y M D H M S message
		(Level-string level)
                message
                #\return #\linefeed)))))                    ; output CR/LF for windows!

;; Step1 <Macro>
;; -----------------------------------------------------------------------------------------------
(defmacro define-class (name superclasses slots)
  `(defclass ,name ,superclasses
    ,(mapcar (lambda (slot)
               (let ((keyword (intern (symbol-name slot) :keyword)))
               `(,slot :initarg ,keyword :accessor ,slot)))
             slots)))

(define-class player ()
  (name))

;; Step1 <Spawn Player>
;; -----------------------------------------------------------------------------------------------
(defvar *max-player-count*)
(defvar *players*)

(defun Spawn-player (player-name)
  (let ((player (make-instance 'player
                               :name player-name)))
    (push player *players*)    ; add player to *players*
    player))

;; Step1 <Define Package> :blaster-command
;; -----------------------------------------------------------------------------------------------
(defvar *server-socket*)

(defpackage :blaster-commands)

;; Step1 <Handle Client>
;; -----------------------------------------------------------------------------------------------
(defun Parse-command (line)
  (let ((trimmed (and line  ; delete spaces, newlines, and tabs at the beginning and end of the string
		      (string-trim '(#\space #\return #\linefeed) line))))
    (if (zerop (length trimmed))
        (values nil nil)
        (let ((tokens (split-sequence:split-sequence #\space trimmed))) ; split character string with space
          (values (intern (string-upcase (first tokens)) 'blaster-commands)  ; blaster-commands packsge <--
                  (rest tokens))))))                                         ; intern (first tokens)

(defun Handle-client (stream)
  (Log-event :info "New connection: ~A" stream) ; stream from blaster-client
  (loop with player = nil
        for line = (read-line stream nil nil)
        for input = (and line (string-trim '(#\space #\return #\linefeed) line))
        do (multiple-value-bind (command args)  ; command <-- (first tokens) <-- PLAY	       
             (Parse-command line)               ; args    <-- (rest tokens)  <-- tomekame0126
	     (case command
               (blaster-commands::play
                 (cond ((= (length *players*) *max-player-count*)   ; if player MAX!
                        (format stream "ERROR too many players~%")  ; return ERROR!
                        (return))                                   ; thread finish 
		       (t
		        (setf player (Spawn-player (first args)))   ; new player spawn
		        (format stream "OK ~%")  )))))					       
           (finish-output stream))
  (close stream)
  (Log-event :info "Done processing ~A" stream))

;; Step1 <Server Start Stop>
;; -----------------------------------------------------------------------------------------------
(defvar *listen-thread*)

(defun Server-listen ()
  (let ((stream (usocket:socket-stream (usocket:socket-accept *server-socket*)))) ; socket <-- accept
    (bordeaux-threads:make-thread (lambda () (Handle-client stream))  ; thread <-- (handle-client socket)
                           :name "Game Server [client]")))

(defun Start (max-player-count &key (port 8080))
  (setf *max-player-count* max-player-count  *players* '())

  (setf *server-socket* (usocket:socket-listen "localhost" port    ; listen 
                                               :reuse-address t))
  (setf *listen-thread* (bordeaux-threads:make-thread (lambda ()   ; *listen-thread* <-- thread:(handle-client stream) 			   
                                                        (loop
						          (Server-listen)))
                                                  :name "Game Server [listen]"))
  (Log-event :info "Server started on port ~A" port)
  t)

(defun Stop ()  
  (usocket:socket-close *server-socket*)              ; stop listen
  (bordeaux-threads:destroy-thread *listen-thread*)   ; stop thread
  (log-event :info "Server stopped")
  t)

(defun Prompt ()
  (let ((command (read)))                             ; wait for input [stop]
    (if (eql command 'stop)
          (stop)
        (Prompt))))  

(defun Operation ()
  (format t "blaster-server is now working!~%")
  (format t "if you want to shutdown the server,type [stop]~%")
  (Start 2)   ; max-player:2
  (Prompt))
    
(Operation)

立ち上げるとこんな感じになる。
f:id:tomekame0126:20161223104241p:plain

そして、クライアント
client-step1.lisp

;;; The Common-Blaser :client
;;; Step1 <Game Frame> <Define Packages> <Parse-Response> 
;;; 
;; Step1 <Define Package> :client
;; -----------------------------------------------------------------------------------------------
(defpackage :client
  (:use :common-lisp)
  (:export #:Common-blaster))
(in-package :client)

;; Step1 <Parse-Response> 
;; -----------------------------------------------------------------------------------------------
(defun Parse-response (line)
  (let ((trimmed (and line  ; delete spaces, newlines, and tabs at the beginning and end of the string
		      (string-trim '(#\space #\return #\linefeed) line))))
    (if (zerop (length trimmed)) 
        (values nil nil)
        (let ((tokens (split-sequence:split-sequence #\space trimmed))) ; split character string with space
          (values (string-upcase (first tokens)) ; SAMPLE <-- sample etc 
                  (rest tokens))))))

(defvar *server-socket*)
(defvar *server-stream*)

(defun Close-socket ()
  (close *server-stream*)
  (usocket:socket-close *server-socket*))	

(defun Play-game ()         ; game main routine   
  (Close-socket))    

;; Step1 <Game-Frame> 
;; -----------------------------------------------------------------------------------------------
(defun Common-blaster (server-host player-name &key (server-port 8080))
  (format t "Connecting to server ~A:~A...~%" server-host server-port)
  (setf *server-socket* (usocket:socket-connect server-host server-port))
  (setf *server-stream* (usocket:socket-stream *server-socket*))
 
  (format *server-stream* "PLAY ~A~%" player-name)
  (finish-output *server-stream*)
  (let ((line (read-line *server-stream* nil nil))) ; read-line from blaster-server
    (multiple-value-bind (response args)        
        (Parse-response line)
        (declare (ignore args))                     ; <-- for later use!
        (cond ((null response)
               (format t "Connection error, stopping.~%"))
              ((string= response "ERROR")
              ; (progn
	        (format t "Cannot join game:~A~%" (subseq line 5))) ; <-- too many players ~%
	      ;  (Close-socket)))
              ((string= response "OK")
	       (format t "Joining game ~%")
	       (Play-game))))))
	       
;; Step1 <Define Package> :blaster-client
;; -----------------------------------------------------------------------------------------------
(defpackage :blaster-client
  (:use :common-lisp :client))
(in-package :blaster-client)

  (Common-blaster "localhost" "tomekame0126")

1人目と2人目がアクセスするとこんな感じになる。
f:id:tomekame0126:20161223105929p:plain

3人目がアクセスすると・・・・ ごめん。ムリ!
注)Warning は同じ Emacs から起動しているためのもので、関係なし。
f:id:tomekame0126:20161223110318p:plain

クライアント側を落とした後(Emacsを終了させた後)にサーバを落とすとこんな感じ。
f:id:tomekame0126:20161223110731p:plain

アクセスログはこんな感じ。
明らかに 3人目が拒否られてるよね。
f:id:tomekame0126:20161223110915p:plain

ちょっと早いクリスマスプレゼントということで!
https://www.youtube.com/watch?v=tGfpMTaIX6A


H28.12.24 ちょっと修正
"Cannot join game" 周りの (Close-socket) が必要なさげなのでカットしてみた。