X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=6baea54ce99daef1d83e8b0440de2fb0ef8a4f5e;hp=0b0e10108411c0aa1086cfd682a346c51149e43c;hb=29f902827724fd50b512c60916a16850367f6046;hpb=902b52f87ea65d6a52cb84afee32ad20d89b2bc3 diff --git a/mudsync/room.scm b/mudsync/room.scm index 0b0e101..6baea54 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -72,8 +72,7 @@ (empty-command "look" 'cmd-look-room) (empty-command "go" 'cmd-go-where) (loose-direct-command "go" 'cmd-go) - ;; (greedy-command "say" 'cmd-say) - )) + (greedy-command "say" 'cmd-say))) (define room-actions (build-actions @@ -83,11 +82,12 @@ (cmd-go (wrap-apply room-cmd-go)) (cmd-go-where (wrap-apply room-cmd-go-where)) (look-room (wrap-apply room-look-room)) - (tell-room (wrap-apply room-tell-room)) + (tell-room (wrap-apply room-act-tell-room)) ;; in this case the command is the same version as the normal ;; look-room version (cmd-look-room (wrap-apply room-look-room)) - (cmd-look-at (wrap-apply room-look-at)))) + (cmd-look-at (wrap-apply room-look-at)) + (cmd-say (wrap-apply room-cmd-say)))) (define room-actions* (append room-actions gameobj-actions)) @@ -228,7 +228,6 @@ claim to point to." (define goes-by (message-ref (<-wait room occupant 'goes-by) 'goes-by #f)) - (display "here!\n") (if (member called-this goes-by) (return occupant))) (hash-map->list (lambda (key val) key) @@ -259,18 +258,33 @@ claim to point to." (<- room (message-from message) 'tell #:text "You don't see that here, so you can't look at it.\n")))) -(define-mhandler (room-tell-room room message text) - "Tell the room some messages." - (define exclude (message-ref message 'exclude #f)) - (define wait-delivery (message-ref message 'wait-delivery #f)) + +(define* (room-tell-room room text #:key exclude wait) (define who-to-tell (gameobj-occupants room #:exclude exclude)) (for-each (lambda (tell-me) ;; @@: Does anything really care? (define deliver-method - (if wait-delivery + (if wait <-wait <-)) (deliver-method room tell-me 'tell #:text text)) who-to-tell)) + +(define-mhandler (room-act-tell-room room message text) + "Tell the room some messages." + (define exclude (message-ref message 'exclude #f)) + (define wait-delivery (message-ref message 'wait #f)) + (room-tell-room room text + #:exclude exclude + #:wait wait-delivery)) + +(define-mhandler (room-cmd-say room message phrase) + "Command: Say something to room participants." + (define player-name + (message-ref (<-wait room (message-from message) + 'get-name) 'val)) + (define message-to-send + (format #f "~a says: ~a\n" player-name phrase)) + (room-tell-room room message-to-send))