(load "~cs61a/lib/obj.scm")
(load "~cs61a/lib/tables.scm")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ADV.SCM
;; This file contains the definitions for the objects in the adventure
;; game and some utility procedures.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define-class (basic-object)
  (instance-vars (properties (make-table)))
  (method (put type num)
    (insert! type num properties))
  (default-method 
    (lookup message properties)))

(define-class (place name)
  (parent (basic-object))
  (instance-vars
   (directions-and-neighbors '())
   (things '())
   (people '())
   (entry-procs '())
   (exit-procs '()))
  (method (may-enter? per) #t)
  (method (place?) #t)
  (method (type) 'place)
  (method (neighbors) (map cdr directions-and-neighbors))
  (method (exits) (map car directions-and-neighbors))
  (method (look-in direction)
    (let ((pair (assoc direction directions-and-neighbors)))
      (if (not pair)
	  '()                     ;; nothing in that direction
	  (cdr pair))))           ;; return the place object
  (method (appear new-thing)
    (if (memq new-thing things)
	(error "Thing already in this place" (list name new-thing)))
    (set! things (cons new-thing things))
    'appeared)
  (method (enter new-person)
    (if (memq new-person people)
	(error "Person already in this place" (list name new-person)))
    (set! people (cons new-person people))
    (begin (map (lambda (old-one) (ask old-one 'notice new-person)) (cdr people))
    (for-each (lambda (proc) (proc)) entry-procs)
    'appeared))
  (method (gone thing)
    (if (not (memq thing things))
	(error "Disappearing thing not here" (list name thing)))
    (set! things (delete thing things)) 
    'disappeared)
  (method (exit person)
    (for-each (lambda (proc) (proc)) exit-procs)
    (if (not (memq person people))
	(error "Disappearing person not here" (list name person)))
    (set! people (delete person people)) 
    'disappeared)

  (method (new-neighbor direction neighbor)
    (if (assoc direction directions-and-neighbors)
	(error "Direction already assigned a neighbor" (list name direction)))
    (set! directions-and-neighbors
	  (cons (cons direction neighbor) directions-and-neighbors))
    'connected)

  (method (add-entry-procedure proc)
    (set! entry-procs (cons proc entry-procs)))
  (method (add-exit-procedure proc)
    (set! exit-procs (cons proc exit-procs)))
  (method (remove-entry-procedure proc)
    (set! entry-procs (delete proc entry-procs)))
  (method (remove-exit-procedure proc)
    (set! exit-procs (delete proc exit-procs)))
  (method (clear-all-procs)
    (set! exit-procs '())
    (set! entry-procs '())
    'cleared) )

(define-class (locked-place name)
  (parent (place name))
  (instance-vars (locker #f))
  (method (unlock) (set! locker #t))
  (method (lock) (set! locker #f))
  (method (may-enter? per) locker))

(define-class (restaurant name food-type cost)
  (parent (place name))
  (method (menu) (list (ask food-type 'name) cost))
  (method (sell custom item)
	  (if (and (eq? (ask food-type 'name) item)
		      (or (if (eq? (ask custom 'type) 'police)
				(begin (display "No charge for you, Sir")
				(newline)
				#t)
				#f)
			  (ask custom 'pay-money cost)))
	      (let ((x (instantiate food-type)))
		(ask self 'appear x)
		x)
	      #f)))

(define-class (person name place)
  (parent (basic-object))
  (instance-vars
   (possessions '())
   (saying ""))
  (initialize
   (ask place 'enter self)
   (ask self 'put 'strength 100)
   (ask self 'put 'money 100))
  (method (type) 'person)
  (method (person?) #t)
  (method (look-around)
    (map (lambda (obj) (ask obj 'name))
	 (filter (lambda (thing) (not (eq? thing self)))
		 (append (ask place 'things) (ask place 'people)))))
  (method (get-money n)
	  (ask self 'put 'money (+ n (ask self 'money)))
	  'ok)
  (method (pay-money n)
	  (let ((k (ask self 'money)))
	    (if (< k n)
		#f
		(begin (ask self 'put 'money (- k n))
		       #t))))
  (method (take-all)
	  (let ((a (ask (ask self 'place) 'things)))
	    (let ((all (map (lambda (thing)
			      (if (eq? 'no-one (ask thing 'possessor))
				  thing
				  #f))
			    a)))
	      (map (lambda (one) (ask self 'take one)) (remove #f all)))))
   (method (go-directly-to somewhere)
	  (cond ((not (ask somewhere 'place?))
		 (error "cannot enter" somewhere))
		((not (ask somewhere 'may-enter? self))
		 (display (ask somewhere 'name))
		 (display "locked")
		 (newline))
		(else
		 (ask place 'exit self)
		 (announce-move name place somewhere)
		 (for-each
		  (lambda (p)
		    (ask place 'gone p)
		    (ask somewhere 'appear p))
		  possessions)
		 (set! place somewhere)
		 (ask somewhere 'enter self))))
  (method (buy item)
	  (let ((x  (ask place 'sell self item)))
	    (if x
		(ask self 'take x)
		#f)))
  (method (take thing)
    (cond ((not (ask thing 'thing?)) (error "Not a thing" thing))
	  ((not (memq thing (ask place 'things)))
	   (error "Thing taken not at this place"
		  (list (ask place 'name) thing)))
	  ((memq thing possessions) (error "You already have it!"))
	  ((eq? 'no-one (ask thing 'possessor))
	   (announce-take name thing)
	   (set! possessions (cons thing possessions))
	   (ask thing 'change-possessor self)
	   (display 'taken)
	   (newline))
	  (else
	   (let ((item (ask thing 'may-take? self))
		 (pers (ask thing 'possessor)))
	     (if item
		 (begin
		   (announce-take name item)
		   (set! possessions (cons item possessions))
		   (ask pers 'lose item)
		   (ask thing 'change-possessor self)
		   (display 'taken)
		   (newline)
		   (have-fit pers))
		 #f)))))
	  
  (method (eat)
    (let ((foods (filter (lambda (one)
			   (ask one 'edible?))
			 (ask self 'possessions))))
      (map (lambda (one)
	     (let ((cal (ask one 'calories)))
	       (ask self 'put 'strength (+ (ask self 'strength) cal))
	       (ask self 'lose one)
	       (ask place 'gone one)))
	   foods)))
  
  (method (lose thing)
    (set! possessions (delete thing possessions))
    (ask thing 'change-possessor 'no-one)
    'lost)
  (method (talk) (print saying))
  (method (set-talk string) (set! saying string))
  (method (exits) (ask place 'exits))
  (method (notice person) (ask self 'talk))
  (method (go direction)
    (let ((new-place (ask place 'look-in direction)))
      (cond ((null? new-place)
	     (error "Can't go" direction))
	    ((not (ask new-place 'may-enter? self))
	     (display (ask new-place 'name))
	     (display " locked")
	     (newline))
	    (else
	     (ask place 'exit self)
	     (announce-move name place new-place)
	     (for-each
	      (lambda (p)
		(ask place 'gone p)
		(ask new-place 'appear p))
	      possessions)
	     (set! place new-place)
	     (ask new-place 'enter self))))) )

(define-class (police name place)
  (parent (person name place))
  (initialize
   (ask self 'put 'strength 200))
  (method (type) 'police)
  
  (method (notice person)
	  (cond ((and (eq? 'thief (ask person 'type))
		      (> (ask self 'strength) (ask person 'strength)))		
		 (begin (newline)
			(display "Crime Does Not Pay")
			(newline)
			(map (lambda (x)
			       (ask self 'take x)) (ask person 'possessions))
			(ask person 'go-directly-to jail))))))
	
	  

;(define thing
;  (let ()
;    (lambda (class-message)
;      (cond
;       ((eq? class-message 'instantiate)
;	(lambda (name)
;	  (let ((self '()) (possessor 'no-one))
;	    (define (dispatch message)
;	      (cond
;	       ((eq? message 'initialize)
;		(lambda (value-for-self)
;		  (set! self value-for-self)))
;	       ((eq? message 'send-usual-to-parent)
;		(error "Can't use USUAL without a parent." 'thing))
;	       ((eq? message 'name) (lambda () name))
;	       ((eq? message 'possessor) (lambda () possessor))
;	       ((eq? message 'type) (lambda () 'thing))
;	       ((eq? message 'change-possessor)
;		(lambda (new-possessor)
;		  (set! possessor new-possessor)))
;	       (else (no-method 'thing))))
;	    dispatch)))
;       (else (error "Bad message to class" class-message))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;define things
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-class (thing name)
  (parent (basic-object))
  (instance-vars (possessor 'no-one))
  (method (name) name)
  (method (thing?) #t)
  (method (possessor) possessor)
  (method (type) 'thing)
  (method (change-possessor new-possessor)
	  (set! possessor new-possessor))
  (method (may-take? receiver)
	  (if (> (ask receiver 'strength)
		 (ask possessor 'strength))
	      self
	      #f)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Define class food
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-class (food name cal)
  (parent (thing name))
  (method (edible?) #t)
  (method (calories) cal))

(define-class (bagel)
  (parent (food 'bagel 10))
  (class-vars (name 'bagel)))

(define-class (coffee)
  (parent (food 'coffee 3))
  (class-vars (name 'coffee)))

(define-class (big-mac)
  (parent (food 'big-mac 20))
  (class-vars (name 'big-mac)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Implementation of thieves for part two
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (edible? thing)
  (ask thing 'edible?))

(define-class (thief name initial-place)
  (parent (person name initial-place))
  (instance-vars
   (behavior 'steal))
  (initialize
   (ask self 'put 'strength 150))
  (method (type) 'thief)
 
  (method (notice person)
    (if (eq? behavior 'run)
	(let ((can (ask (usual 'place) 'exits)))
	 (cond ((not (equal? can '()))
		(ask self 'go (pick-random (ask (usual 'place) 'exits))))
	       (else (newline)
		     (display " Can't get out ")
		     (newline)))) 
	(let ((food-things
	       (filter (lambda (thing)
			 (and (edible? thing)
			      (not (eq? (ask thing 'possessor) self))))
		       (ask (usual 'place) 'things))))
	  (if (not (null? food-things))
	      (begin
	       (ask self 'take (car food-things))
	       (set! behavior 'run)
	       (ask self 'notice person)) )))) )

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility procedures
;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; this next procedure is useful for moving around

(define (move-loop who)
  (newline)
  (print (ask who 'exits))
  (display "?  > ")
  (let ((dir (read)))
    (if (equal? dir 'stop)
	(newline)
	(begin (ask who 'go dir)
	       (move-loop who)))))


;; One-way paths connect individual places.

(define (can-go from direction to)
  (ask from 'new-neighbor direction to))


(define (announce-take name thing)
  (newline)
  (display name)
  (display " took ")
  (display (ask thing 'name))
  (newline))

(define (announce-move name old-place new-place)
  (newline)
  (newline)
  (display name)
  (display " moved from ")
  (display (ask old-place 'name))
  (display " to ")
  (display (ask new-place 'name))
  (newline))

(define (have-fit p)
  (newline)
  (display "Yaaah! ")
  (display (ask p 'name))
  (display " is upset!")
  (newline))


(define (pick-random set)
  (nth (random (length set)) set))

(define (delete thing stuff)
  (cond ((null? stuff) '())
	((eq? thing (car stuff)) (cdr stuff))
	(else (cons (car stuff) (delete thing (cdr stuff)))) ))

;(define (person? obj)
;  (and (procedure? obj)
;       (member? (ask obj 'type) '(person police thief))))
;
;(define (thing? obj)
;  (and (procedure? obj)
;       (eq? (ask obj 'type) 'thing)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;some user-defined utility
;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (show-people aplace)
  (map (lambda (x)
	 (ask x 'name))
       (ask aplace 'people)))

(define (show-things people)
  (map (lambda (x)
	 (ask x 'name))
       (ask people 'possessions)))

(define (whereis people)
  (ask (ask people 'place) 'name))

(define (owner thing)
  (let ((f (ask thing 'possessor)))
    (if (word? f)
	f
	(ask f 'name))))

(define (find-neighbor aplace)
  (let ((alist (ask aplace 'directions-and-neighbors)))
    (define (find-one arg)
      (list (car arg)
	    (ask (cdr arg) 'name)))
    (map find-one alist)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;  Data for adventure game.
;;; This file is adv-world.scm
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; setting up the world
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define Soda (instantiate place 'Soda))
(define DYC-Office (instantiate place 'DYC-Office))
(define MJC-Office (instantiate place 'MJC-Office))
(define 61A-Lab (instantiate place '61A-Lab))
(define art-gallery (instantiate place 'art-gallery))
(define Lewis (instantiate place 'Lewis))
(define Sproul-Plaza (instantiate place 'Sproul-Plaza))
(define Telegraph-Ave (instantiate place 'Telegraph-Ave))
(define Noahs (instantiate restaurant 'Noahs bagel 1.0))
(define Coffee-shop (instantiate restaurant 'coffee-shop coffee 1.5))
(define Intermezzo (instantiate place 'Intermezzo))
(define s-h (instantiate place 'sproul-hall))
(define heaven (instantiate locked-place 'heaven))
(define jail (instantiate place 'jail))

(can-go Soda 'up art-gallery)
(can-go art-gallery 'down Soda)
(can-go art-gallery 'west DYC-Office)
(can-go DYC-Office 'east art-gallery)
(can-go art-gallery 'east MJC-Office)
(can-go MJC-office 'west art-gallery)
(can-go Soda 'down 61A-Lab)
(can-go 61A-Lab 'up Soda)
(can-go Soda 'south Lewis)
(can-go Lewis 'north Soda)
(can-go Lewis 'south Sproul-Plaza)
(can-go Sproul-Plaza 'north Lewis)
(can-go Sproul-Plaza 'south Telegraph-Ave)
(can-go Sproul-Plaza 'east s-h)
(can-go s-h 'west Sproul-Plaza)
(can-go Telegraph-Ave 'north Sproul-Plaza)
(can-go Telegraph-Ave 'south Noahs)
(can-go Noahs 'north Telegraph-Ave)
(can-go Noahs 'south Intermezzo)
(can-go Noahs 'up coffee-shop)
(can-go coffee-shop 'down noahs)
(can-go Intermezzo 'north Noahs)
(can-go soda 'death heaven)
(can-go heaven 'rebirth soda)


(define (sproul-hall-exit count)
    (lambda ()
      (if (< count 3)
	  (begin (set! count (+ 1 count))
		 (error "You can check out any time you'd like, but you can never leave"))
	  (display "You may leave now"))))
(define exit-1 (sproul-hall-exit 0))

(define (dyc-office-exit)
  (print "Who's your favorite instructor?")
  (let ((answer (read)))
    (cond ((or (eq? answer 'DYC) (eq? answer 'David)) (print "Thanks!"))
	  ((or (eq? answer 'Bryan) (eq? answer 'Lai) (eq? answer 'Erik) 
	       (eq? answer 'Todd) (eq? answer 'Jeremy) (eq? answer 'Will))
	   (print "I'll let them know!"))
	  ((eq? answer 'Brenda) (print "I'm quite fond of her too..."))
	  (else (begin (newline) (dyc-office-exit))))))
    

(ask s-h 'add-entry-procedure
 (lambda () (print "Miles and miles of students are waiting in line...")))
(ask s-h 'add-exit-procedure exit-1)
(ask DYC-Office 'add-exit-procedure dyc-office-exit)
(ask Noahs 'add-entry-procedure
 (lambda () (print "Would you like lox with it?")))
(ask Noahs 'add-exit-procedure
 (lambda () (print "How about a cinnamon raisin bagel for dessert?")))
(ask Telegraph-Ave 'add-entry-procedure
 (lambda () (print "There are tie-dyed shirts as far as you can see...")))
(ask 61A-Lab 'add-entry-procedure
 (lambda () (print "The computers seem to be down")))
(ask 61A-Lab 'add-exit-procedure
 (lambda () (print "The workstations come back to life just in time.")))

;; Some things.

;(define bagel (instantiate thing 'bagel))
;(ask Noahs 'appear bagel)

;(define coffee (instantiate thing 'coffee))
;(ask Intermezzo 'appear coffee)

(define b1 (instantiate bagel))
(ask soda 'appear b1)
(define c1 (instantiate coffee))
(ask soda 'appear c1)
(define b2 (instantiate bagel))
(ask soda 'appear b2)
(define rock (instantiate thing 'rock))
(ask soda 'appear rock)


;; Some people.

(define David (instantiate person 'David DYC-Office))
(define Brenda (instantiate person 'Brenda DYC-Office))
(define hacker (instantiate person 'hacker 61A-lab))
(define nasty (instantiate thief 'nasty sproul-plaza))
(define simon (instantiate person 'simon noahs))
(define cop (instantiate police 'cop lewis))