X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=8dc1d847fa6637d654eb4e729a62486382e9c00e;hp=efb52d828e96efeda3c5d12e3ace6262f5f22b40;hb=6f7c1d4f9a2043c16f83facef6b3216e45e14f40;hpb=c8c47c9d61abd219f561c020e9147d715717a16f diff --git a/mudsync/room.scm b/mudsync/room.scm index efb52d8..8dc1d84 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -66,7 +66,10 @@ (empty-command "go" 'cmd-go-where) (loose-direct-command "go" 'cmd-go) (greedy-command "say" 'cmd-say) - (greedy-command "emote" 'cmd-emote))) + (greedy-command "\"" 'cmd-say) + (greedy-command "'" 'cmd-say) + (greedy-command "emote" 'cmd-emote) + (greedy-command "/me" 'cmd-emote))) ;; TODO: Subclass from container? (define-class () @@ -105,28 +108,28 @@ (dyn-ref room (slot-ref exit 'to)) #f)) (define player-name - (msg-val (<-wait room (message-from message) 'get-name))) + (mbody-val (<-wait (message-from message) 'get-name))) (cond (exit ;; Set the player's new location - (<-wait room (message-from message) 'set-loc! + (<-wait (message-from message) 'set-loc! #:loc to-address) ;; Tell everyone else the person walked away (room-tell-room room (format #f "~a wanders ~a.\n" player-name direct-obj)) - (<- room to-address 'announce-entrance + (<- to-address 'announce-entrance #:who-entered (message-from message)) ;; Have the new room update the player to the new location - (<- room to-address 'look-room + (<- to-address 'look-room #:to-id (message-from message))) (else - (<- room (message-from message) 'tell + (<- (message-from message) 'tell #:text "You don't see any way to go there.\n")))) (define (room-cmd-go-where room message) - (<- room (message-from message) 'tell + (<- (message-from message) 'tell #:text "Go where?\n")) ;;; look commands @@ -152,15 +155,14 @@ "Handle looking around the room" ;; Get the room text (define room-text - (format #f "**~a**\n~a\n" - (slot-ref room 'name) - (slot-ref room 'desc))) + `((strong "=> " ,(slot-ref room 'name) " <=") + (p ,(slot-ref room 'desc)))) ;; Get a list of other things the player would see in the room (define occupant-names-all (map (lambda (occupant) - (call-with-message (<-wait room occupant 'visible-name + (call-with-message (<-wait occupant 'visible-name #:whos-looking player-id) (lambda* (_ #:key text) text))) @@ -182,10 +184,11 @@ (define final-text (if occupant-names-string - (string-append room-text occupant-names-string) + `(,@room-text + (p (em ,occupant-names-string))) room-text)) - (<- room player-id 'tell + (<- player-id 'tell #:text final-text)) @@ -202,8 +205,8 @@ (lambda (return) (for-each (lambda (occupant) - (msg-receive (_ #:key goes-by) - (<-wait room occupant 'goes-by) + (mbody-receive (_ #:key goes-by) + (<-wait occupant 'goes-by) (if (member called-this goes-by) (return occupant)))) (hash-map->list (lambda (key val) key) @@ -221,15 +224,15 @@ (cond (matching-object (let ((obj-desc - (msg-val (<-wait room matching-object 'get-desc + (mbody-val (<-wait matching-object 'get-desc #:whos-looking (message-from message))))) (if obj-desc - (<- room (message-from message) 'tell + (<- (message-from message) 'tell #:text (string-append obj-desc "\n")) - (<- room (message-from message) 'tell + (<- (message-from message) 'tell #:text (string-append %formless-desc "\n"))))) (else - (<- room (message-from message) 'tell + (<- (message-from message) 'tell #:text "You don't see that here, so you can't look at it.\n")))) @@ -242,7 +245,7 @@ (if wait <-wait <-)) - (deliver-method room tell-me 'tell + (deliver-method tell-me 'tell #:text text)) who-to-tell)) @@ -255,24 +258,22 @@ (define* (room-cmd-say room message #:key phrase) "Command: Say something to room participants." (define player-name - (msg-val (<-wait room (message-from message) - 'get-name))) + (mbody-val (<-wait (message-from message) 'get-name))) (define message-to-send - (format #f "~a says: ~a\n" player-name phrase)) + `((b "<" ,player-name ">") " " ,phrase)) (room-tell-room room message-to-send)) (define* (room-cmd-emote room message #:key phrase) "Command: Say something to room participants." (define player-name - (msg-val (<-wait room (message-from message) - 'get-name))) + (mbody-val (<-wait (message-from message) 'get-name))) (define message-to-send - (format #f "* ~a ~a\n" player-name phrase)) + `((b "* " ,player-name) " " ,phrase)) (room-tell-room room message-to-send)) (define* (room-announce-entrance room message #:key who-entered) (define player-name - (msg-val (<-wait room who-entered 'get-name))) + (mbody-val (<-wait who-entered 'get-name))) (define message-to-send (format #f "~a enters the room.\n" player-name)) (room-tell-room room message-to-send