;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commands ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Reminder (see input.ss) : a command has three parts: ;;; - a specification list that holds Scheme values or predicates, ;;; or a predicate that will be called on the whole input string, ;;; or a list that starts with :or and then specs lists; ;;; - a help string; ;;; - a function that will be applied on the player and the input ;;; list, and returns: ;;; - #f means that there shouldn't be another input event ;;; - a string will be printed and a new input will be read ;;; immediately (usually used to indicate input errors). ;;; - a number is the delay until the next input event. ;;; - any other result means use the default delay until the next ;;; input, should be #t (other values might be used differently). ;;; Show help on all commands. (add-player-command '(:or "help" "h") "help get the list of available commands" (lambda (plyr inp) (tell plyr "") (tell plyr "Available commands ( are arguments):") (for-each (lambda (command) (unless (equal? "" (cmd-desc command)) (tell plyr (echos-ns " | " (cmd-desc command))))) (commands plyr)) ;; returned value must be a string to read another input "So, what will it be?")) ;;; Wait and do nothing. (add-player-command '(:or "wait" "w" "nop") "wait do nothing" (lambda (plyr inp) (let ((strs (random-elt '(("You wait... Time passes..." "More time passes...") ("You spend some time trying to catch flies." "Hey, just caught a fly!") ("You kill time thinking about the meaning of life." "You found the meaning of life too complicated.") ("You take some time to admire the view." "What a lovely view...."))))) (insert-immediate-event (lambda () (tell plyr (first strs)))) (insert-event 1.5 (lambda () (tell plyr (second strs))))) ;; wait 2 seconds until next input 2)) ;;; See what time is it in the game: seconds since startup. (add-player-command (list :or '(t) '(time)) "time see what is the server time (secs since started)" (lambda (plyr inp) ;; this is a little long, but it just shows the time (let* ((add0 (lambda (n) (if (< n 10) (string-append "0" (number->string n)) (number->string n)))) (curt (as (current-time))) (secs (modulo curt 60)) (mins (modulo (quotient curt 60) 60)) (hours (quotient curt 3600))) (string-append "The time is: " (if (zero? hours) "" (echos-ns hours ":")) (add0 mins) ":" (add0 secs))))) ;;; Look around. (add-player-command (list :or '(l) '(look) (list 'l symbol?) (list 'look symbol?)) "look [] look around or at something" (lambda (plyr inp) (define (describe x) (for-each (lambda (x) (tell plyr (add " " x))) (description x))) (let* ((what (and (= 2 (length inp)) (second inp))) (place (nick-find what (exits (location plyr)))) (thing (nick-find what (contents (location plyr)))) (held (nick-find what (contents plyr)))) (cond ((or (= 1 (length inp)) (eq? (second inp) 'around)) ;; temporarily delete the visited places for a full description (let ((tmp (visited-places plyr))) (set! (visited-places plyr) '()) (describe-location (location plyr) plyr) (set! (visited-places plyr) tmp))) (place (tell plyr (echos-ns "You look there and see " (name+nick place) ":")) (describe place)) (thing (tell plyr (echos-ns "You see " (name+nick thing) ":")) (describe thing)) (held (tell plyr (echos-ns "You are holding " (name+nick held) ":")) (describe held)) (else (tell plyr (random-elt '("You don't see it." "It is not here.")))))) ;; next input is immediate 0)) ;; See what you have. (add-player-command (list :or '(i) '(inventory)) "inventory see what you are carrying" (lambda (plyr inp) (let ((stuff (map name+nick (contents plyr)))) (if (null? stuff) (tell plyr "You have nothing!") (begin (tell plyr "Here is what you have:") (for-each (lambda (x) (tell plyr (add " " x))) stuff)))) 0)) ;;; Go somewhere. (add-player-command (list :or '(g) '(go) (list 'go symbol?) (list 'g symbol?) (list 'go 'to symbol?) (list 'go 'to 'the symbol?)) "go go somewhere (`back' goes back if possible)" (lambda (plyr inp) ;; in all input forms, the target is always last (let ((target (nick-find (last inp) (exits (location plyr))))) (cond (target (transfer plyr (location plyr) target)) ((null? (exits (location plyr))) ;; no exits at all - return a message (random-elt '("There is no way to exit this place." "You're stuck here." "Hahahahahaaaaa..."))) ((eq? 'back (last inp)) (if (and (>= (length (visited-places plyr)) 2 ) (memq (second (visited-places plyr)) (exits (location plyr)))) (begin (transfer plyr (location plyr) (second (visited-places plyr))) #t) (echos "Can't go back."))) ((= (length inp) 1) (echos "Possible exits are:" (map nick (exits (location plyr))))) (else ;; no such place - return a message (random-elt (let ((exits (map nick (exits (location plyr))))) (list (echos "You look around, but" (last inp) "is not around, only" exits) (echos "You can only go to one of" exits "from here.") (echos "Try one of" exits "..." "where the hell is" (last inp) "anyway?") (echos "You try to imagine" (last inp) "and go there, but it doesn't work!"))))))))) ;;; Take something. (add-player-command (list :or '(take) '(get) (list 'take symbol?) (list 'get symbol?) (list 'take 'the symbol?) (list 'get 'the symbol?)) "take take some object (can also use get)" (lambda (plyr inp) ;; in all input forms, the object is always last (let* ((objects (filter inanimate? (contents (location plyr)))) (object (nick-find (last inp) objects))) (cond (object (insert-immediate-event (lambda () (transfer object (location plyr) plyr))) #t) ((null? objects) "There is nothing to take.") ((= (length inp) 1) (echos "Possible objects are:" (map nick objects))) (else ;; no such object - return a message (random-elt (let ((objects (map nick objects))) (list (echos "You look around, but you don't see any" (last inp) "only" objects) (echos "You can only take one of" objects "from here.") (echos "Try one of" objects "...") (echos "You try to imagine" (last inp) "and take it, but it doesn't work!"))))))))) ;;; Drop something. (add-player-command (list :or (list 'drop symbol?) (list 'put symbol?) (list 'drop 'the symbol?) (list 'put 'the symbol?)) "drop drop some object (can also use put)" (lambda (plyr inp) ;; in all input forms, the object is always last (let ((object (nick-find (last inp) (contents plyr)))) (cond (object (insert-immediate-event (lambda () (transfer object plyr (location plyr)))) #t) ((contents plyr) "You have nothing to drop.") (else ;; no such object - return a message (random-elt (let ((objects (map nick (contents plyr)))) (list (echos "You empty your pockets, but you don't find" (last inp)) (echos "You only have one of" objects) (echos "Try one of" objects "...") (echos "You try to imagine that you have" (last inp) "and drop it, but it doesn't work!"))))))))) ;;; Give something. (add-player-command (list :or (list 'give symbol? symbol?) (list 'give symbol? 'to symbol?)) "give give an object to someone (also \"give s to p\")" (lambda (plyr inp) (let* ((alt? (= (length inp) 4)) ; check the inp form used (p2nick (if alt? (fourth inp) (second inp))) (objnick (if alt? (second inp) (third inp))) (plyr2 (nick-find p2nick (filter animate? (contents (location plyr))))) (obj (nick-find objnick (contents plyr)))) (cond ((and plyr2 obj (not (eq? plyr plyr2))) (insert-immediate-event (lambda () (transfer obj plyr plyr2))) #t) ((eq? plyr plyr2) "You give it to yourself and say thanks...") ((not obj) (echos "You don't have" objnick)) ((not (nick-find p2nick *players*)) "There is no such player.") ((not plyr2) (echos "You don't see" p2nick "here")))))) ;;; Add a "who" command - shows the list of currently player. (add-player-command "who" "who display the names of all current players." (lambda (plyr inp) (let ((players (remq plyr *players*))) (if (null? players) (tell plyr (random-elt '("There is no one else connected." "You are all alone." "It's only you and the mosquitos."))) (begin (tell plyr "These are the current (other) players:") (for-each (lambda (x) (tell plyr (add " " (name+nick x)))) players))) 0))) ;;; Say something. (add-player-command (list 'say string?) "say say something to everyone close (use a string)." (lambda (plyr inp) (say plyr (second inp)) #t)) (add-player-command (lambda (s) (and (> (string-length s) 1) (eq? (string-ref s 0) #\:))) ":... a shortcut for `say' (no need for quotes)." (lambda (plyr inp) (say plyr (truncate-string (substring inp 1 (string-length inp)))) #t)) ;;; Emote somethig. (add-player-command (list 'emote string?) "emote emote something (try and see what it does)." (lambda (plyr inp) (emote plyr (second inp)) #t)) (add-player-command (lambda (s) (and (> (string-length s) 1) (eq? (string-ref s 0) #\;))) ";... a shortcut for `emote' (no need for quotes)." (lambda (plyr inp) (emote plyr (truncate-string (substring inp 1 (string-length inp)))) #t)) ;;; Shout something. (add-player-command (list 'shout string?) "shout [] shout something to everyone in the game." (lambda (plyr inp) (shout plyr (second inp)) #t)) (add-player-command (lambda (s) (and (> (string-length s) 1) (eq? (string-ref s 0) #\!))) "!... a shortcut for `shout' (no need for quotes)." (lambda (plyr inp) (shout plyr (truncate-string (substring inp 1 (string-length inp)))) #t)) ;;; Tell something to someone specific. (add-player-command (list 'tell symbol? string?) "tell tell something to any specific player." (lambda (plyr inp) ;; look for any player or any character in the same place (let ((other (or (nick-find (second inp) *players*) (nick-find (second inp) (filter (lambda (x) (instance-of? x )) (contents (location plyr))))))) (if other (begin (message other plyr 'tell (third inp)) "Said.") "No such player is logged on.")))) ;;; Fight another character. (add-player-command (list 'fight symbol?) "fight fight someone." (lambda (plyr inp) (let ((other (nick-find (second inp) (filter (lambda (x) (or (animate? x) (instance-of? x ))) (contents (location plyr)))))) (if (and other (not (eq? other plyr))) (fight plyr other) (echos "Couldn't find" (second inp)))))) ;;; Quit the game. (add-player-command '(quit) "quit quit the game immediately." (lambda (plyr inp) (kill plyr)))