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")
はいっ!予想どおりの結果です。
そしてサーバを立ち上げ、2人がアクセスして接続を切った後、サーバをシャットダウンしたログ。
忘年会が続き、さすがに飲み疲れました。
今夜はここまで。