;;;
;;; adventure.ss
;;; UVA CS200 Spring 2004
;;; Problem Set 6
;;;
;;; This file defines the people, places and things in Charlottansville.
;;; You can extend this file to make more stuff part of your world.
;;;

(display "Loading adventure.ss...")

(define (is-compass-direction direction)
  (or (eq? direction 'north)
      (eq? direction 'south)
      (eq? direction 'east)
      (eq? direction 'west)))

;;;
;;; One-way paths connect individual places in the world.
;;; 

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

;;;
;;; Two-way paths mutually connect two individual places.
;;;

(define (can-go-both-ways from direction reverse-direction to)  ;; two-way path
  (can-go from direction to)
  (can-go to reverse-direction from))

;;;
;;; Note that all the steam tunnels have the same name - its
;;; easy to get lost in the tunnels if you are not careful!
;;;

(define (make-tunnel place)
  (let ((ptunnel (make-place 'Steam-Tunnel))
	(place-connections (ask place 'neighbors)))
    ;; up and down to the tunnels
    (can-go-both-ways place 'down 'up ptunnel)))

;;;
;;; This must be done after all tunnels have been
;;; made (with make-tunnel).
;;;

(define (connect-tunnels place)
  (let ((ptunnel (ask place 'neighbor-towards 'down)))
    (if ptunnel
	;; if the place has a tunnel, connect the tunnel to
	;; the places below all places this place is connected to
	(map
	 (lambda (exit)
	     ;;; For each exit that is a compass direction,
	     ;;; connect the steam tunnels
	   (if (is-compass-direction exit)
	       (let ((place-below (ask (ask place 'neighbor-towards exit) 'neighbor-towards 'down)))
		 (if place-below
		     (can-go ptunnel exit place-below)))))
	 (ask place 'exits)))))

;;;
;;; This procedure sets up Charlottansville:
;;;    
;;;                                                 Cricket-Street
;;;  
;;;                                                   Cdrs-Hill
;;;
;;; Cloakner-Stadium  U-Haul [bus]                 University-Ave  Downtown-Maul
;;;
;;;                                                      Recursa (contains Lambda-Dome)
;;;
;;; New-Dorms Old-Dorms Oldbrushe-Hall  Somdergal-Library  Green
;;;
;;;                                                     Bart-Statue
;;; 
;;;                                                     Cabal-Hall

;;; We put the places in the global environment, so it is easy to refer to them.

(define Cabal-Hall        (make-place 'Cabal-Hall))        ; Where conspirators scheme
(define Bart-Statue       (make-place 'Bart-Statue))       ; Son of Homer
(define Green             (make-place 'Green))             ; World famous lawn
(define Recursa           (make-place 'Recursa))           ; Hub of all knowledge and honor
(define Lambda-Dome       (make-place 'Lambda-Dome))       ; Dome of infinite wisdom
(define University-Ave    (make-place 'University-Ave))    ; Its just a street
(define Cdrs-Hill         (make-place 'Cdrs-Hill))         ; Home of the University President
(define Cricket-Street    (make-place 'Cricket-Street))    ; Known for its sticky wickets
(define Downtown-Maul     (make-place 'Downtown-Maul))     ; Only the brave venture here
(define U-Haul            (make-place 'U-Haul))            ; Rumored to have ghosts of blue devils
(define Oldbrushe-Hall    (make-place 'Oldbrushe-Hall))    ; Charlottansville's finest dining establishment
(define Old-Dorms         (make-place 'Old-Dorms))         ; Students live here
(define New-Dorms         (make-place 'New-Dorms))         ; Students live here
(define Cloakner-Stadium  (make-place 'Cloakner-Stadium))  ; Sometimes misprounounced "Clockner", but the o: is like in Go:del
(define Somdergal-Library (make-place 'Somdergal-Library)) ; Named for the Univeristy's first president
(define Jail              (make-place 'Jail))              ; Where students caught streaking are sent

(define (set-up-charlottansville)
  (let ((all-places ;;; All the places in Charlottansville
	 (list Green Cabal-Hall Recursa Lambda-Dome University-Ave
	       Cdrs-Hill Downtown-Maul U-Haul Oldbrushe-Hall
	       Old-Dorms New-Dorms Cricket-Street Cloakner-Stadium 
	       Bart-Statue Somdergal-Library))
	(places-with-tunnels ;;; Under most places there are steam-tunnels
	 (list Green Bart-Statue Cabal-Hall Recursa 
	       Somdergal-Library Oldbrushe-Hall Old-Dorms New-Dorms)))
    ;;; Reset all the places
    (map (lambda (place) (ask place 'reset)) all-places)

    ;;; Connect the places geographically
    (can-go-both-ways Green 'south 'north Bart-Statue)
    (can-go-both-ways Bart-Statue 'south 'north Cabal-Hall)
    (can-go-both-ways Green 'north 'south Recursa)
    (can-go-both-ways Recursa 'north 'south University-Ave)
    (can-go-both-ways University-Ave 'north 'south Cdrs-Hill)
    (can-go-both-ways Cdrs-Hill 'north 'south Cricket-Street)
    
    (can-go-both-ways University-Ave 'bus-eastbound 'bus-westbound Downtown-Maul)
    (can-go-both-ways University-Ave 'bus-westbound 'bus-eastbound U-Haul)
    (can-go-both-ways U-Haul 'west 'east Cloakner-Stadium)
    
    (can-go-both-ways Green 'west 'east Somdergal-Library)
    (can-go-both-ways Somdergal-Library 'west 'east Oldbrushe-Hall)
    (can-go-both-ways Oldbrushe-Hall 'west 'east Old-Dorms)
    (can-go-both-ways Old-Dorms 'west 'east New-Dorms)
    
    (can-go Recursa 'enter Lambda-Dome)
    (can-go-both-ways Lambda-Dome 'south 'north Lambda-Dome)
    (can-go-both-ways Lambda-Dome 'east 'west Lambda-Dome)
    
    ;;; Make the steam tunnels
    (map make-tunnel places-with-tunnels)     ;;; Make all the tunnels
    (map connect-tunnels places-with-tunnels) ;;; Connect all the steam tunnels
    'Welcome-to-Charlottansville)
  )

(define clock (make-world-clock))

(define (install-object object place)
  (ask object 'install place)
  (ask clock 'add object))

(define Evan-Davis (make-person 'Evan-Davis)) 
(define Jeffus-Thomasson (make-person 'Jeffus-Thomasson))
(define Officer-Krispy (make-person 'Officer-Krispy))

(define (read-command)
  (let ((command '()) ;;; list of symbols
	(word '()))   ;;; list of chars
    (define (read-one-char)
      (let ((c (read-char)))
	(case c
	  ((#\newline) 
	   (set! command (append command (list (string->symbol (list->string word)))))
	   #f)
	  ((#\space) 
	   (set! command (append command (list (string->symbol (list->string word)))))
	   (set! word '())
	   #t)
	  (else
	   (set! word (append word (list c)))
	   #t))))
    (define (read-until-done)
      (if (read-one-char)
	  (read-until-done)
	  #t))
    (display "what now? > ")
    (read-until-done)
    command))

(define (play-interactively-as character)
  (let ((commands (read-command)))
    (if (null? commands)
	(begin 
	  (display "What was that?")
	  (play-interactively-as character))
	(let ((message (car commands)))
	  (if (eq? message 'quit)
	      (display "Better luck next time.  Play again soon!")
	      (begin
		(if (has-method? character message)
		    (begin
		      (let ((result
			     (case (length commands)
			       ((1) (ask character (car commands)))
			       ((2) (ask character (car commands) (cadr commands)))
			       ((3) (ask character (car commands) (cadr commands) (caddr commands)))
			       (else 
				(display "Sorry too many command parameters!")))))
			(if (not (void? result))
			    (printf "< Result: ~a>~n" result)))
		      (ask clock 'tick)) ; after every move time advances
		    (display-message (list "Sorry, I don't know how to " message ".")))
		(play-interactively-as character)))))))

;;;
;;; The beginning of an ever-expanding game script
;;; 

(define (play-game-first)
  (set-up-charlottansville)

  ;;; Put some people in our world
  
  (install-object Evan-Davis Cabal-Hall)
  (install-object Jeffus-Thomasson Cdrs-Hill)
  (install-object Officer-Krispy Green)
  
  ;;; Start playing
  (play-interactively-as Jeffus-Thomasson)
  )

;;;
;;; This version of play game depends on you defining make-student and make-police-officer first:
;;;

(define (play-game)
  (let ((aph (make-student 'alyssa-p-hacker))
	(ben (make-student 'ben-bitdiddle))
	(krumpke (make-police-officer 'officer-krumpke)))
    (set-up-charlottansville)
    (install-object aph green)
    (ask ben 'make-restless 0.333)
    (install-object ben cdrs-hill)
    (ask krumpke 'make-restless 0.5)
    (install-object krumpke bart-statue)
    
    ;;; Start playing
    (play-interactively-as aph)
    )
  )

(display "Done.")
(newline)