;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                             Emotions                             ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (get-possessive (animate <animate>))
  (if (gender animate) "her" "his"))

(define (get-objective (animate <animate>))
  (if (gender animate) "her" "him"))

(define (get-pronoun (animate <animate>))
  (if (gender animate) "She" "He"))

;;; So.. currently we have:
;;; smile beam shake nod fruit huggle
;;; frown love bug growl ruffle
;;; snuggle tickle

;;;(place-message
;;; (some <place>)    ; The place where all animates get the message
;;; (filtered <list>) ; The list of animates that don't get the message
;;;                   ; You could also just pass in an animate object
;;;                   ; if you need to filter out only one thing.
;;;                   ; Pass in #f if you want everyone to get the
;;                    ; message
;;; (type <symbol>)   ; You'll probably use #f (this just prints your
;;;                   ; message without any alteration. The other types
;;;                   ; aren't important - you can just use the tell,
;;;                   ; shout, say methods...
;;; (msg <string>))   ; The message that you print to the screen

(define (add-emote-command symbol helpstr func)
  (add-player-command
   'emotions
   (list :or (list symbol) (list symbol symbol?))
   (echos-ns symbol " [<player>] " helpstr)
   (lambda (plyr inp)
     (let* ((length (length inp))
            (target (and (= length 2)
                         (nick-find (second inp)
                                    (contents (location plyr))))))
       (if (or (not target) (animate? target))
         (func plyr target)
         (echos "There is no one named" (second inp)
                "in the vicinity."))))))

;;; Beaming, for all the bright cs212 students.
(add-emote-command 'beam "   Beaming!"
 (lambda (plyr target)
   (cond ((not target)
          (place-message (location plyr) plyr #f
                         (echos (name plyr) "beams happily."))
          "You beam happily.")
         ((eq? plyr target)
          "Uh, you beam at yourself.")
         (else
          (tell target (echos (name plyr) "beams happily at you."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " beams happily at "
                                   (name target) "."))
          (echos-ns "You beam happily at " (name target) ".")))))

;;; Smiling
(add-emote-command 'smile "  Showing those dimples of yours."
 (lambda (plyr target)
   (cond ((not target)
          (place-message (location plyr) plyr #f
                         (echos (name plyr) "smiles brightly."))
          "You smile brightly.")
         ((eq? plyr target)
          "You smile at yourself?")
         (else
          (tell target (echos (name plyr)
                              "gives you a bright smile."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                  " smiles brightly at "
                                  (name target) "."))
          (echos-ns "You smile brightly at " (name target) ".")))))

;;; Nodding
(add-emote-command 'nod "    Nodding at someone."
 (lambda (plyr target)
   (cond ((not target)
          (place-message (location plyr) plyr #f
                         (echos (name plyr) "nods."))
          "You nod.")
         ((eq? target plyr)
          "You nod at yourself.")
         (else
          (tell target (echos (name plyr) "nods at you."))
          (place-message (location plyr) (list plyr target) #f
                         (echos (name plyr)
                                "nods at"  (name target)))
          (echos-ns "You nod at " (name target) ".")))))

;;; Shaking head
(add-emote-command 'shake "  Shaking head at someone."
 (lambda (plyr target)
   (cond ((not target)
          (place-message (location plyr) plyr #f
                         (echos (name plyr) "shakes"
                                (get-possessive plyr)
                                "head."))
          "You shake your head.")
         ((eq? plyr target)
          "Right. You shake your head at yourself.")
         (else
          (tell target (echos (name plyr) "shakes"
                              (get-possessive plyr)
                              "head at you."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " shakes "
                                   (get-possessive plyr)
                                   " head at "
                                   (name target) "."))
          (echos-ns "You shake your head at " (name target) ".")))))

;;; Fruitting.  Because carson said so.
(add-emote-command 'fruit "  You fruit someone."
 (lambda (plyr target)
   (cond ((not target)
          "Nuh uh, you need to fruit someone.")
         ((eq? plyr target)
          "No fruitting yourself!")
         (else
          (tell target (echos (name plyr)
                              "fruits you! You are the victim"
                              "of a drive-by fruitting."))
          (place-message
           (location plyr) (list plyr target) #f
           (echos-ns (name plyr)
                     " fruits "
                     (name target)
                     "! "
                     (name target)
                     " is the victim of a drive-by fruitting."))
          (echos-ns "You fruit " (name target) "!")))))

;;; Huggles.  Nadine likes huggles.
(add-emote-command 'huggle " Huggling someone you like."
 (lambda (plyr target)
   (cond ((not target)
          "Huggles require a target.")
         ((eq? plyr target)
          "Huggles must be shared!")
         (else
          (tell target
                (echos (name plyr)
                       "huggles you. You feel warm and contented."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " huggles "
                                   (name target)
                                   ". They both look very contented."))
          (echos-ns "You huggle " (name target) " warmly.")))))

;;; Frowning
(add-emote-command 'frown "  When all is not right with the world."
 (lambda (plyr target)
   (cond ((not target)
          (place-message (location plyr) plyr #f
                         (echos (name plyr) "furrows"
                                (get-possessive plyr)
                                "brow in a frown."))
          "You furrow your brows in a frown.")
         ((eq? plyr target)
          "You frown at yourself.")
         (else
          (tell target (echos (name plyr) "frowns at you."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " frowns at "
                                   (name target) "."))
          (echos-ns "You frown at " (name target) ".")))))

;;; Love
(add-emote-command 'love "   All the world needs more.."
 (lambda (plyr target)
   (cond ((not target)
          "Who are you gonna love?")
         ((eq? plyr target)
          "You love yourself. Good for ya.")
         (else
          (tell target
                (echos (name plyr)
                       "whispers sweet words of love to you."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " whispers sweet words of love to "
                                   (name target) "."))
          (echos-ns "You whisper sweet words of love to "
                    (name target)
                    ".")))))

;;; Bug.
(add-emote-command 'bug "    Bug someone."
 (lambda (plyr target)
   (cond ((not target)
          "Too bad.")
         ((eq? plyr target)
          "You bug yourself.")
         (else
          (tell target (echos-ns (name plyr)
                                 " bugs you. You swat annoyedly at "
                                 (get-objective plyr) "."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " bugs " (name target) ". "
                                   (get-pronoun target)
                                   " swats annoyedly at "
                                   (name plyr) "."))
          (echos-ns "You bug " (name target) ". "
                    (get-pronoun target) " swats annoyedly at you.")))))

;;; Growl
(add-emote-command 'growl "  Growling at someone."
 (lambda (plyr target)
   (cond ((not target)
          (place-message (location plyr) plyr #f
                         (echos (name plyr) "growls fiercely."))
          "You growl fiercely.")
         ((eq? plyr target)
          "Maybe you need to step away from the computer.")
         (else
          (tell target (echos (name plyr) "growls fiercely at you."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " growls fiercely at "
                                   (name target) "."))
          (echos-ns "You growl fiercely at " (name target) ".")))))

;;; Ruffle
(add-emote-command 'ruffle " You know, ruffling people."
 (lambda (plyr target)
   (cond ((not target)
          (place-message (location plyr) plyr #f
                         (echos (name plyr) "make ruffling noises."))
          "You make ruffling noises.")
         ((eq? plyr target)
          "You ruffle your hair.")
         (else
          (tell target
                (echos (name plyr) "ruffles your hair playfully."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " ruffles "
                                   (name target)
                                   "'s hair playfully."))
          (echos-ns "You ruffle " (name target) "'s hair playfully.")))))

;;; Snuggles are good too.
(add-emote-command 'snuggle "Snuggles are a good thing."
 (lambda (plyr target)
   (cond ((not target)
          "Snuggles require a target.")
         ((eq? plyr target)
          "Snuggles must be shared!")
         (else
          (tell target (echos (name plyr) "snuggles you."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " snuggles "
                                   (name target) "."))
          (echos-ns "You snuggle " (name target) ".")))))

;;; Tickle
(add-emote-command 'tickle " Tickling someone."
 (lambda (plyr target)
   (cond ((not target)
          "Who do you want to tickle?")
         ((eq? plyr target)
          "Eh, ok. You tickle yourself.")
         (else
          (tell target (echos (name plyr) "tickles you playfully."))
          (place-message (location plyr) (list plyr target) #f
                         (echos-ns (name plyr)
                                   " tickles "
                                   (name target)
                                   " playfully."))
          (echos-ns "You tickle " (name target) " playfully.")))))