X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=0b0e10108411c0aa1086cfd682a346c51149e43c;hp=a84550d630c726f7e6588d63a740d4d07bfed0ef;hb=902b52f87ea65d6a52cb84afee32ad20d89b2bc3;hpb=d198683d31a3b359e26cc688cc04cebc8ca978c6 diff --git a/mudsync/room.scm b/mudsync/room.scm index a84550d..0b0e101 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -71,7 +71,9 @@ (loose-direct-command "look" 'cmd-look-at) (empty-command "look" 'cmd-look-room) (empty-command "go" 'cmd-go-where) - (loose-direct-command "go" 'cmd-go))) + (loose-direct-command "go" 'cmd-go) + ;; (greedy-command "say" 'cmd-say) + )) (define room-actions (build-actions @@ -81,6 +83,7 @@ (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)) ;; in this case the command is the same version as the normal ;; look-room version (cmd-look-room (wrap-apply room-look-room)) @@ -244,7 +247,8 @@ claim to point to." (matching-object (let ((obj-desc (message-ref - (<-wait room matching-object 'get-desc) + (<-wait room matching-object 'get-desc + #:whos-looking (message-from message)) 'val))) (if obj-desc (<- room (message-from message) 'tell @@ -254,3 +258,19 @@ 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-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 who-to-tell (gameobj-occupants room #:exclude exclude)) + (for-each + (lambda (tell-me) + ;; @@: Does anything really care? + (define deliver-method + (if wait-delivery + <-wait + <-)) + (deliver-method room tell-me 'tell + #:text text)) + who-to-tell))