;;;                  MASSACHVSETTS INSTITVTE OF TECHNOLOGY
;;;        Department of Electrical Engineering and Computer Science
;;;        6.001---Structure and Interpretation of Computer Programs
;;;                           Spring Semester, 1997
;;;                              Problem Set 7 
;;;
;;;                         Code file GAME.SCM


;;; ----------------------------------------------------------------------------

;;; Implementation of people

(define (other-people-at-place person place)
  ;; Used by MAKE-PERSON and MAKE-TROLL
  (find-all-other place 'PERSON? person))

(define (make-person name birthplace laziness)
  ;; Laziness determines how often the person will move
  (let ((mobile-obj  (make-mobile-object name birthplace))
        (possessions '()))
    (install-shield
     (lambda (message)
       (case message
         ((PERSON?) (lambda (self) true))
         ((INSTALL)
          (lambda (self)
            (add-to-clock-list self)
            (delegate mobile-obj self 'INSTALL)))
         ((POSSESSIONS) (lambda (self) possessions))
         ((LIST-POSSESSIONS)
          (lambda (self)
            (let ((my-stuff (ask self 'POSSESSIONS)))
              (ask self 'SAY
                   (cons "I have"
                         (if (null? my-stuff)
                             '("nothing")
                             (map (lambda (p) (ask p 'NAME))
                                  my-stuff))))
              my-stuff)))
         ((SAY)
          (lambda (self list-of-stuff)
            (display-message
             (append (list "At" (ask (ask self 'LOCATION) 'NAME)
                           ":"  name "says --")
                     (if (null? list-of-stuff)
                         '("Oh, nevermind.")
                         list-of-stuff)))
            'said))
         ((HAVE-FIT)
          (lambda (self)
            (ask self 'SAY '("Yaaaah! I am upset!"))
            'I-feel-better-now))
         ((LOOK-AROUND)
          (lambda (self)
            (let ((other-things
                   (map (lambda (thing) (ask thing 'NAME))
                        (delq self ;; DELQ
                              (ask (ask self 'LOCATION) ;; defined
                                   'THINGS))))) ;; below
              (ask self 'SAY (cons "I see" (if (null? other-things)
                                               '("nothing")
                                               other-things)))
              other-things)))
         

         ((TAKE)
          (lambda (self thing)
            (cond ((memq thing possessions)
                   (ask self 'SAY
                        (list "I already have" (ask thing 'NAME)))
                   true)
                  ((and (let ((things-at-place
                               (ask (ask self 'LOCATION) 'THINGS)))
                          (memq thing things-at-place))
                        (ownable? thing))
                   (if (ask thing 'OWNED?)
                       (let ((owner (ask thing 'OWNER)))
                         (ask owner 'LOSE thing)
                         (ask owner 'HAVE-FIT))
                       'unowned)
                   (ask thing 'SET-OWNER! self)
                   (set! possessions (cons thing possessions))
                   (ask self 'SAY
                        (list "I take" (ask thing 'NAME)))
                   true)
                  (else
                   (display-message
                    (list "You cannot take" (ask thing 'NAME)))
                   false))))
         ((LOSE)
          (lambda (self thing)
            (if (eq? self (ask thing 'OWNER))
                (begin
                  (set! possessions (delq thing possessions))
                  (ask thing 'SET-OWNER! 'NOBODY)
                  (ask self 'SAY
                       (list "I lose" (ask thing 'NAME)))
                  true)
                (begin
                  (display-message (list name "does not own"
                                         (ask thing 'NAME)))
                  false))))
         ((CLOCK-TICK)
          (lambda (self)
            (if (= (random laziness) 0)
                (ask self 'ACT)
                false)))
         ((ACT)
          (lambda (self)
            (let ((new-place (random-neighbor (ask self 'LOCATION))))
              (if new-place
                  (ask self 'MOVE-TO new-place)
                  false))))             ; All dressed up and no place to go
         

         ((MOVE-TO)
          (lambda (self new-place)
            (let ((old-place (ask self 'LOCATION))
                  (my-stuff (ask self 'POSSESSIONS)))
              (define (greet-people person people)
                (if (not (null? people))
                    (ask person 'SAY
                         (cons "Hi"
                               (map (lambda (p) (ask p 'NAME))
                                    people)))
                    'sure-is-lonely-in-here))
              (cond ((eq? new-place old-place)
                     (display-message (list name "is already at"
                                            (ask new-place 'NAME)))
                     false)
                    ((is-a new-place 'PLACE?)
                     (ask self 'CHANGE-LOCATION new-place)
                     (for-each
                      (lambda (p) (ask p 'CHANGE-LOCATION new-place))
                      my-stuff)
                     (display-message
                      (list name "moves from" (ask old-place 'NAME)
                            "to" (ask new-place 'NAME)))
                     (greet-people self
                                   (other-people-at-place self new-place))
                     true)
                    (else
                     (display-message (list name "can't move to"
                                            (ask new-place 'NAME))))))))
         ((GO)
          (lambda (self direction)
            (let ((old-place (ask self 'LOCATION)))
              (let ((new-place (ask old-place 'NEIGHBOR-TOWARDS direction)))
                (if new-place
                    (ask self 'MOVE-TO new-place)
                    (begin
                      (display-message
                       (list "You cannot go" direction
                             "from" (ask old-place 'NAME)))
                      false))))))
         (else (get-method message mobile-obj)))))))

(define make&install-person (installer make-person))


;;; A troll is a kind of person (but not a kind person!)

(define (make-troll name birthplace laziness)
  (let ((person (make-person name birthplace laziness)))
    (install-shield
     (lambda (message)
       (case message
         ((TROLL?) (lambda (self) #T))
         ((ACT)
          (lambda (self)
            (let ((others (other-people-at-place
                           self (ask self 'LOCATION))))
              (if (not (null? others))
                  (ask self 'EAT-PERSON (pick-random others))
                  (delegate person self 'ACT)))))
         ((EAT-PERSON)
          (lambda (self person)
            (ask self 'SAY
                 (list "Growl.... I'm going to eat you,"
                       (ask person 'NAME)))
            (go-to-heaven person)
            (ask self 'SAY
                 (list "Chomp chomp." (ask person 'NAME)
                       "tastes yummy!"))
            '*burp*))
         (else (get-method message person)))))))

(define make&install-troll (installer make-troll))


(define (go-to-heaven person)
  (for-each (lambda (item) (ask person 'LOSE item))
            (ask person 'POSSESSIONS))
  (ask person 'SAY
       '("
                   Grendel, now be still,
                   I kill'd not thee with half so good a will."
         ))
  (ask person 'MOVE-TO heaven)
  (remove-from-clock-list person)
  'GAME-OVER-FOR-YOU-DUDE)

(define heaven (make&install-place 'HEAVEN)) ; The point of no return


(define (make-rich-person name birthplace laziness)
  (let ((my-poor-person (make-person name birthplace laziness))
        (hailing? #F))
    (install-shield
     (lambda (message)
       (case message
         ((RICH-PERSON?) (lambda (self) #T))
         ((HAIL-TAXI)
          (lambda (self)
            (set! hailing? #T)
            (let ((taxis (find-all (ask self 'LOCATION) 'EMPTY-TAXI?)))
              (if (null? taxis)
                  'NO-TAXI-HERE
                  (let ((my-taxi (pick-random taxis)))
                    (let ((dest (pick-random *ALL-BUILDINGS*)))
                      'you-have-to-write-this
                      (ask self 'SAY 
                           (list "Cabbie, take me to" (ask dest 'NAME)))
                      'FORWARD-HO!))))))
         ((ACT)
          (lambda (self)
            (if (is-a (ask self 'LOCATION) 'TAXI?)
                'WAIT-TO-ARRIVE
                (ask self 'HAIL-TAXI))))
         ((CLOCK-TICK)
          (lambda (self)
            (if hailing?
                'you-have-to-write-this
                'and-this-too)))
         (else (get-method message my-poor-person)))))))

(define make&install-rich-person (installer make-rich-person))

(define (make-car name my-initial-location max-speed)
  (let ((mobile-obj (make-mobile-object name my-initial-location))
        (me-as-location (make-place (list name 'PLACE)))
        (directions '())
        (speed 0))
    (install-shield
     (lambda (message)
       (case message
         ((CAR?) (lambda (self) #T))
         ((INSTALL)
          (lambda (self)
            (add-to-clock-list self)
            (delegate-to-all (list mobile-obj me-as-location)
                             self 'INSTALL)))
         ((DROP-OFF-PASSENGER)
          (lambda (self passenger)
            (cond ((not (is-a passenger 'PERSON?))
                   (ask self 'SAY (list "Not a person" passenger)))
                  ((not (ask self 'HAVE-THING? passenger))
                   (ask self 'SAY (list "Not my passenger" passenger)))
                  (else
                   (ask passenger 'SAY (list "Exiting" (ask self 'NAME)))
                   (ask passenger 'CHANGE-LOCATION (ask self 'LOCATION))))))
         ((MOVE) 
          (lambda (self direction)
            (let ((next-stop
                   (ask (ask self 'LOCATION) 'NEIGHBOR-TOWARDS direction)))
              (if next-stop
                  (begin
                    (ask self 'SAY (list "zooming to" (ask next-stop 'NAME)))
                    (ask self 'CHANGE-LOCATION next-stop))
                  (begin
                    (ask self 'SAY (list "crashed into wall"))
                    'CRASH!)))))
         ((STOP)
          (lambda (self)
            (set! directions '())
            (set! speed 0)
            'STOPPED))
         ((DRIVE)
          (lambda (self new-speed . new-directions)
            (if (not (null? directions))
                (ask self 'SAY (list "Stopped driving to" directions)))
            (set! directions new-directions)
            (set! speed (max 0 (min max-speed new-speed)))
            'DRIVING))
         ((CLOCK-TICK)
          (lambda (self)
            (define (loop n)
              (cond ((zero? n) 'DONE)
                    ((null? directions) (ask self 'STOP))
                    (else (ask self 'MOVE (car directions))
                          (set! directions (cdr directions))
                          (loop (- n 1)))))
            (loop speed)))
         (else (get-method message mobile-obj me-as-location)))))))

(define make&install-car (installer make-car))
         
(define (make-taxi name my-initial-location)
  (let ((my-car (make-car name my-initial-location 0))
        (destination #F)
        (fare 0))
    (install-shield
     (lambda (message)
       (case message
         ((TAXI?) (lambda (self) #T))
         ((EMPTY-TAXI?)
          (lambda (self)
            (null? (find-all self 'PERSON?))))
         ((DROP-OFF-PASSENGERS)
          (lambda (self)
            (for-each
             (lambda (person)
               (ask self 'SAY (list "That'll be" fare "bucks," (ask person 'NAME)))
               (ask self 'DROP-OFF-PASSENGER person))
             (find-all self 'PERSON?))))
         ((STOP)
          (lambda (self)
            (ask self 'SAY
                 (list "Buddy, I don't stop 'til I getz ya home."))))
         ((DRIVE)
          (lambda (self . stuff)
            (ask self 'SAY
                 (list "If ya wanna drive, getcha own cab."))))
         ((SET-DESTINATION)
          (lambda (self to-where)
            (set! destination to-where)
            'AND-AWAY-WE-GO))
         ((CLOCK-TICK)
          (lambda (self)
            (define (loop n)
              (if (zero? n)
                  'DONE
                  (let ((location (ask self 'LOCATION)))
                    (if (eq? destination location)
                        (begin 
                          (ask self 'DROP-OFF-PASSENGERS)
                          (ask self 'SET-DESTINATION #F)
                          (set! fare 0))
                        (let ((direction
                               (pick-random
                                (filter (lambda (direction)
                                          (memq (ask location 
                                                     'NEIGHBOR-TOWARDS 
                                                     direction)
                                                *ALL-BUILDINGS*))
                                        (ask location 'EXITS)))))
                          (ask self 'MOVE direction)
                          (if destination (set! fare (+ fare 1)) 'CRUISING)))
                    (loop (- n 1)))))
            (loop (if destination 3 1))))
         (else (get-method message my-car)))))))

(define make&install-taxi (installer make-taxi))