X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=c1e853689d81422e46fa07c5870bfdc7b9dacf70;hp=aaedd5ce6a15ff5297f3157aa7f52712b82cae65;hb=bbf45570e7dfe20e132cc8e4601ccbf2de667ff3;hpb=ed1ef3172af4c2621e2b746824b7defa6f0dcedd diff --git a/mudsync/room.scm b/mudsync/room.scm index aaedd5c..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 () @@ -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 @@ -224,10 +211,8 @@ (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")))) @@ -257,7 +242,7 @@ (define player-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) @@ -265,7 +250,7 @@ (define player-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)