;;;
;;; MIT 6.001                                    Fall, 2002
;;; PROJECT 2
;;;
;;;                           Code file SETUP.SCM


    
;;;============================================================================
;;; You can extend this file to make more stuff part of your world.
    
;;;============================================================================


(define (create-rooms)
  ;; creates the rooms in the house and returns a list of them

  (let ((library
	 (create-place 'library
		       "carefully arranged library with stacks and stacks of books!"))
	(ballroom
	 (create-place 'ballroom
		       "ballroom.  Care to dance?"))
	(kitchen
	 (create-place 'kitchen
		       "clean kitchen filled with delicious scents and aromas!"))
	(conservatory
	 (create-place 'conservatory
		       "conservatory.  Do you feeling like singing?"))
	(dining-room
	 (create-place 'dining-room
		       "spacious and tastefully decorated dining room"))
	(billiard-room
	 (create-place 'billiard-room
		       "billiard room.  Game of pool anyone?"))
	(study
	 (create-place 'study
		       "quiet study room. Shhh!"))
	(lounge
	 (create-place 'lounge
		       "nice relaxing place.  Ahh!"))
	(foyer
	 (create-place 'foyer
		       "huge magnificent foyer"))
	(hall
	 (create-place 'hall
		       "large and grandiose the reception room")))

    (let ((key-card
	   (create-mobile-thing 'key-card conservatory "a coded key card, like you
    find in a fancy hotel."))
	  (brass-key
	   (create-mobile-thing 'brass-key dining-room "a huge, ornate, brass key, 
    with lots of intricate curves."))
	  (scrap-of-paper
	   (create-mobile-thing 'scrap-of-paper study "a folded, creased and spindled
    pieced of paper.  On it is written 1 9 8 3."))
	  (paper-clip
	   (create-mobile-thing 'paper-clip ballroom "a paper clip, bent into a funny 
    shape.")))
        
      ;; Now for the connectedness...
      (create-exit foyer 'north hall 'south #f #f)
      (create-exit foyer 'east dining-room 'west #f #f)
      (create-exit foyer 'south ballroom 'north #f #f)
      (create-exit study 'south library 'north #f #f)
      (create-exit study 'east hall 'west #f #f)
      (create-exit study 'secret-passage kitchen 'secret-passage
		   (lambda (self person)
		     (if (memq scrap-of-paper
			       (ask person 'things))
			 (begin
			   (ask self 'change-state)
			   (ask screen 'tell-room (ask person 'location)
				(list (ask person 'name) "types the numbers on the 
    scrap of paper onto the key pad recessed into the wall.  With a grinding of gears,
    the bookshelf slides, exposing a secret passage")))
			 #f))
		   (lambda (self person)
		     (if (memq  paper-clip
				(ask person 'things))
			 (begin
			   (ask self 'change-state)
			   (ask screen 'tell-room (ask person 'location)
				(list (ask person 'name) "inserts the paper clip into 
    the door recessed into the wall.  With a silent puff of air, the door moves,
    exposing a secret passage")))
			 #f)))
      (create-exit library 'south billiard-room 'north #f #f)
      (create-exit billiard-room  'south conservatory 'north #f #f)
      (create-exit conservatory 'east ballroom 'west #f #f)
      (create-exit conservatory 'secret-passage lounge 'secret-passage
		   (lambda (self person)
		     (if (memq  key-card
				(ask person 'things))
			 (begin
			   (ask self 'change-state)
			   (ask screen 'tell-room (ask person 'location)
				(list (ask person 'name) "inserts the key card into 
    the slot in the wall.  With a dusty sigh, the fireplace moves, exposing a secret
    passage")))
			 #f))
		   (lambda (self person)
		     (if (memq brass-key
			       (ask person 'things))
			 (begin
			   (ask self 'change-state)
			   (ask screen 'tell-room (ask person 'location)
				(list (ask person 'name) "inserts the huge brass key
    into the door recessed into the wall.  With an ear-wrench squeal, the door moves, 
    exposing a secret passage")))
			 #f)))
      (create-exit ballroom 'east kitchen 'west #f #f)
      (create-exit kitchen 'north dining-room 'south #f #f)
      (create-exit dining-room 'north lounge 'south #f #f)
        
      ;; put things in the rooms
      (create-thing 'piano conservatory 
		    "a fine Steinway grand piano!")
      (create-thing 'rembrandt hall 
		    "one of Rembrandt's masterpieces!")
      (create-thing 'refrigerator kitchen 
		    "definitely GE!")
      (create-thing 'globe study 
		    "a rather spherical globe..")
      (create-thing 'chandelier ballroom 
		    "made of many sparkling crystals!")
      (create-thing 'pool-table billiard-room 
		    "quite a respectable pool table.." )
      (create-thing 'bookshelf library 
		    "packed with books!")
      (create-thing 'couch lounge 
		    "quite a comfy looking chair, perfect for lounging in.")
      (create-thing 'china-cabinet dining-room 
		    "a sturdy mahogany cabinet, currently empty.")

      
      (list foyer study library billiard-room conservatory kitchen ballroom
	    dining-room hall lounge))))
        
(define (create-people birthplace the-cast details)
  ;; creates all the Clue characters, choosing one of them to be a murderer
  (define create-character
    (let ((index 0)
	  (killer-index (+ 1 (random (length the-cast)))))
      (lambda (name laziness miserly description)
	(set! index (+ index 1))
	(if (= index killer-index) 
	    (begin
	      (ask screen 'TELL-WORLD
		   (list "Killer is:" name))
	      (create-killer name birthplace laziness miserly details description))
	    (create-autonomous-player name birthplace laziness
				      miserly description)))))
  (map (lambda (params)
	 (apply create-character params))
       the-cast))

(define (create-weapons birthplace)
  (let ((candlestick-holder (create-mobile-thing 'candlestick-holder birthplace

                                                 "crafted of fine brass..."))
	(lead-pipe (create-mobile-thing 'lead-pipe birthplace 
					"a sturdy pipe, roughly 2.5 feet long.."))
	(revolver (create-mobile-thing 'revolver birthplace 
		       "a miniature gun, but don't let it's size deceive you..."))
	(knife (create-mobile-thing 'knife birthplace 
				    "supposedly stainless..." ))
	(wrench (create-mobile-thing 'wrench birthplace 
				     "sturdy and quite heavy.."))
	(rope (create-mobile-thing 'rope birthplace 
				   "delicate and fine, yet it'll do the trick..")))
    (list candlestick-holder lead-pipe revolver knife wrench rope)))

(define (put-in-random-location list-of-entities locations entity-type)
  ;; place list of entities in random locations
  (if (null? list-of-entities)
      'done
      (let ((random-place (pick-random locations)))
	(cond ( (eq? entity-type 'person)
		(ask (car list-of-entities) 'MOVE-TO random-place) )
	      ( (eq? entity-type 'object)
		(ask (car list-of-entities) 'CHANGE-LOCATION random-place)))
	(put-in-random-location (cdr list-of-entities) locations entity-type))))

(define (details)
  ;; for recording the details of the murder
  ;; written in message passing style, but not an object in our system
  (let ((murder-room 'nowhere)
	(murder-weapon 'nothing)
	(murderer 'noone))
    (lambda (message)
      (case message
	((SET) (lambda (r w m)
		 (set! murder-room r)
		 (set! murder-weapon w)
		 (set! murderer m)))
	((CHECK) (lambda (r w m)
		   (and (eq? murder-room r)
			(eq? murder-weapon w)
			(eq? murderer m))))))))
(define (setup name)
  (ask clock 'reset)
  (ask clock 'ADD-CALLBACK
       (make-clock-callback 'tick-printer clock 'PRINT-TICK))
  (let ((rooms (create-rooms))
	(murder-details (details))
	(the-cast '((mrs-peacock 3 3 "a mystery how she can glide about
    effortlessly and silently in those heels..")
		    (colonel-mustard 6 2 "unnerving when he stares at you..")
		    (miss-scarlet 4 2 "strange how she will not look you in
the eye..")
		    (professor-plum 4 3 "chilling when he laughs and rubs
his hands together..")
		    (mr-green 3 4 "bizarre, but you feel something is out
of place.. something that you can't quite identify..")
		    (mrs-white 5 3 "surprising how many secrets this
widow holds.."))))
        
    ;; The initial point of no return
    (set! heaven (create-place 'heaven "place with no exits"))
        
    ;; The important critters in our world...
    (let ((people (create-people heaven the-cast murder-details))
	  (weapons (create-weapons heaven))
	  (the-avatar (create-avatar name heaven murder-details
				     "no doubt someone who is as handsome as you!")))

      (set! me the-avatar)
      (set! *weapons* weapons)
      (set! *the-cast* people)
      (set! death-exit (make-exit #f 'heaven heaven #f))
      (ask screen 'set-me me)
          
          
      ;; put people and weapons in random places
      (put-in-random-location people rooms 'person)
      (put-in-random-location weapons rooms 'object)
      (put-in-random-location (list the-avatar) rooms 'person)

      ;;      (initialize-the-house)

      ;; add here whatever you want to use to install new objects in rooms

      'ready)))

(define death-exit 'will-be-set-by-setup)
(define heaven 'will-be-set-by-setup)
(define me 'will-be-set-by-setup)
(define *weapons* 'will-be-set-by-setup)
(define *the-cast* 'will-be-set-by-setup)

;;; To start, do (setup 'George-Spelvin) or whatever!