`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 再履修 <その11> multithreading ③

ウィンドウを出すのは、このブログの一番最初にやったプログラムコードをそのまま(Play-game) に付け加えるだけ。
http://tomekame0126.hatenablog.com/entry/2014/06/26/222706

すなわち、これを

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

こんな感じにするだけ。
ウィンドウクローズボタンや q を押すことで終了する。

(defun Play-game ()     ; game main routine
  (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio) ; use video and audio
    (sdl:window 800 600 :position 'center                ; size 800*600, position center
                      ; :position #(192 50)              ;               position x(192) y(50)
                        :title-caption "BLASTER"
                        :icon-caption  "BLASTER"  
                        :flags '(sdl:sdl-doublebuf sdl:sdl-sw-surface))

    (sdl:with-events (:poll)
      (:quit-event ()
	(Close-socket)	   
        t)

      (:idle ()
       (when (sdl:get-key-state :SDL-KEY-Q)  ;---> blaster-command::quit (Handle-client)
         (format *server-stream* "QUIT~%")
         (finish-output *server-stream*)
	 (Close-socket)
         (return-from Play-game))))))

これに合わせてモデファイしたサーバ側
Q が押されたら、(remove player *players*) を行うファンクションを追加している。
server-step2.lisp

;;; The Common-Blaser :server
;;; Step1 <Define Packages> <Log File> <Macro> <Spawn Player> <Handle Client> <Server Start Stop>
;;; Step2 modify : <Spawn Player> <Handle Client> 
;;; 
;; 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))

;; Step 2 modify
(defun Kill-player (player)
  (setf *players* (remove player *players*))) ; remove player from *players*

;; 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
               ;; Step 2 modify
	       (blaster-commands::quit    ;<--- "QUIT~%" (Common-blaster)
	       	 (when player                   ; when player is alive
		   (Kill-player player))        ; remove player
		   (return))
               (blaster-commands::play    ;<--- "PLAY ~A%" (Common-blaster)
                 (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)

続いて、Step 2 としてウィンドウ機能を追加したクライアント側
client-step2.lisp

;;; The Common-Blaser :client
;;; Step1 <Game Frame> <Define Packages> <Parse-Response> 
;;; Step2 <Game Window>
;;;
;; 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*))	

;; Step2 <Game Window> 
;; -----------------------------------------------------------------------------------------------
(defun Play-game ()     ; game main routine
  (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio) ; use video and audio
    (sdl:window 800 600 :position 'center                ; size 800*600, position center
                      ; :position #(192 50)              ;               position x(192) y(50)
                        :title-caption "BLASTER"
                        :icon-caption  "BLASTER"  
                        :flags '(sdl:sdl-doublebuf sdl:sdl-sw-surface))

    (sdl:with-events (:poll)
      (:quit-event ()
	(Close-socket)	   
        t)

      (:idle ()
       (when (sdl:get-key-state :SDL-KEY-Q)  ;---> blaster-command::quit (Handle-client)
         (format *server-stream* "QUIT~%")
         (finish-output *server-stream*)
	 (Close-socket)
         (return-from Play-game))))))
	 
;; 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")
	        (format t "Cannot join game:~A~%" (subseq line 5))) ; <-- too many players ~%
              ((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")

f:id:tomekame0126:20161226202933p:plain
はいっ!予想どおりの結果です。

そしてサーバを立ち上げ、2人がアクセスして接続を切った後、サーバをシャットダウンしたログ。
f:id:tomekame0126:20161226212156p:plain

忘年会が続き、さすがに飲み疲れました。
今夜はここまで。