Fix some client bugs and call controller quit method before halting.

fantasary/client.scm

@@ -22,6 +22,7 @@
   #:use-module (fantasary tls-cert)
   #:use-module (fibers conditions)
   #:use-module (fibers operations)
+  #:use-module (fibers timers)
   #:use-module (goblins)
   #:use-module (goblins actor-lib joiners)
   #:use-module (goblins actor-lib let-on)
@@ -276,11 +277,22 @@
       #:catch log-error))
 
 (define (look)
-  (let-on ((contents (<- controller 'look)))
-    (let ((entities (assq-ref contents 'entities))
-          (exits (assq-ref contents 'exits)))
-      (log-pk 'look entities exits)
-      (let-on ((entity-names (all-of*-maybe
+  (let-on ((contents (<- controller 'look))
+           (room-profile (<- controller 'room-profile)))
+    (let* ((entities (assq-ref contents 'entities))
+           (exits (assq-ref contents 'exits))
+           (entity-names-vow
+            (all-of*-maybe
+             (map (lambda (e)
+                    (lookup-name-for-entity e))
+                  entities)))
+           (exit-names-vow
+            (all-of*-maybe
+             (map (lambda (room)
+                    (lookup-name-for-room room))
+                  exits))))
+      (let-on ((room-name (lookup-name-for-profile room-profile))
+               (entity-names (all-of*-maybe
                               (map (lambda (e)
                                      (lookup-name-for-entity e))
                                    entities)))
@@ -288,6 +300,7 @@
                             (map (lambda (room)
                                    (lookup-name-for-room room))
                                  exits))))
+        (log (format #f "You are in ~a." room-name))
         (match entity-names
           (()
            (log "There's nothing else in this room.  Just you."))
@@ -332,8 +345,7 @@
           ($ petnames 'register our-name profile)
           (log (format #f "Registered petname @~a for ?~a" our-name self-name))
           (add-task! tasks refresh-title))
-        (log (format #f "No object with self-proposed name: ~a"
-                     self-proposed-name)))))
+        (log (format #f "No object with self-proposed name: ~a" self-name)))))
 
 ;; Parse user input into a s-expression that we can process.
 (define (parse-command port)
@@ -509,7 +521,7 @@
 
   ;; Setup OCapN
   (define hub-uri
-    (call-with-input-file "sturdyref" read-string))
+    (string-trim-both (call-with-input-file client-sturdyref-file read-string)))
   (define hub-sref (string->ocapn-id hub-uri))
   (set! tcp-netlayer
         (with-vat machine-vat
@@ -537,10 +549,12 @@
   (set! entity-vow
         (with-vat user-vat
           (let-on ((profile profile-vow))
-            (spawn ^entity profile))))
+            (<- hub-vow 'make-entity profile))))
   (set! controller
         (with-vat user-vat
-          (spawn ^controller entity-vow)))
+          (let-on ((hub hub-vow)
+                   (entity entity-vow))
+            (spawn ^controller hub entity))))
   (set! logger
         (with-vat ui-vat
           (spawn ^logger:curses log-win)))
@@ -555,23 +569,27 @@
     ;; Enter initial room.
     (on (<- controller 'enter (<- hub-vow 'spawn-point))
         (lambda _
-          (on (<- controller 'look)
-              (lambda (contents)
-                (<-np controller 'say "hey"))
-              #:catch log-error))
-        #:catch log-error)
-    (let*-on ((room (<- hub-vow 'spawn-point))
-              (room-name (<- room 'self-proposed-name)))
-      (format #t "Room name ~a\n" room-name)))
+          (add-task! tasks refresh-title)
+          (look))
+        #:catch log-error))
 
   ;; Setup UI
-  (add-task! tasks refresh-prompt)
-  (add-task! tasks refresh-title))
+  (add-task! tasks refresh-prompt))
 
 (define (do-command input)
   (match (call-with-input-string input parse-command)
     (('quit)
-     (halt-event-loop))
+     (let ((halt? (make-condition)))
+       (define (signal-halt . _)
+         (signal-condition! halt?))
+       (with-vat user-vat
+         (on (<- controller 'quit) signal-halt #:catch signal-halt))
+       ;; Attempt to get a response from the server before quitting,
+       ;; but don't wait forever.
+       (perform-operation
+        (choice-operation (wait-operation halt?)
+                          (sleep-operation 1)))
+       (halt-event-loop)))
     (command
      (with-vat user-vat
        (match command