X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=6baea54ce99daef1d83e8b0440de2fb0ef8a4f5e;hp=a84550d630c726f7e6588d63a740d4d07bfed0ef;hb=29f902827724fd50b512c60916a16850367f6046;hpb=d198683d31a3b359e26cc688cc04cebc8ca978c6 diff --git a/mudsync/room.scm b/mudsync/room.scm index a84550d..6baea54 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -71,7 +71,8 @@ (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,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)) @@ -225,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) @@ -244,7 +246,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 +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))