From: Christopher Allan Webber Date: Tue, 13 Dec 2016 18:45:13 +0000 (-0600) Subject: Use msg-val everywhere and fix some definitions' argument lists. X-Git-Tag: fosdem-2017~129 X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=commitdiff_plain;h=aca41e2e3c5ed026c2672e3ac4ac364bbdef19c7 Use msg-val everywhere and fix some definitions' argument lists. --- diff --git a/mudsync/game-master.scm b/mudsync/game-master.scm index 0a53389..996e51d 100644 --- a/mudsync/game-master.scm +++ b/mudsync/game-master.scm @@ -149,8 +149,7 @@ #:input data)) (define* (gm-lookup-special actor message #:key symbol) - (<-reply actor message - #:val (hash-ref (slot-ref actor 'special-dir) symbol))) + (<-reply actor message (hash-ref (slot-ref actor 'special-dir) symbol))) (define* (gm-write-home actor message #:key text) (define client-id (hash-ref (gm-reverse-client-dir actor) diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 8b1040f..3250680 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -127,8 +127,7 @@ ;; Kind of a useful utility, maybe? (define (simple-slot-getter slot) (lambda (actor message) - (<-reply actor message - #:val (slot-ref actor slot)))) + (<-reply actor message (slot-ref actor slot)))) (define (gameobj-replace-step-occupants actor occupants) ;; Snarf all the occupants! @@ -249,8 +248,7 @@ Assists in its replacement of occupants if necessary and nothing else." #:occupants occupants)) (define (gameobj-act-get-loc actor message) - (<-reply actor message - #:val (slot-ref actor 'loc))) + (<-reply actor message (slot-ref actor 'loc))) (define (gameobj-set-loc! gameobj loc) "Set the location of this object." @@ -281,7 +279,7 @@ and whos-asking, and see if we should just return it or run it." (define gameobj-get-name (simple-slot-getter 'name)) -(define* (gameobj-act-set-name! actor message #:key val) +(define* (gameobj-act-set-name! actor message val) (slot-set! actor 'name val)) (define* (gameobj-get-desc actor message #:key whos-looking) @@ -290,7 +288,7 @@ and whos-asking, and see if we should just return it or run it." ((? procedure? desc-proc) (desc-proc actor whos-looking)) (desc desc))) - (<-reply actor message #:val desc-text)) + (<-reply actor message desc-text)) (define (gameobj-visible-to-player? gameobj whos-looking) "Check to see whether we're visible to the player or not. @@ -356,10 +354,8 @@ By default, this is whether or not the generally-visible flag is set." (match special-symbol ;; if it's a symbol, look it up dynamically ((? symbol? _) - (msg-receive (_ #:key val) - (<-wait gameobj (slot-ref gameobj 'gm) 'lookup-special - #:symbol special-symbol) - val)) + (msg-val (<-wait gameobj (slot-ref gameobj 'gm) 'lookup-special + #:symbol special-symbol))) ;; if it's false, return nothing (#f #f) ;; otherwise it's probably an address, return it as-is diff --git a/mudsync/player.scm b/mudsync/player.scm index 844aaf9..113770f 100644 --- a/mudsync/player.scm +++ b/mudsync/player.scm @@ -113,9 +113,7 @@ (define inv-names (map (lambda (inv-item) - (msg-receive (_ #:key val) - (<-wait player inv-item 'get-name) - val)) + (msg-val (<-wait player inv-item 'get-name))) (gameobj-occupants player))) (define text-to-show (if (eq? inv-names '()) diff --git a/mudsync/room.scm b/mudsync/room.scm index 2c19788..2ebced1 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -119,9 +119,7 @@ (dyn-ref room (slot-ref exit 'to)) #f)) (define player-name - (msg-receive (_ #:key val) - (<-wait room (message-from message) 'get-name) - val)) + (msg-val (<-wait room (message-from message) 'get-name))) (cond (exit ;; Set the player's new location @@ -237,10 +235,8 @@ (cond (matching-object (let ((obj-desc - (msg-receive (_ #:key val) - (<-wait room matching-object 'get-desc - #:whos-looking (message-from message)) - val))) + (msg-val (<-wait room matching-object 'get-desc + #:whos-looking (message-from message))))) (if obj-desc (<- room (message-from message) 'tell #:text (string-append obj-desc "\n")) @@ -273,10 +269,8 @@ (define* (room-cmd-say room message #:key phrase) "Command: Say something to room participants." (define player-name - (msg-receive (_ #:key val) - (<-wait room (message-from message) - 'get-name) - val)) + (msg-val (<-wait room (message-from message) + 'get-name))) (define message-to-send (format #f "~a says: ~a\n" player-name phrase)) (room-tell-room room message-to-send)) @@ -284,19 +278,15 @@ (define* (room-cmd-emote room message #:key phrase) "Command: Say something to room participants." (define player-name - (msg-receive (_ #:key val) - (<-wait room (message-from message) - 'get-name) - val)) + (msg-val (<-wait room (message-from message) + 'get-name))) (define message-to-send (format #f "* ~a ~a\n" player-name phrase)) (room-tell-room room message-to-send)) (define* (room-announce-entrance room message #:key who-entered) (define player-name - (msg-receive (_ #:key val) - (<-wait room who-entered 'get-name) - val)) + (msg-val (<-wait room who-entered 'get-name))) (define message-to-send (format #f "~a enters the room.\n" player-name)) (room-tell-room room message-to-send diff --git a/mudsync/thing.scm b/mudsync/thing.scm index 7b3a71d..762775d 100644 --- a/mudsync/thing.scm +++ b/mudsync/thing.scm @@ -82,13 +82,9 @@ (define* (thing-cmd-take thing message #:key direct-obj) (define player (message-from message)) (define player-name - (msg-receive (_ #:key val) - (<-wait thing player 'get-name) - val)) + (msg-val (<-wait thing player 'get-name))) (define player-loc - (msg-receive (_ #:key val) - (<-wait thing player 'get-loc) - val)) + (msg-val (<-wait thing player 'get-loc))) (define thing-name (slot-ref thing 'name)) (define should-take (slot-ref-maybe-runcheck thing 'takeable player)) @@ -111,13 +107,9 @@ (define* (thing-cmd-drop thing message #:key direct-obj) (define player (message-from message)) (define player-name - (msg-receive (_ #:key val) - (<-wait thing player 'get-name) - val)) + (msg-val (<-wait thing player 'get-name))) (define player-loc - (msg-receive (_ #:key val) - (<-wait thing player 'get-loc) - val)) + (msg-val (<-wait thing player 'get-loc))) (define thing-name (slot-ref thing 'name)) (define should-drop (slot-ref-maybe-runcheck thing 'dropable player)) diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 16f91b8..d458327 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -160,14 +160,11 @@ or 'skribe'? Now *that's* composition!")) (define* (sign-cmd-sign-in actor message #:key direct-obj indir-obj preposition) (define old-name - (msg-receive (_ #:key val) - (<-wait actor (message-from message) 'get-name) - val)) + (msg-val (<-wait actor (message-from message) 'get-name))) (define name indir-obj) (if (valid-name? indir-obj) (begin - (<-wait actor (message-from message) 'set-name! - #:val name) + (<-wait actor (message-from message) 'set-name! name) (<- actor (slot-ref actor 'loc) 'tell-room #:text (format #f "~a signs the form!\n~a is now known as ~a\n" old-name old-name name))) @@ -200,15 +197,14 @@ character.\n"))) #:init-value (simple-dispatcher summoning-bell-actions*))) -(define (summoning-bell-cmd-ring bell message) +(define* (summoning-bell-cmd-ring bell message . _) ;; Call back to actor who invoked this message handler ;; and find out their name. We'll call *their* get-name message ;; handler... meanwhile, this procedure suspends until we get ;; their response. (define who-rang - (msg-receive (_ #:key val) - (<-wait bell (message-from message) 'get-name) - val)) + (msg-val (<-wait bell (message-from message) 'get-name))) + ;; Now we'll invoke the "tell" message handler on the player ;; who rang us, displaying this text on their screen. ;; This one just uses <- instead of <-wait, since we don't @@ -419,9 +415,7 @@ if this room is intended for children or child-like adults." (define* (furniture-cmd-sit actor message #:key direct-obj) (define player-name - (msg-receive (_ #:key val) - (<-wait actor (message-from message) 'get-name) - val)) + (msg-val (<-wait actor (message-from message) 'get-name))) (<- actor (message-from message) 'tell #:text (format #f "You ~a ~a.\n" (slot-ref actor 'sit-phrase) @@ -609,7 +603,7 @@ with tuition at where it is...")) (<- clerk (message-from message) 'tell #:text "The clerk says, \"Sorry, I'm on my break.\"\n")))) -(define (clerk-act-be-summoned clerk message who-summoned) +(define* (clerk-act-be-summoned clerk message #:key who-summoned) (match (slot-ref clerk 'state) ('on-duty (<- clerk who-summoned 'tell @@ -635,11 +629,9 @@ feel free to ask me. For example, 'ask clerk about changing name'. You can ask me about the following: " clerk-knows-about ".\"\n"))))) -(define (clerk-cmd-dismiss clerk message) +(define* (clerk-cmd-dismiss clerk message . _) (define player-name - (msg-receive (_ #:key val) - (<-wait clerk (message-from message) 'get-name) - val)) + (msg-val (<-wait clerk (message-from message) 'get-name))) (match (slot-ref clerk 'state) ('on-duty (<- clerk (gameobj-loc clerk) 'tell-room