;; --- Assignment 9 for CS22 
;; --- Author: Kuzman Ganchev and Albert Bui
;; --- Manufactorer: K&B.I Conglomerate
;; --- Version: 11/17/99
;;-----------------------------------------------------

;; K&B International presents....
;; A CS22 RPG
;; A story of courage, romance, action, and purple hair.
;; Prepare to be submerged in a world as real as the stunning 3D graphics
;; you are about to visualize.
;; Remeber... they're all around you.

;; This is actuallywhere the code begins.


;;------------------------------ The Clock ------------------------------

(define make-clock
  (lambda ()
    (let ((current-time 0)
          (beings-under-spell '()))
      
      (define method:type
        (lambda (self) 'clock))
      
      (define method:time
        (lambda (self) current-time))
      
      (define method:beings-under-spell
        (lambda (self) beings-under-spell))
      
      (define method:clear
        (lambda (self)
          (set! current-time 0)
          (set! beings-under-spell '())))
      
      (define method:tick
        (lambda (self)
          (set! current-time (+ current-time 1))
          (for-each
            (lambda (being) (ask being 'wander-around))
            beings-under-spell)
          (ask big-brother 'inform heaven '())
          '(the clock says tick)))
      
      (define method:put-under-spell
        (lambda (self being)
          (set! beings-under-spell (cons being beings-under-spell))))
      
      (define method:remove-from-spell
        (lambda (self being)
          (set! beings-under-spell (remove being beings-under-spell))))
      
      ;; clock messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'base-type) method:type)
          ((eq? message 'time) method:time)
          ((eq? message 'beings-under-spell) method:beings-under-spell)
          ((eq? message 'clear) method:clear)
          ((eq? message 'tick) method:tick)
          ((eq? message 'put-under-spell) method:put-under-spell)
          ((eq? message 'remove-from-spell) method:remove-from-spell)
          (else (error "I don't understand the message" message)))))))

(define clock (make-clock))



;;------------------------------- Places --------------------------------

(define make-place
  (lambda (name)
    (let ((neighborhood '())
          (current-things '())
          (current-beings '()))
      
      (define method:type
        (lambda (self) 'place))
      
      (define method:name
        (lambda (self) name))
      
      (define method:neighborhood
        (lambda (self) neighborhood))
      
      (define method:things
        (lambda (self) current-things))
      
      (define method:beings
        (lambda (self) current-beings))
      
      (define method:add-thing
        (lambda (self new-thing)
          (set! current-things (cons new-thing current-things))))
      
      (define method:delete-thing
        (lambda (self thing)
          (set! current-things (remove thing current-things))))
      
      (define method:add-being
        (lambda (self new-being)
          (set! current-beings (cons new-being current-beings))))
      
      (define method:delete-being
        (lambda (self being)
          (set! current-beings (remove being current-beings))))
      
      (define method:unowned-things
        (lambda (self)
          (filter
            (lambda (thing) (not (ask thing 'owned?)))
            current-things)))
      
      (define method:accept-being?
        (lambda (self being) #t))
      
      (define method:nearby-place
        (lambda (self direction)
          (get-nearby-place direction neighborhood)))
      
      (define method:random-nearby-place
        (lambda (self)
          (if (null? neighborhood)
            #f
            (cdr (pick-at-random neighborhood)))))
      
      (define method:add-nearby-place
        (lambda (self direction place)
          (if (get-nearby-place direction neighborhood)
            'done
            (let ((new-pair (cons direction place)))
              (set! neighborhood (cons new-pair neighborhood))))))
      
      ;; place messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'base-type) method:type)
          ((eq? message 'name) method:name)
          ((eq? message 'neighborhood) method:neighborhood)
          ((eq? message 'things) method:things)
          ((eq? message 'beings) method:beings)
          ((eq? message 'add-thing) method:add-thing)
          ((eq? message 'delete-thing) method:delete-thing)
          ((eq? message 'add-being) method:add-being)
          ((eq? message 'delete-being) method:delete-being)
          ((eq? message 'unowned-things) method:unowned-things)
          ((eq? message 'accept-being?) method:accept-being?)
          ((eq? message 'nearby-place) method:nearby-place)
          ((eq? message 'random-nearby-place) method:random-nearby-place)
          ((eq? message 'add-nearby-place) method:add-nearby-place)
          (else (error "I don't understand the message" message)))))))

;; ------------------------
;; <new> - below
;; a card-accessed-place is a type of place
;; registers ids only if they are inside the place (and not being 
;; carried by a being) accepts beings only if they have a card with
;; an id that matches a registered id (ie: an element form the 
;; registered-ids list).

(define make-card-accessed-place
  (lambda (name)
    (let ((place (make-place name))
          (registered-ids '()))
      (define method:type
        (lambda (self) 'card-accessed-place))
      
      (define method:register-card
        (lambda (self card-object) 
          (if (member? card-object (ask place 'things))
            (begin (set! registered-ids 
                         (cons (ask card-object 'id) registered-ids))
                   (display "id registered")
                   (newline)
                   'done)
            (display "id not registered"))))
      
      (define method:accept-being?
        (lambda (self being)
          (ask big-brother 
               'inform
               self
               (map (lambda (card) (ask card 'id))
                    (ask being 'cards)))
          (let ((type-of-being (ask being 'type)))
            (or (eq? 'ogre type-of-being)
                (eq? 'robot-ogre type-of-being)
                (contain-same?
                  registered-ids
                  (map (lambda (card) (ask card 'id)) 
                       (ask being 'cards)))))))
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'accept-being?) method:accept-being?)
          ((eq? message 'register-card) method:register-card)
          (else (get-method message place)))))))


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

(define create-one-way-path
  (lambda (from-place direction to-place)
    (ask from-place 'add-nearby-place direction to-place)))

(define create-path
  (lambda (from-place direction to-place)
    (create-one-way-path from-place direction to-place)
    (create-one-way-path to-place (opposite direction) from-place)))

(define opposite
  (lambda (direction)
    (cond
      ((eq? direction 'north) 'south)
      ((eq? direction 'northeast) 'southwest)
      ((eq? direction 'east) 'west)
      ((eq? direction 'southeast) 'northwest)
      ((eq? direction 'south) 'north)
      ((eq? direction 'southwest) 'northeast)
      ((eq? direction 'west) 'east)
      ((eq? direction 'northwest) 'southeast)
      ((eq? direction 'upstairs) 'downstairs)
      ((eq? direction 'downstairs) 'upstairs)
      (else (error "Invalid direction" direction)))))

;; a neighborhood is a list of the form:
;; ((direction . place) (direction . place) ...)

;; direction can be north, northeast, east, southeast, south,
;; southwest, west, northwest, upstairs, or downstairs

(define get-nearby-place
  (lambda (direction neighborhood)
    (cond
      ((null? neighborhood) #f)
      ((eq? (caar neighborhood) direction) (cdar neighborhood))
      (else (get-nearby-place direction (cdr neighborhood))))))

;;------------------------------- Things --------------------------------

(define make-thing
  (lambda (name place)
    (let ((owner 'nobody))
      
      (define method:type
        (lambda (self) 'thing))
      
      (define method:name
        (lambda (self) name))
      
      (define method:place
        (lambda (self) place))
      
      (define method:owner
        (lambda (self) owner))
      
      (define method:owned?
        (lambda (self)
          (not (eq? owner 'nobody))))
      
      (define method:set-place
        (lambda (self new-place)
          (set! place new-place)))
      
      (define method:set-owner
        (lambda (self new-owner)
          (set! owner new-owner)))
      
      ;; thing messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'base-type) method:type)
          ((eq? message 'name) method:name)
          ((eq? message 'place) method:place)
          ((eq? message 'owner) method:owner)
          ((eq? message 'owned?) method:owned?)
          ((eq? message 'set-place) method:set-place)
          ((eq? message 'set-owner) method:set-owner)
          (else (error "I don't understand the message" message)))))))

;;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;; A readable-thing is a kind of thing:

(define make-readable-thing
  (lambda (name place text)
    (let ((thing (make-thing name place)))
      
      (define method:type
        (lambda (self) 'readable-thing))
      
      (define method:text
        (lambda (self) text))
      
      ;; readable-thing messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'text) method:text)
          (else (get-method message thing)))))))

;;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;; An sd-card is a type of thing <new> :

(define make-sd-card 
  (lambda (name birthplace id) 
    (let ((thing (make-thing name birthplace)))
      (define  method:type
        (lambda (self) 'sd-card))
      (define method:id
        (lambda (self) id))
      (lambda (message)
        (cond 
          ((eq? message 'type) method:type)
          ((eq? message 'id) method:id)
          (else (get-method message thing))))))) 


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

(define make&install-thing
  (lambda (name place)
    (let ((new-thing (make-thing name place)))
      (ask place 'add-thing new-thing)
      new-thing)))

(define make&install-readable-thing
  (lambda (name place text)
    (let ((new-thing (make-readable-thing name place text)))
      (ask place 'add-thing new-thing)
      new-thing)))

;; <new> make&install-sd-card

(define make&install-sd-card
  (lambda (name birthplace id)
    (let ((new-card (make-sd-card name birthplace id)))
      (ask birthplace 'add-thing new-card)
      new-card)))

;;------------------------------- Beings --------------------------------

(define make-being
  (lambda (name current-place restlessness)
    (let ((threshold (- 100 restlessness))
          (possessions '()))
      
      (define method:type
        (lambda (self) 'being))
      
      (define method:name
        (lambda (self) name))
      
      (define method:place
        (lambda (self) current-place))
      
      (define method:restlessness
        (lambda (self) restlessness))
      
      (define method:possessions
        (lambda (self) possessions))
      
      (define method:add-possession
        (lambda (self new-thing)
          (set! possessions (cons new-thing possessions))))
      
      (define method:delete-possession
        (lambda (self thing)
          (set! possessions (remove thing possessions))))
      
      (define method:move-to
        (lambda (self new-place)
          (ask current-place 'delete-being self)
          (ask new-place 'add-being self)
          (for-each
            (lambda (thing)
              (ask current-place 'delete-thing thing)
              (ask new-place 'add-thing thing)
              (ask thing 'set-place new-place))
            possessions)
          (set! current-place new-place)))
      
      (define method:act
        (lambda (self)
          (greet-beings self (other-beings-nearby self))))
      
      (define method:wander-around
        (lambda (self)
          (if (>= (random 100) threshold)
            (let ((new-place (ask current-place 'random-nearby-place)))
              (if (and new-place (ask new-place 'accept-being? self))
                (begin
                 (say name "wanders from" (ask current-place 'name)
                      "to" (ask new-place 'name))
                 (ask self 'move-to new-place)
                 (ask self 'act)))))))
      
      ;; USER COMMANDS:
      ;; --------------
      
      (define method:go
        (lambda (self direction)
          (let ((new-place (ask current-place 'nearby-place direction)))
            (cond
              ((not new-place)
               (say "No way to go" direction "from"
                    (ask current-place 'name)))
              ((eq? new-place current-place)
               (say name "is already at" (ask current-place 'name)))
              ((ask new-place 'accept-being? self)
               (begin
                (say name "moves from" (ask current-place 'name) "to"
                     (ask new-place 'name))
                (ask self 'move-to new-place)
                (ask self 'act)
                (ask self 'look-around)))
              (else (say name "is not allowed to go to"
                         (ask new-place 'name)))))))
      
      (define method:list-possessions
        (lambda (self)
          (if (null? possessions)
            (says self "I'm not carrying anything.")
            (begin
             (says self "I'm currently carrying:")
             (for-each
               (lambda (thing) (say (ask thing 'name)))
               possessions)))))
      
      (define method:drop
        (lambda (self thing)
          (if (not (member? thing (ask self 'possessions)))
            (say name "is not carrying" (ask thing 'name))
            (begin
             (ask self 'delete-possession thing)
             (ask thing 'set-owner 'nobody)
             (say name "drops" (ask thing 'name) "at"
                  (ask current-place 'name))))))
      
      (define method:take
        (lambda (self thing)
          (cond
            ((member? thing (ask self 'possessions))
             (say name "is already carrying" (ask thing 'name)))
            ((eq? (ask thing 'place) current-place)
             (if (ask thing 'owned?)
               (begin
                (let ((owner (ask thing 'owner)))
                  (ask owner 'delete-possession thing)
                  (ask thing 'set-owner self)
                  (ask self 'add-possession thing)
                  (say name "snatches" (ask thing 'name) "from"
                       (ask owner 'name))))
               (begin
                (ask thing 'set-owner self)
                (ask self 'add-possession thing)
                (say name "takes" (ask thing 'name)))))
            (else (says-at-place self "I don't see any"
                                 (ask thing 'name) "to take")))))
      
      (define method:greet
        (lambda (self being)
          (cond
            ((eq? (ask being 'place) current-place)
             (says-at-place self "Hi" (ask being 'name)))
            (else (says-at-place self "I don't see"
                                 (ask being 'name) "here")))))
      
      (define method:read
        (lambda (self thing)
          (cond
            ((not (eq? (ask thing 'place) current-place))
             (says-at-place self "I don't see any"
                            (ask thing 'name) "to read"))
            ((not (is-a? thing 'readable-thing))
             (says self "I don't know how to read that"))
            (else (for-each say (ask thing 'text))))))
      
      (define method:look-around
        (lambda (self)
          (say "At" (ask current-place 'name) name "says:")
          (let ((neighborhood (ask current-place 'neighborhood)))
            (if (null? neighborhood)
              (say "I don't see any way out of here")
              (for-each
                (lambda (pair)
                  (let ((direction (car pair))
                        (nearby-place (cdr pair)))
                    (say "I see a path leading" direction "to"
                         (ask nearby-place 'name))))
                neighborhood)))
          (for-each
            (lambda (other-being)
              (say (ask other-being 'name) "is standing next to me")
              (let ((possessions (ask other-being 'possessions)))
                (if (not (null? possessions))
                  (begin
                   (say (ask other-being 'name) "is carrying:")
                   (for-each
                     (lambda (thing) (say (ask thing 'name)))
                     possessions)))))
            (remove self (ask current-place 'beings)))
          (let ((unowned-things (ask current-place 'unowned-things)))
            (if (not (null? unowned-things))
              (begin
               (say "Nearby I see:")
               (for-each
                 (lambda (thing) (say (ask thing 'name)))
                 unowned-things))))))
      
;; <new> (following method, lists cards belonging to being)      
      (define method:list-cards
        (lambda (self)
          (filter (lambda (possession) 
                    (is-a? possession 'sd-card))
                  possessions)))
      
      ;; being messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'base-type) method:type)
          ((eq? message 'name) method:name)
          ((eq? message 'place) method:place)
          ((eq? message 'restlessness) method:restlessness)
          ((eq? message 'possessions) method:possessions)
          ((eq? message 'add-possession) method:add-possession)
          ((eq? message 'delete-possession) method:delete-possession)
          ((eq? message 'move-to) method:move-to)
          ((eq? message 'act) method:act)
          ((eq? message 'wander-around) method:wander-around)
          ((eq? message 'go) method:go)
          ((eq? message 'list-possessions) method:list-possessions)
          ((eq? message 'drop) method:drop)
          ((eq? message 'take) method:take)
          ((eq? message 'greet) method:greet)
          ((eq? message 'read) method:read)
          ((eq? message 'look-around) method:look-around)
;;<new> (following line) 
          ((eq? message 'cards) method:list-cards)      
          (else (error "I don't understand the message" message)))))))

;;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;; Students, professors, and trolls are all kinds of beings (but they
;; are not all kind beings!):

(define make-student
  (lambda (name birthplace restlessness)
    (let ((being (make-being name birthplace restlessness))
          (threshold (- 100 restlessness)))
      
      (define method:type
        (lambda (self) 'student))
      
      (define method:act
        (lambda (self)
          (let ((my-place (ask self 'place)))
            (let ((free-stuff (ask my-place 'unowned-things)))
              (let ((free-cards (filter 
                                 (lambda (athing) 
                                   (is-a? athing 'sd-card))
                                 free-stuff)))
            (cond 
              ((and (eq? 'card-accessed-place 
                         (ask my-place 'type))
                    (not (null? free-cards)))
               (ask self 'take (pick-at-random free-cards)))
              ((and (not (null? free-stuff)) 
                    (> 30 (random 100)))
               (ask self 'take (pick-at-random free-stuff)))
              ((> 10 (random 100))
               (ask self 
                    'drop 
                    (pick-at-random 
                      (ask self 'possessions))))))))))
      
      (define method:wander-around
        (lambda (self)
          (if (>= (random 100) (- threshold 20))
            (ask self 'act))
          (if (>= (random 100) threshold)
            (let ((new-place (ask (ask self 'place) 'random-nearby-place)))
              (if (and new-place (ask new-place 'accept-being? self))
                (begin
                 (say name "wanders from" (ask (ask self 'place) 'name)
                      "to" (ask new-place 'name))
                 (ask self 'move-to new-place)
                 ))))))
      
      ;; student messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'act) method:act)
          ((eq? message 'wander-around) method:wander-around)
          (else (get-method message being)))))))

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

(define make-professor
  (lambda (name birthplace restlessness)
    (let ((being (make-being name birthplace restlessness)))
      
      (define method:type
        (lambda (self) 'professor))
      
      ;; professor messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          (else (get-method message being)))))))

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

(define make-troll
  (lambda (name birthplace restlessness)
    (let ((hunger 0)
          (being (make-being name birthplace restlessness)))
      
      (define method:type
        (lambda (self) 'troll))
      
      (define method:act
        (lambda (self)
          (set! hunger (+ hunger 1))
          (cond
            ((= hunger 10)
             (says-at-place self "<growl>...I'm getting hungry"))
            ((= hunger 20)
             (says-at-place self "<growl>...I'm starving!")))
          (let ((nearby-beings (other-beings-nearby self)))
            (if (not (null? nearby-beings))
              (begin
               (greet-beings self nearby-beings)
               (if (> hunger 10)
                 (ask self 'eat (pick-at-random nearby-beings))))))))
      
       (define method:eat
        (lambda (self unlucky-being)
          (says-at-place unlucky-being "Yikes!")
          (if (member? twinkies (ask unlucky-being 'possessions))
              (begin 
                (says self "Chomp!  Mmmmm... Twinkies tastes yummy!")
                (ask unlucky-being 'delete-possession twinkies)
                (ask (ask unlucky-being 'place) 'delete-thing twinkies)
                (says self "<burp>")
                (set! hunger 0))
              (begin 
                (says self 
                      "Chomp!  Mmmmm..." 
                      (ask unlucky-being 'name) 
                      "tastes yummy!")
                (send-to-heaven unlucky-being)
                (says self "<burp>")
                (set! hunger 0)))))

      
      ;; troll messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'act) method:act)
          ((eq? message 'eat) method:eat)
          (else (get-method message being)))))))

;; ---------------------------------
;; <new> - below, ogres are beings that hunt down felons against the 
;; intrinsic human rights to life, libery and yellow shorts. they also 
;; enforce the student disservice card system.

(define make-ogre
  (lambda (name birthplace restlessness)
    (let ((hunger 0)
          (being (make-being name birthplace restlessness)))
      
      (define method:type
        (lambda (self) 'ogre))
      
      (define method:act
        (lambda (self)
          (set! hunger (+ hunger 2))
          (cond
            ((= hunger 10)
             (says-at-place self "<growl>... where'd the felons go?"))
            ((= hunger 20)
             (says-at-place self "<growl>...I'm starving! here kitty kitty..")))
          (let 
            ((nearby-felons 
               (filter 
                 (lambda (abeing) 
                   (contain-same? 
                     (map (lambda (acard) 
                            (ask acard 'id))
                          (ask abeing 'cards)) *stolen-card-ids*))
                 (other-beings-nearby self))))
            (if (not (null? nearby-felons))
              (begin
               (greet-beings self nearby-felons)
               (if (> hunger 10)
                 (ask self 'eat (pick-at-random nearby-felons))))))))
      
      (define method:eat
        (lambda (self unlucky-being)
          (says-at-place unlucky-being "Oh NO!!! It's an Ogre!")
          (says self "Chomp! Mmmmm..." (ask unlucky-being 'name) 
                "tastes yummy!")
          (says self " Off to heaven scumbag!!")
          (send-to-heaven unlucky-being)
          (says self "<burp> - another day, another felon")
          (set! hunger 0)))
      
      ;; ogre messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'act) method:act)
          ((eq? message 'eat) method:eat)
          (else (get-method message being)))))))

;;-------

;; <new> a robot-ogre is not a type of ogre (it lacks the complex emotional 
;; mechanisms thath make ogres so special). A robot-ogre is a type of being.


(define make-robot-ogre
  (lambda (name birthplace)
    (let ((being (make-being name birthplace 100)))
      (define method:type
        (lambda (self) 'robot-ogre))
      
      (define method:act
        (lambda (self)
          (let 
            ((nearby-felons 
               (filter 
                 (lambda (abeing) 
                   (contain-same? 
                     (map (lambda (acard) 
                            (ask acard 'id))
                          (ask abeing 'cards)) *stolen-card-ids*))
                 (other-beings-nearby self))))
            (if (not (null? nearby-felons))
              (begin
               (greet-beings self nearby-felons)
               (ask self 'eat (pick-at-random nearby-felons)))))))
      
      (define method:eat
        (lambda (self unlucky-being)
          (says-at-place unlucky-being "Oh NO!!! It's a mechanical Orge!")
          (says self "The threat posed by " (ask unlucky-being 'name) 
                "has been neutralized")
          (send-to-heaven unlucky-being)))
      
      ;; robot-ogre messages:
      (lambda (message)
        (cond
          ((eq? message 'type) method:type)
          ((eq? message 'act) method:act)
          ((eq? message 'eat) method:eat)
          (else (get-method message being)))))))


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

(define make&install-student
  (lambda (name birthplace restlessness)
    (let ((student (make-student name birthplace restlessness)))
      (ask clock 'put-under-spell student)
      (ask birthplace 'add-being student)
      student)))

(define make&install-professor
  (lambda (name birthplace restlessness)
    (let ((professor (make-professor name birthplace restlessness)))
      (ask clock 'put-under-spell professor)
      (ask birthplace 'add-being professor)
      professor)))

(define make&install-troll
  (lambda (name birthplace restlessness)
    (let ((troll (make-troll name birthplace restlessness)))
      (ask clock 'put-under-spell troll)
      (ask birthplace 'add-being troll)
      troll)))

;; <new> makes and installs an ogre

(define make&install-ogre
  (lambda (name birthplace restlessness)
    (let ((ogre (make-ogre name birthplace restlessness)))
      (ask clock 'put-under-spell ogre)
      (ask birthplace 'add-being ogre)
      ogre)))

;; <new> makes and installs a new robot-ogre
(define make&install-robot-ogre
  (lambda (name birthplace restlessness)
    (let ((robot-ogre (make-robot-ogre name birthplace)))
      (ask clock 'put-under-spell robot-ogre)
      (ask birthplace 'add-being robot-ogre)
      robot-ogre)))

(define send-to-heaven
  (lambda (being)
    ;; you can't take it with you
    (for-each
      (lambda (thing) (ask being 'drop thing))
      (ask being 'possessions))
    (ask being 'move-to heaven)
    (ask being 'act)
    (ask clock 'remove-from-spell being)))

(define greet-beings
  (lambda (being other-beings)
    (for-each
      (lambda (other-being)
        (if (not (is-a? being 'ogre))
          (ask being 'greet other-being)))
      other-beings)))

(define other-beings-nearby
  (lambda (being)
    (remove being (ask (ask being 'place) 'beings))))

;;<new>------------------ Legal System support -------------------------

;; <new> - below creates a report stolen card method, it needs to be 
;; passesd two arguments: a place to create ogres, and a place to create
;; robot-ogres.

(define make-report-stolen-card 
  (lambda (ogre-birthplace robot-ogre-birthplace)
    (lambda (id)
      (set! *stolen-card-ids* (cons id *stolen-card-ids*))
      (cond ((= 10 (length *stolen-card-ids*)) 
             (begin
              (make&install-robot-ogre 'ogre-robocop 
                                       robot-ogre-birthplace
                                       0)
              (display "The card with the id ")
              (diplay id)
              (display " has been reported stolen.")
              (newline)
              (display "We would like to announce a new force in the war")
              (newline)
              (display "against crime... Introducing ogre-robocop.")
              (newline)
              '(applause)))
            (else 
             (begin
              (make&install-ogre 
                (list 'ogre 'number (length *stolen-card-ids*))
                ogre-birthplace
                (+ 50 (random 50)))
              (display "the card with the id ")
              (display id)
              (display " has been reported stolen.")
              (newline)
              (display "a new ogre has been dispatched to hunt down thieves")
              (newline)
              'done
              ))))))

;; <new> - below make-big-brother creates big-brother - the vigilant eye 
;; of the law. Big-brither is the vigilant protector from the most terrible 
;; crime of sd-card fraud. <incomplete>

(define make-big-brother
  (lambda (report-stolen-card-function)
    (let ((list-of-informs '())
          (time-of-informs 0))
      (define method:inform
        (lambda (self place ids)
          (if (< time-of-informs (ask clock 'time))
            (begin
             (find-duplicates list-of-informs
                              report-stolen-card-function)
             (set! time-of-informs (ask clock 'time))
             (set! list-of-informs '())))
          (set! list-of-informs 
                (cons (list (ask place 'name) ids) list-of-informs))))
      (lambda (message)
        (cond 
          ((eq? message 'inform) method:inform)
          (else (error "Big Brother is not impressed by prank" 'calls)))))))

(define find-duplicates 
  (lambda (list-of-informs report-stolen-card-function)
    (report-duplicates (strip list-of-informs) report-stolen-card-function)))

(define report-duplicates
  (lambda (id-list report-stolen-card-function)
    (cond ((< (length id-list) 2) 'no-takers)
          ((member? (car id-list) (cdr id-list)) 
           (report-stolen-card-function (car id-list))
           (report-duplicates (cdr id-list) 
                              report-stolen-card-function)))))


(define strip
     (lambda (l)
       (cond ((null? l) '())
             (else (append (cadar l) (strip (cdr l)))))))  



;;------------------------ User Interface -------------------------------

(define tick
  (lambda ()
    (ask clock 'tick)))

(define run-clock
  (lambda (n)
    (if (= n 0)
      'done
      (begin
       (say (tick))
       (run-clock (- n 1))))))

(define user-interface-messages
  '(go list-possessions drop take greet read look-around))

(define tell
  (lambda (object message . args)
    (cond
      ((not (is-a? object 'being))
       (say "Come on, don't be ridiculous!"))
      ((not (member? message user-interface-messages))
       (say (ask object 'name) "just ignores you."))
      (else (let ((method (get-method message object)))
              (apply method (cons object args)))))
    (tick)))

;;-------------------------- Utilities ----------------------------------

(define ask
  (lambda (object message . args)
    (let ((method (get-method message object)))
      (apply method (cons object args)))))

(define get-method
  (lambda (message object)
    (object message)))

(define is-a?
  (lambda (x type)
    (or (eq? (ask x 'type) type)
        (eq? (ask x 'base-type) type))))

;; say prints out its arguments separated by spaces:

(define say
  (lambda things-to-say
    (for-each
      (lambda (x) (display x) (display " "))
      things-to-say)
    (newline)))

;; says prints out the list of things-to-say, preceded by
;; "<name-of-being> says: "

(define says
  (lambda (being . things-to-say)
    (display (ask being 'name))
    (display " says: ")
    (apply say things-to-say)))

;; says-at-place prints out the list of things-to-say, preceded by
;; "At <location> <name-of-being> says:  "

(define says-at-place
  (lambda (being . things-to-say)
    (display "At ")
    (display (ask (ask being 'place) 'name))
    (display " ")
    (display (ask being 'name))
    (display " says: ")
    (apply say things-to-say)))

(define pick-at-random
  (lambda (l)
    (list-ref l (random (length l)))))

(define member?
  (lambda (x l)
    (and (not (null? l))
         (or (eq? (car l) x) (member? x (cdr l))))))

(define remove
  (lambda (x l)
    (cond
      ((null? l) '())
      ((eq? (car l) x) (remove x (cdr l)))
      (else (cons (car l) (remove x (cdr l)))))))

(define filter
  (lambda (pred? l)
    (cond
      ((null? l) '())
      ((pred? (car l)) (cons (car l) (filter pred? (cdr l))))
      (else (filter pred? (cdr l))))))

;; <new> - below
;; contain-same? is used by make-card-accessed-place. it takes 2 lists, it 
;; returns true if the lists contain an element in common, and false 
;; otherwise.

(define contain-same? 
  (lambda (l1 l2)
    (cond ((null? l1) #f)
          ((null? l2) #f)
          ((not (null? (filter (lambda (element) 
                            (eq? (car l1) element))
                          l2)))
           #t)
          (else (contain-same? (cdr l1) l2)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;Swarthmore World;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;------------------Initialize Simulated World --------------------------

;; reset the clock back to time 0
(ask clock 'clear)


  



          

;; create some places
(define jims-office     (make-place 'jims-office))
(define lisas-office    (make-place 'lisas-office))
(define hallway         (make-place 'hallway))
(define robot-lab       (make-place 'robot-lab))
(define sproul-entrance (make-place 'sproul-entrance))
(define computer-lab    (make-place 'computer-lab))
(define dupont-hall     (make-place 'dupont-hall))
(define trotter-hall    (make-place 'trotter-hall))
(define parrish-hall    (make-place 'parrish-hall))
(define parrish-beach   (make-place 'parrish-beach))
(define kohlberg-hall   (make-place 'kohlberg-hall))
(define tarble          (make-place 'tarble))
(define mccabe-library  (make-place 'mccabe-library))
(define sharples        (make-place 'sharples))
(define dungeon         (make-place 'dungeon))
(define heaven          (make-place 'heaven))
(define road            (make-place 'road))

;; <new> - below
(define mertz           (make-card-accessed-place 'mertz))
(define willets         (make-card-accessed-place 'willets))
(define wharton         (make-card-accessed-place 'wharton))
(define dana            (make-card-accessed-place 'dana))
(define hallowell       (make-card-accessed-place 'hallowell))

;; establish pathways between various places
(create-path sproul-entrance 'downstairs hallway)
(create-path hallway 'east jims-office)
(create-path hallway 'south lisas-office)
(create-path sproul-entrance 'upstairs computer-lab)
(create-path computer-lab 'east robot-lab)
(create-path sproul-entrance 'east tarble)
(create-path tarble 'northeast parrish-hall)
(create-path tarble 'east parrish-beach)
(create-path tarble 'south sharples)
(create-path parrish-hall 'south parrish-beach)
(create-path parrish-hall 'east mccabe-library)
(create-path parrish-hall 'north kohlberg-hall)
(create-path parrish-hall 'northeast trotter-hall)
(create-path kohlberg-hall 'north dupont-hall)
(create-path kohlberg-hall 'east trotter-hall)
(create-path trotter-hall 'south mccabe-library)
(create-one-way-path dungeon 'upstairs parrish-hall)
;; <new> - below
(create-path mccabe-library  'south mertz) ;; mertz is south of mcabe
(create-path sharples        'east  mertz)
(create-path mccabe-library  'east  willets)
(create-path sproul-entrance 'west  wharton)
(create-path road            'northwest hallowell)
(create-path road            'west  dana)
(create-path road            'east  parrish-hall)
(create-path road            'south wharton)


;; create some beings
(define jim        (make&install-professor 'jim jims-office 5))
(define lisa       (make&install-professor 'lisa lisas-office 20))
(define grendel    (make&install-troll 'grendel dungeon 50))
;; <new> - below
(define kuzman     (make&install-student 'kuzman  wharton   10))
(define neil       (make&install-student 'neil    willets   25))
(define sarah      (make&install-student 'sarah   mertz     20))
(define al         (make&install-student 'al      willets    0))
(define russell    (make&install-student 'russell dana       2))
(define mandy      (make&install-student 'mandy   mertz     30))
(define rob        (make&install-student 'rob     dana      10))
(define s-k        (make&install-student 's-k     hallowell 25))

;; create some things
(define computer (make&install-thing 'computer jims-office))
(define frisbee (make&install-thing 'frisbee lisas-office))
(define robot (make&install-thing 'robot robot-lab))
(define twinkies (make&install-thing 'twinkies sharples))


;; <new> below:
(define jims-card (make&install-sd-card 'jims-card jims-office 'jim))
(define kuzmans-card (make&install-sd-card 'kuzmans-card wharton 'wha1))
(define neils-card (make&install-sd-card 'neils-card willets 'wil1))
(define sarahs-card (make&install-sd-card 'sarahs-card mertz 'mer1))
(define als-card (make&install-sd-card 'als-card willets 'wil2))
(define russells-card (make&install-sd-card 'russells-card dana 'dan1))
(define mandys-card (make&install-sd-card 'mandys-card mertz 'mer2))
(define robs-card (make&install-sd-card 'robs-card dana 'dan2))
(define s-ks-card (make&install-sd-card 's-ks-card hallowell 'hal1))

(define f-card-dana (make&install-sd-card 'f-card-dana tarble 'dan1))
(define f-card-mertz (make&install-sd-card 'f-card-mertz dana 'mer1))
(define f-card-hallowell (make&install-sd-card 'f-card-hallowell willets 'dan1))
(define f-card-wharton (make&install-sd-card 'f-card-wharton hallowell 'wha1))
(define f-card-willets (make&install-sd-card 'f-card-willets mertz 'wil1))

(ask wharton 'register-card kuzmans-card)
(ask willets 'register-card neils-card)
(ask mertz 'register-card sarahs-card)

(ask willets 'register-card als-card)
(ask dana 'register-card russells-card)
(ask mertz 'register-card mandys-card)
(ask dana 'register-card robs-card)
(ask hallowell 'register-card s-ks-card)



(define book
  (make&install-readable-thing 
   'book mccabe-library
   (list
    "A quick glance at a random page reveals:"
    "\"Holy smokes, Batman!  What do we do now?!"
    "Don't panic, Robin!  Luckily, I remembered"
    "to bring the bat-chainsaw with me...\"")))

(define computer-manual
  (make&install-readable-thing 
   'computer-manual computer-lab
   (list
    "The first page says:"
    "\"To operate computer, turn power switch from OFF position to ON."
    "For further technical assistance, call 1-800-GET-LOST during the"
    "hours of 3:00-3:15am, Sunday through Monday.\""
    "The other pages all seem to be blank.")))

(define sign
  (make&install-readable-thing 
   'sign kohlberg-hall
   (list "On the sign is written, in dark Gothic lettering:"
         "\"Abandon all hope ye who enter here\"")))

;; <new> --- the law ---

;; <new> - below *stolen-card-ids* is a list that keeps track of all the 
;; stolen card ids. Since we live in a safe loving community, this is 
;; initially 0, but who knows what the new sd system will do to people?

(define *stolen-card-ids* '())

;; <new> - below the method by which theft is reported in this game
(define report-stolen-card 
  (make-report-stolen-card dungeon robot-lab))

;; <new> - below big-brother spies on the beings in the world

(define big-brother (make-big-brother report-stolen-card))