Skip to content
Snippets Groups Projects
Commit 96ce6040 authored by David Thompson's avatar David Thompson
Browse files

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

parent 87a800b1
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment