`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 再履修 <その13> game map



blaster-common.lisp ⇒

(defpackage :blaster-common
  (:use :common-lisp)
  (:export #:game-map
           #:width #:height #:data
           #:x #:y
           #:owner #:power #:ticks #:explosion-step
           #: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)))

(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))

(define-class player (entity)
  (dx dy
   bomb-count bomb-power dropped-bombs

(defparameter +cell-size+ 1000)
(defparameter +cell-half-size+ (floor +cell-size+ 2))  ; 500
(defparameter +player-step+ (floor +cell-size+ 5))     ; 200


;;; 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)
                #\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)
    (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))

;; 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*

;; 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 
			;; 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			   
                                                  :name "Game Server [listen]"))
  (Log-event :info "Server started on port ~A" port)

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

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

;; 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


;;; 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)))

(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))

    (sdl:with-events (:poll)
      (:quit-event ()

      (:idle ()
       (when (sdl:get-key-state :SDL-KEY-Q)  ;---> blaster-command::quit (Handle-client)
         (format *server-stream* "QUIT~%")
         (finish-output *server-stream*)
         (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")