;;;;BRIAN DUNSTAN

(load ps5)
;;;;===========================================
;;;;EXTRA CREDIT:  THE BARTENDER (DR. SWINDLE)

;;;The inspriation for this particular project
;;;was experience with other programs designed
;;;to hold conversations, such as ELIZA.

;;;The character of the bartender is build upon
;;;four components: mood, excitedness, memory,
;;;and boredom (the last time he has heard from
;;;someone)
;;;all of these except memory are just numers...
;;;memor is a list of previously heard
;;;sentences, or a list of lists of symbols.

;;;with various combinations of good humor and
;;;excitedness, the bartender can be jovial,
;;;violent, depressed, rational,
;;;or even pleasantly intimate.

;;;he gives pick up lines, drinks, gives rounds
;;;on the house, asks thoughful questions of
;;;clients, or yells at them when they get too
;;;loud.

;;;he is sad when people leave and happy when
;;;they enter or emote something.  He likes a crowd.
;;;when no one says anything, he gets bored and
;;;picks his nose--or some such thing... Everything
;;;is based on combinations of random elements of
;;;word lists.


;;;;=================================
;;;;this section contains data that is useful for other
;;;;funtions--wordlists that give the bartender
;;;;something to say.

(define adj-list
  '(idiotic
    drunken
    smelly
    peckish
    frigid
    slimy
    ghoulish
    english
    zoroastrian
    commie))

(define adv-list
  '(foppishly
    sluttily
    kleptomaniacly
    cyclothematically))

(define relation-list
  '(son
    daughter
    cousin
    father
    mother
    worshipper))

(define noun-list
  '(molacca
    toad-squirrel
    newt
    female-pladypus
    neaderthal
    null-pointer
    malformed-letrec
    linker-error))

(define violent-act
  '(smites
    hits
    buggers
    bludgeons
    kills
    maims))


(define music
  '(bach
    beethoven
    alanis
    gregorian-chants
    rap
    hip-hop
    ragtime
    warchants
    elvis
    rolling-stones
    doors
    ragtime
    harpsichord
    mozart
    TMBG))

(define persuasive-act
  '(persuades
    cajoles
    forces
    coerces
    tricks
    charms
    engineers
    programs))

(define fools
  '(jukebox
    minstrels
    garbage-can
    broken-bottle
    clarinet
    viola
    tongo-drum
    barstool))

(define buzz-words
  '(set-bang
    lambda
    malformed-letrec
    swindle
    lisp
    prolog
    enclosure
    environment-model
    substitution-model
    defclass
    defgeneric
    object-oriented
    functional
    garbage-collector
    GUI))

(define silly-act
  '(befuddles
    blurgles
    sips
    partakes
    enjoys
    slurps
    uses
    glugs
    fliggels))

(define alcohol
  '(methyl
    ethyl
    vodka
    whiskey
    rum
    fortified-wine
    beer
    snapple))

(define body-parts
  '(chin
    kneebone
    ankle
    stomach
    head
    ears
    arms
    fingers
    toes
    adams-apple
    nose
    hair))

(define glum-adv
  '(unhappily
    dejectedly
    glumly
    soporifically
    phlegamtically
    dramatically
    unenthusiastically))

(define depressed-sentences
  '("If you don't mind, I think I'll just off and shoot myself."
    "Life, don't talk to me about Life!"
    "Time is an illusion, lunchtime doubly so."
    "Why won't anyone listen to me?"
    "Oh, Gawd, the Pressure!"
    "I'm going to eat the minstrels now."
    "You know... I was once in... the castle Antrax"
    "Where oh were is chr:amy?"
    "I could go on and on about malformed letrecs."))

(define pickup-lines
  '("Will you come over to my place"
    "Why don't we go outside... I know a nice quiet spot"
    "Would you like to see \"The Life of Brian\""
    "You know you want me"))


;;;=======================================
;;;This section brings an eliza-esque aspect
;;;to the bartender by giving him the ability
;;;to conjugate sentences and spit them back, so
;;;'(I am a trout) ==> (You are a trout).
;;;the funtion conjugate searches the list
;;;'conjugation and an input list and replaces
;;;elements in the input that are in the
;;;list 'conjugation' with their opposites...
;;;so are becomes am, were becomes was, or
;;;vice versa

(define conjugation
  '((are am)
    (were was)
    (you I)
    (your my)
    (my your)
    (I\'ve You\'ve)
    (I\'m You\'re)
    (me you)
    (us you)
    (we you)
    (these those)
    (thy my)
    (thee I)
    (thou I)
    (ye I)
    (art am)))

(define (conjugate list)
  (map (lambda (e)
         (let ((primary (filter
                         (lambda (g) (eq? (first g) e))
                         conjugation))
               (secondary (filter
                           (lambda (g) (eq? (second g) e))
                           conjugation)))
           (cond
             ((not (empty? primary)) (second (head primary)))
             ((not (empty? secondary)) (first (head secondary)))
             (else e)))) list))

;;;=========================
;;;this is something I hacked to gether at the very beginning,
;;;so it's a little rough.  Basically it uses recursive rules
;;;to put together insult nouns by combining adverbs, adjectives,
;;;and nouns, to produce other nouns. The result is a list.

(defgeneric (insult l))

(defmethod (insult (l <list>))
  (cond
    ((empty? l)
     (insult-noun adj-list adv-list relation-list noun-list))
    (else empty)))

(define (insult-noun adj-list adv-list relation-list noun-list)
  (let* ((adj (random-elt adj-list))
        (adv (random-elt adv-list))
        (relation? (< 0 (random 2)))
        (noun
         (if (or (< 0 (random 2)) relation?)
             (list (random-elt noun-list))
             (insult-noun
              adj-list adv-list relation-list noun-list)))
        (noun
         (if relation?
               (append
                (list (random-elt relation-list) 'of 'a )
                noun)
             noun)))
    (if (> 1 (random 3))
        (append! (list adj) noun)
        (append! (list adv adj) noun))))

;;;==================================
;;;this rather complicated code turns normal
;;;english expressions (in the form of lists of
;;;symbols) into piglatin.

;;;It does this by turning the lists of symbols
;;;into lists of characters, and then parsing
;;;the character lists (words) into their first
;;;set of consonants, and a remainder.

;;;the main function then replaces the sets
;;;of first consonants of adjacent words
;;;with each other, and combines the
;;;the character lists back into
;;;symbols.

;;;It was originally intended for use with
;;;the French Taunter, but time contrains
;;;prevented that, so now the bartender
;;;alone uses it.

;;this method determines if a given character at the head
;;of an arbitrary list is a vowel.  For the base five vowels,
;;this is easy--for 'y', vowel? checks to see if the the following
;;letter is a consonent.  If it is, the 'y' is considered a vowel.
(define (vowel? expr)
  (cond ((empty? expr) #f)
        ((or
          (equal? (head expr) #\a)
          (equal? (head expr) #\e)
          (equal? (head expr) #\i)
          (equal? (head expr) #\o)
          (equal? (head expr) #\u)
          (equal? (head expr) #\A)
          (equal? (head expr) #\E)
          (equal? (head expr) #\I)
          (equal? (head expr) #\O)
          (equal? (head expr) #\U))
         #t)
        ((or (equal? (head expr) #\y) (equal? (head expr) #\Y))
         (not (vowel? (tail expr))))
        (else #f)))

(define (latin->piglatin expr)
  (letrec* ((word->pair
             (lambda (word)
               (letrec* ((lst (string->list (symbol->string word)))
                         (crawl
                          (lambda (init remaining)
                            (if (not (vowel? remaining))
                                (crawl
                                 (append! init
                                          (list (head remaining)))
                                 (tail remaining))
                                (list init remaining)))))
                 (crawl empty lst))))
            (sentence-crawl
             (lambda (init remaining)
               (if (empty? remaining) init
               (let* ((word-one
                       (let ((result (head remaining)))
                         (set! init (append!
                                     init
                                     (list (head remaining))))
                         (set! remaining (tail remaining))
                         result))
                       (word-two
                        (if (empty? remaining)
                            (head init)
                            (let ((result (head remaining)))
                              (set! init (append!
                                          init
                                          (list (head remaining))))
                              (set! remaining (tail remaining))
                              result)))
                       (temp (head word-one)))
                 (set! (head word-one) (head word-two))
                 (set! (head word-two) temp)
                 (sentence-crawl init remaining))))))
            (map
             (lambda (wrd) (string->symbol (list->string wrd)))
             (map
              (lambda (lst) (append! (first lst) (second lst)))
              (sentence-crawl empty (map word->pair expr))))))



;;these two utilities convert between lists of symbols
;;(the internal representation of sentences)
;;and strings (input, output)
(define (symlist->string list)
  (letrec* ((l->str
             (lambda (str list)
               (if (empty? list) str
                   (l->str
                    (add " " (symbol->string (head list)) str)
                    (tail list))))))
    (l->str "" (reverse list))))

(define (string->symlist string)
  (letrec* ((char-list (string->list string))
            (crawl
             (lambda (word-list remaining)
               (cond
                 ((empty? remaining)
                  (set! (head word-list) (reverse (head word-list)))
                  word-list)
                 ((eq? (head remaining) #\space)
                  (set! (head word-list) (reverse (head word-list)))
                  (crawl (cons empty word-list)
                         (tail remaining)))
                 (else
                  (set! (head word-list) (cons
                                          (head remaining)
                                          (head word-list)))
                  (crawl word-list
                         (tail remaining)))))))
    (map string->symbol
         (map list->string
              (reverse (crawl (list empty) char-list))))))


(define (distance a b)
  (sqrt (+ (* a a) (* b b))))

(define (jitter n)
  (* n (/ (+ 50 (random 100)) 100)))



(define (act verb-list noun-list gender)
  (list
   (random-elt verb-list)
   (case gender
     ((m) 'his)
     ((f) 'her)
     ((n) 'its)
     ((t) 'their)
     (else 'their))
   (random-elt noun-list)))

(defclass <speaker> (<character>)
  (heard
   :type      <number>
   :accessor  heard
   :initarg   :heard
   :initvalue (current-time))
  (excitedness
   :type      <number>
   :accessor  excitedness
   :initarg   :excitedness
   :initvalue 0)
  (mood
   :type  <number>
   :accessor mood
   :initarg :mood
   :initvalue 0)
  (memory ;;list of things previously said
   :type  <list>
   :accessor memory
   :initarg :memory
   :initvalue (list '(I can\'t remember))))

(define speaker-plan
  (lambda (p)
    (let ((patrons (filter player? (contents (location p)))))
      (if (< 2 (length patrons))
          (set! (excitedness p) (+ 0.1 (excitedness p))))
      (set! (mood p) (jitter (mood p)))
      (set! (excitedness p) (jitter (excitedness p)))
      (cond
        ((< 7 (- (current-time) (heard p)))
         (begin
           (emote p (symlist->string (act silly-act body-parts 'm)))
           (set! (heard p) (- (current-time) 3))))

        ((> 3 (- (current-time) (heard p)))
         (cond
           ;DEPRESSED
           ((> 0.7 (jitter (distance (+ (excitedness p) 1)
                                     (+ (mood p) 1))))
            (if (zero? (random 2))
                (begin
                  (emote p (add (symbol->str (random-elt glum-adv))
                                (symlist->string
                                 (act drunken-act alcohol 'm))))
                  (set! (mood p) (+ (jitter 0.2) (mood p)))
                  (set! (excitedness p)
                        (+ (jitter 0.2) (excitedness p))))
                (say p (random-elt depressed-sentences))))
           ;THOUGHTFUL
           ((> 0.7 (jitter (distance (+ (excitedness p) 1)
                                     (- (mood p) 1))))
               (if (and (zero? (random 2)) (not (empty? patrons)))
                   (let ((victim (random-elt patrons)))
                     (tell victim
                           (add (random-elt pickup-lines) ", "
                                (name victim) "?")))
                   (say p (add
                           "It has been said that "
                           (symlist->string
                            (conjugate
                             (random-elt (memory p))))))))
           ;JOVIAL
           ((> 0.7 (jitter (distance (- (excitedness p) 1)
                                     (- (mood p) 1))))
               (if (zero? (random 2))
                   (shout p (add "A round of "
                                 (symbol->string (random-elt alcohol))
                                 ", on the House!!!"))
                   (emote p (add (symlist->string
                                  (act persuasive-act fools 'm))
                                 " to "
                                 (symlist->string
                                  (list 'play
                                        (random-elt music)))))))
           ;VIOLENT
           ((> 0.7 (jitter (distance (- (excitedness p) 1)
                                     (+ (mood p) 1))))
               (if (zero? (random 2))
                   (shout p (add "What "
                                 (symlist->string (insult empty))
                                 " said that "
                                 (symlist->string
                                  (conjugate
                                   (random-elt (memory p))))))
                   (begin
                     (emote p (symlist->string
                               (act violent-act fools 'm)))
                     (set! (mood p) (+ 0.3 (mood p)))
                     (set! (excitedness p)
                           (- 0.3 (excitedness p))))))
           ;NORMAL/RATIONAL
           (else
            (if (zero? (random 2))
                (say p (symlist->string (latin->piglatin
                                         (random-elt (memory p)))))
                (say p (add
                        "Hmmm, why do you thing that "
                        (symlist->string (first (memory p)))))))))
        (else (say p "..."))))
    1))


(defmethod (message (l <speaker>) (from <animate>)
                    (type <symbol>) (msg <string>))
  (begin
    (set! (heard l) (current-time))
    (case type
      ((say)   (set! (memory l)
                     (cons (string->symlist msg)
                           (memory l))))
      ((emote) (set! (excitedness l) (+ 0.1 (excitedness l))))
      ((shout) (begin
                 (set! (excitedness l) (+ 0.3 (excitedness l)))
                 (set! (mood l) (- 0.3 (mood l)))
                 (set! (memory l)
                      (cons (string->symlist msg)
                            (memory l)))))
        ((tell)  (begin
                 (set! (excitedness l) (+ 0.1 (excitedness l)))
                 (set! (mood l) (+ 0.1 (mood l)))
                 (set! (memory l)
                      (cons (string->symlist msg)
                            (memory l)))))
      ((enter) (begin
                 (say l "Come in! Somtimes a man will tell his")
                 (say l "bartender things he'll never tell his")
                 (say l "Doctor!")
                 (set! (excitedness l) (+ 0.1 (excitedness l)))
                 (set! (mood l) (+ 0.3 (mood l)))))
      ((leave)
       (begin
         (say l "Awww, don't leave now...")
         (set! (excitedness l) (- 0.3 (excitedness l)))
         (set! (mood l) (- 0.3 (mood l)))))
        (else msg))))

(define chr:bartender
  (make <speaker>
        :nick 'bartender
        :name "Doctor Swindle"
        :location loc:pub
        :plan speaker-plan))