X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=6baea54ce99daef1d83e8b0440de2fb0ef8a4f5e;hp=10932c9314fa3ff9e3b2bb7285e57ac6e562ddee;hb=29f902827724fd50b512c60916a16850367f6046;hpb=4d1280ec16d7645817bf741cde658e358de66327 diff --git a/mudsync/room.scm b/mudsync/room.scm index 10932c9..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,10 +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-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)) @@ -227,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) @@ -257,3 +257,34 @@ claim to point to." (else (<- room (message-from message) 'tell #:text "You don't see that here, so you can't look at it.\n")))) + + +(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 + <-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))