Lisp Game Programming 再履修 <その13> game map
正月のイベントもほぼ終わったので再開!
前回はアニメーションテストを行ったけど、アニメーションを表示するためのマップが必要なので、一度マップ表示に戻ろう。
今回から、共通に利用するファイルも用意する。
(ほぼ原作のままだけど、いらないもの?があったので、その分をカットしている)
blaster-common.lisp ⇒
(defpackage :blaster-common (:use :common-lisp) (:export #:game-map #:width #:height #:data #:In-map-p #:entity #:x #:y #:bomb #:owner #:power #:ticks #:explosion-step #:Bomb-kill-zone #:player #:dx #:dy #:name #:direction #:bomb-count #:bomb-power #:dropped-bombs #:moving-p #:status #:+cell-size+ #:+cell-half-size+ #:+player-step+)) (in-package :blaster-common) (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 game-map () (width height data)) (defun In-map-p (x y map) (and (<= 0 x (1- (width map))) (<= 0 y (1- (height map))))) (define-class entity () (x y)) (define-class bomb (entity) (owner power ticks explosion-step)) (defun Bomb-kill-zone (bomb map) (let ((cells (list (cons (x bomb) (y bomb))))) (loop for (dx . dy) in '((1 . 0) (-1 . 0) (0 . 1) (0 . -1)) do (loop for i from 1 repeat (power bomb) for x = (+ (x bomb) (* i dx)) for y = (+ (y bomb) (* i dy)) while (and (In-map-p x y map) (not (eql (aref (data map) y x) :wall))) do (push (cons x y) cells) when (eql (aref (data map) y x) :obstacle) return nil)) cells)) (define-class player (entity) (dx dy name direction bomb-count bomb-power dropped-bombs moving-p status)) (defparameter +cell-size+ 1000) (defparameter +cell-half-size+ (floor +cell-size+ 2)) ; 500 (defparameter +player-step+ (floor +cell-size+ 5)) ; 200
server-step3.lisp ⇒
;;; The Common-Blaser :server ;;; Step1 <Define Packages> <Load Common> <Log File> <Spawn Player> <Handle Client> <Server Start Stop> ;;; Step2 modify : <Spawn Player> <Handle Client> ;;; Step3 <Make Map> modify : <Spawn Player> <Handle Client> ;;; ;; Step1 <Load Common> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\blaster-common.lisp") ;; Step1 <Define Package> ;; ----------------------------------------------------------------------------------------------- (defpackage :blaster-server (:use :common-lisp :blaster-common) (: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! ;; Step3 <Make Map> ;; ----------------------------------------------------------------------------------------------- (defvar *map*) (defvar *max-player-count*) (defvar *players*) (defun Make-map (width height) ; map size height * width (let ((data (make-array (list height width) :initial-element nil))) (loop for i below width do (setf (aref data 0 i) :wall ; upper line <-- wall (aref data (1- height) i) :wall)) ; bottom line <-- wall (loop for j below height do (setf (aref data j 0) :wall ; left row <-- wall (aref data j (1- width)) :wall)) ; right row <-- wall (loop for j from 2 to (- height 3) by 2 ; 2nd line from top to (- height 3) by 2 do (loop for i from 2 to (- width 3) by 2 ; 2nd row from left to (- width 3) by 2 do (setf (aref data j i) :wall))) ; <-- wall (loop repeat 10 do (setf (aref data (+ (* (random (floor (- height 1) 2)) 2) 1) ; set where there are no walls (+ (* (random (floor (- width 1) 2)) 2) 1)) ; random <= 5(MAX) :obstacle)) (make-instance 'game-map :width width :height height :data data))) (defun Map->string (map) (with-output-to-string (stream) (loop for j below (height map) do (loop for i below (width map) do (write-char (ecase (aref (data map) j i) ; output string to stream ((nil) #\.) (:wall #\X) (:obstacle #\O)) stream))))) ;; Step1 <Spawn Player> Step 3 modify ;; ----------------------------------------------------------------------------------------------- (defun Spawn-player (player-name map) (let ((player (make-instance 'player :name player-name :x (random (width map)) :y (random (height map)) :dx 0 :dy 0 :direction :south :moving-p nil :status :playing))) (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> ;; ----------------------------------------------------------------------------------------------- (defvar *server-socket*) (defpackage :blaster-commands) (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) ;; Step1 <Handle Client> ;; ----------------------------------------------------------------------------------------------- (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 ; command <-- (first tokens) <-- QUIT (when player (Kill-player player)) ; remove player from *players* (return)) ; thread finish (blaster-commands::play ; command <-- (first tokens) <-- PLAY (cond ((= (length *players*) *max-player-count*) ; if player MAX! (format stream "ERROR too many players~%") ; return ERROR! (return)) ; thread finish (t ;; Step 3 modify (setf player (Spawn-player (first args) *map*)) ; new player spawn (format stream "OK ~A ~A ~A ~%" (width *map*) (height *map*) (Map->string *map*))))))) (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 (map-width map-height max-player-count &key (port 8080)) (setf *map* (make-map map-width map-height)) (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* <-- (handle-client socket) thread (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)))) ;; Step 2 modify (defun Operation () (format t "blaster-server is now working!~%") (format t "if you want to shutdown the server,type [stop]~%") (Start 12 12 2) ; map-width:12 ,map-height:12 ,max-player:2 (Prompt)) (Operation)
client-step3.lisp ⇒
;;; The Common-Blaser :client ;;; Step1 <Game Frame> <Define Packages> <Load Common> <Parse-Response> ;;; Step2 <Game Window> ;;; Step3 <Load-Imagaes> <Parse-Map> <Draw-Game> modify : <Game Window> <Game Frame> ;;; ;; Step1 <Load Common> ;; ----------------------------------------------------------------------------------------------- (load "C:\\work\\blaster-common.lisp") ;; Step1 <Define Package> :client ;; ----------------------------------------------------------------------------------------------- (defpackage :client (:use :common-lisp :blaster-common) (:export #:Common-blaster)) (in-package :client) ;; Step2 <Load-Images> ;; ----------------------------------------------------------------------------------------------- (defparameter *ground-image* nil) (defparameter *wall-image* nil) (defparameter *obstacle-image* nil) (defparameter *player-image* nil) (defparameter *dead-image* nil) (defparameter *bomb-image* nil) (defparameter *explosion-image* nil) (defun Load-images () (setf *ground-image* (sdl:load-image "C:\\work\\Images\\ground.png") *wall-image* (sdl:load-image "C:\\work\\Images\\wall.png") *obstacle-image* (sdl:load-image "C:\\work\\Images\\obstacle.png") *player-image* (sdl:load-image "C:\\work\\Images\\player.png") *dead-image* (sdl:load-image "C:\\work\\Images\\dead.png") *bomb-image* (sdl:load-image "C:\\work\\Images\\bomb.png") *explosion-image* (sdl:load-image "C:\\work\\Images\\explosion.png"))) ;; Step1 <Parse-Response> ;; ----------------------------------------------------------------------------------------------- (defun Parse-response (line) (let ((trimmed (and line (string-trim '(#\space #\return #\linefeed) line)))) (if (zerop (length trimmed)) (values nil nil) (let ((tokens (split-sequence:split-sequence #\space trimmed))) (values (string-upcase (first tokens)) (rest tokens)))))) ;; Step2 <Parse-Map> ;; ----------------------------------------------------------------------------------------------- (defun Parse-map (string width height) (let ((data (make-array (list height width) :initial-element nil)) (index 0)) (loop for j below height do (loop for i below width do (setf (aref data j i) (ecase (aref string index) (#\. nil) (#\X :wall) (#\O :obstacle))) (incf index))) (make-instance 'game-map :width width :height height :data data))) ;; Step2 <Draw-Game> ;; ----------------------------------------------------------------------------------------------- (defun Draw-game (map) (sdl:clear-display (sdl:color :r 40 :g 40 :b 40)) (loop for j below (height map) for y = 12 then (+ y 48) ; window-height:600,map-height:576, difference:24 --> half:12 do (loop for i below (width map) for x = 10 then (+ x 65) ; window-width:800,map-width:780, difference:20 --> half:10 do (sdl:draw-surface-at-* (case (aref (data map) j i) ((nil) *ground-image*) (:wall *wall-image*) (:obstacle *obstacle-image*)) x y))) (sdl:update-display)) (defvar *server-socket*) (defvar *server-stream*) (defun Close-socket () (close *server-stream*) (usocket:socket-close *server-socket*)) ;; Step2 <Game Window> Step3 modify ;; ----------------------------------------------------------------------------------------------- (defun Play-game (map) ; 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)) (Load-images) (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)) ;; Step3 modify (Draw-game map))))) ;; Step1 <Game-Frame> Step3 modify ;; ----------------------------------------------------------------------------------------------- (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) ;----> blaster-command::play (Handle-client) (finish-output *server-stream*) (let ((line (read-line *server-stream* nil nil))) (multiple-value-bind (response args) (Parse-response line) (cond ((null response) (format t "Connection error, stopping.~%")) ((string= response "ERROR") (format t "Cannot join game:~A~%" (subseq line 5))) ((string= response "OK") (format t "Joining game, map ~Ax~A~%" (first args) (second args)) ;; Step3 modify (let* ((map-width (parse-integer (first args))) (map-height (parse-integer (second args))) (map (parse-map (third args) map-width map-height))) ; map <-- 'game-map instance (Play-game map))))))) ;; Step1 <Define Package> :blaster-client ;; ----------------------------------------------------------------------------------------------- (defpackage :blaster-client (:use :common-lisp :client)) (in-package :blaster-client) (Common-blaster "localhost" "tomekame0126")
サーバを立ち上げて、
クライアントを立ち上げると、
期待どおりにマップの表示!
まあ、今回は大したことやってないけど、次回は前回のアニメーションの機能をマップ上で実現しよう。
では。