X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=c1e853689d81422e46fa07c5870bfdc7b9dacf70;hp=0ad886ceece07226a1dd508154c91c619535e4a1;hb=bbf45570e7dfe20e132cc8e4601ccbf2de667ff3;hpb=754bd427883ab189433fad90293e05d9aced2f70 diff --git a/mudsync/room.scm b/mudsync/room.scm index 0ad886c..c1e8536 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,7 +108,7 @@ (dyn-ref room (slot-ref exit 'to)) #f)) (define player-name - (msg-val (<-wait (message-from message) 'get-name))) + (mbody-val (<-wait (message-from message) 'get-name))) (cond (exit ;; Set the player's new location @@ -131,30 +134,12 @@ ;;; look commands -(define (list-words-as-string words) - "A little utility for listing a bunch of words in an English-style list" - ;; TODO: This could be made faster by traversing the O(n) - ;; list once, not twice - (let ((word-length (length words))) - (cond - ((eqv? word-length 0) "") - ((eqv? word-length 1) (car words)) - (else - ;; TODO: and this is NOT efficient - (string-append - (string-join - (drop-right words 1) - ", ") - " and " - (last words)))))) - (define (room-player-looks-around room player-id) "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 @@ -178,11 +163,13 @@ (if (eq? occupant-names-filtered '()) #f (format #f "You see here: ~a.\n" - (list-words-as-string occupant-names-filtered)))) + (string-join occupant-names-filtered + ", ")))) (define final-text (if occupant-names-string - (string-append room-text occupant-names-string) + `(,@room-text + (p (em ,occupant-names-string))) room-text)) (<- player-id 'tell @@ -202,7 +189,7 @@ (lambda (return) (for-each (lambda (occupant) - (msg-receive (_ #:key goes-by) + (mbody-receive (_ #:key goes-by) (<-wait occupant 'goes-by) (if (member called-this goes-by) (return occupant)))) @@ -221,13 +208,11 @@ (cond (matching-object (let ((obj-desc - (msg-val (<-wait matching-object 'get-desc + (mbody-val (<-wait matching-object 'get-desc #:whos-looking (message-from message))))) (if obj-desc - (<- (message-from message) 'tell - #:text (string-append obj-desc "\n")) - (<- (message-from message) 'tell - #:text (string-append %formless-desc "\n"))))) + (<- (message-from message) 'tell #:text obj-desc) + (<- (message-from message) 'tell #:text %formless-desc)))) (else (<- (message-from message) 'tell #:text "You don't see that here, so you can't look at it.\n")))) @@ -255,22 +240,22 @@ (define* (room-cmd-say room message #:key phrase) "Command: Say something to room participants." (define player-name - (msg-val (<-wait (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 (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 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