X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgame-master.scm;fp=mudsync%2Fgame-master.scm;h=89fbaf6c8ca157f52bdca02ef5389306c94abf88;hp=34476b0077a892aaa553813e73df8d30f6676d3c;hb=902b52f87ea65d6a52cb84afee32ad20d89b2bc3;hpb=4d1280ec16d7645817bf741cde658e358de66327

diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm
index 34476b0..89fbaf6 100644
--- a/mudsync/game-master.scm
+++ b/mudsync/game-master.scm
@@ -55,7 +55,8 @@
     (client-input (wrap-apply gm-handle-client-input))
     (lookup-special (wrap-apply gm-lookup-special))
     (new-client (wrap-apply gm-new-client))
-    (write-home (wrap-apply gm-write-home)))))
+    (write-home (wrap-apply gm-write-home))
+    (client-closed (wrap-apply gm-client-closed)))))
 
 
 ;;; .. begin world init stuff ..
@@ -155,6 +156,18 @@
       #:client client-id
       #:data text))
 
+(define-mhandler (gm-client-closed gm message client)
+  ;; Do we have this client registered to an actor?  Get the id if so.
+  (define actor-id (hash-ref (gm-client-dir gm) client))
+
+  ;; Have the actor appropriately disappear / be removed from its
+  ;; room, if we have one.
+  ;; (In some games, if the user never connected)
+  (when actor-id
+    (<-wait gm actor-id 'disconnect-self-destruct)
+    ;; Unregister from the client directories.
+    (gm-unregister-client! gm client)))
+
 
 ;;; GM utilities
 
@@ -162,14 +175,15 @@
   (hash-set! (gm-client-dir gm) client-id player)
   (hash-set! (gm-reverse-client-dir gm) player client-id))
 
-(define (gm-unregister-client! gm client-id)
+(define* (gm-unregister-client! gm client-id #:optional destroy-player)
   "Remove a connection/player combo and ask them to self destruct"
   (match (hash-remove! (gm-client-dir gm) client-id)  ; Remove from our client dir
     ((_ . player-id)
      ;; Remove from reverse table too
      (hash-remove! (gm-reverse-client-dir gm) client-id)
      ;; Destroy player 
-     (<- gm player-id 'destroy-self))
+     (if destroy-player
+         (<- gm player-id 'self-destruct)))
     (#f (throw 'no-client-to-unregister
                "Can't unregister a client that doesn't exist?"
                client-id))))