Permalink
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Showing
with
236 additions
and 78 deletions.
- +75 −0 client/src/arena.lisp
- +8 −5 client/src/camera.lisp
- +40 −1 client/src/events.lisp
- +12 −5 client/src/game-client.lisp
- +26 −12 client/src/game-server.lisp
- +55 −48 client/src/main.lisp
- +14 −4 client/src/player.lisp
- +3 −2 client/src/proxy.lisp
- +2 −1 common/process-command.lisp
- +1 −0 mortar-combat.asd
@@ -0,0 +1,75 @@ | ||
(in-package :mortar-combat) | ||
|
||
|
||
(defclass arena (lockable subscriber) | ||
((player :reader player-of) | ||
(dudes :initform (make-hash-table :test 'equal)))) | ||
|
||
|
||
(defun dudes-of (arena) | ||
(with-slots (dudes) arena | ||
(loop for dude being the hash-value of dudes | ||
collect dude))) | ||
|
||
|
||
(defun add-dude (arena dude) | ||
(with-slots (dudes) arena | ||
(with-instance-lock-held (arena) | ||
(setf (gethash (name-of dude) dudes) dude)))) | ||
|
||
|
||
(defun find-dude (arena name) | ||
(with-slots (dudes) arena | ||
(with-instance-lock-held (arena) | ||
(gethash name dudes)))) | ||
|
||
|
||
(defun update-game-state (this state timestamp) | ||
(with-slots (dudes player) this | ||
(dolist (dude-state (getf state :player-list)) | ||
(with-instance-lock-held (this) | ||
(let* ((dude-name (getf dude-state :name)) | ||
(dude (gethash dude-name dudes))) | ||
(unless (equal dude-name (name-of player)) | ||
(unless dude | ||
(setf dude (make-instance 'proxy :name dude-name) | ||
(gethash dude-name dudes) dude) | ||
(post (make-player-added dude) (events))) | ||
(update-proxy dude | ||
(sequence->vec2 (getf dude-state :position)) | ||
(sequence->vec2(getf dude-state :rotation)) | ||
timestamp))))))) | ||
|
||
|
||
(defun shoot-ball (player) | ||
(let ((pos (position-of player))) | ||
(run (>> (assembly-flow 'ball-model | ||
:position (vec3 (+ (x pos) 1.0) 10.0 (- (y pos))) | ||
:force (mult (gaze-of player) 10000)) | ||
(-> ((mortar-combat)) (ball) | ||
(let ((group (find-node (root-of (scene-of *system*)) :ball-group))) | ||
(adopt group ball))))))) | ||
|
||
|
||
(defmethod initialize-instance :after ((this arena) &key player-name) | ||
(with-slots (player dudes) this | ||
(unless player-name | ||
(error "Player name should be provided for arena")) | ||
(setf player (make-instance 'player :name player-name)) | ||
(flet ((add-player (ev) | ||
(run (>> (assembly-flow 'dude-model | ||
:player (player-from ev) | ||
:color (vec3 0.9 0.4 0.4)) | ||
(-> ((mortar-combat)) (dude) | ||
(let ((dude-group (find-node (root-of (scene-of *system*)) :dude-group))) | ||
(adopt dude-group dude)))))) | ||
(game-state-updated (ev) | ||
(update-game-state this (state-from ev) (timestamp-from ev))) | ||
(shoot (ev) | ||
(declare (ignore ev)) | ||
(shoot-ball player)) | ||
(update-velocity (ev) | ||
(setf (velocity-of player) (velocity-from ev)))) | ||
(register-event-handler 'trigger-pulled #'shoot) | ||
(register-event-handler 'player-added #'add-player) | ||
(register-event-handler 'game-state-updated #'game-state-updated)))) |
@@ -1,5 +1,44 @@ | ||
(in-package :mortar-combat) | ||
|
||
|
||
(defevent player-added-event () | ||
(defclass subscriber (disposable) | ||
((callbacks :initform (cons nil nil)))) | ||
|
||
|
||
(defun register-event-handler (class handler) | ||
(declare (special *callbacks*)) | ||
(push (cons class (subscribe-to class handler (events))) *callbacks*)) | ||
|
||
|
||
(defmethod initialize-instance :around ((this subscriber) &key) | ||
(with-slots (callbacks) this | ||
(let ((*callbacks* (list))) | ||
(declare (special *callbacks*)) | ||
(call-next-method) | ||
(rplacd callbacks *callbacks*)))) | ||
|
||
|
||
(define-destructor subscriber (callbacks) | ||
(loop with eve = (events) | ||
for (class . cb) in (cdr callbacks) | ||
do (unsubscribe-from class cb eve))) | ||
|
||
|
||
;; | ||
(defevent player-added () | ||
(player)) | ||
|
||
|
||
(defevent game-state-updated () | ||
(state timestamp)) | ||
|
||
|
||
(defevent camera-rotated () | ||
(ax ay)) | ||
|
||
|
||
(defevent velocity-changed () | ||
(velocity)) | ||
|
||
|
||
(defevent trigger-pulled () ()) |
Oops, something went wrong.