;;; *********************************************************************
;;; Susan Fox
;;; December 27, 2000

;;; File:  map.ss


;;; This file defines the features of the map as they are used
;;; by the program
;;;

;;; Requires the memory files to have been loaded

(define MAP.SSLOADED #t)

;;; *********************************************************************
;;; Block ADT

;;; This needs a Block ADT.  A Block is simply some amount of space
;;; in the world, specified by a range of x and a range of y values.
;;; Anything specific location that fits within a given block is considered
;;; to be part of that block.

;;; make-block takes four values, low and high x values, and low and
;;; high y values, and builds a block
;;;
(define make-block
  (lambda (low-x high-x low-y high-y)
    (list (list low-x high-x) (list low-y high-y))))

;;; x-range returns the x range, y-range returns the y range
;;; and low-x, high-x, low-y, high-y are self-explanatory
;;;
(define x-range car)
(define y-range cadr)
(define low-x caar)
(define high-x cadar)
(define low-y caadr)
(define high-y cadadr)


;;; midpoint-of takes a block and returns its midpoint as a coordinate
;;;
(define midpoint-of
  (lambda (block)
    (make-coord (int-average (low-x block) (high-x block))
      (int-average (low-y block) (high-y block)))))


;;; block? takes an object and returns true if it is a valid block
;;;
(define block?
  (lambda (obj)
    (and (list? obj)
	 (= (length obj) 2)
	 (list? (x-range obj))
	 (= (length (x-range obj)) 2)
	 (list? (y-range obj))
	 (= (length (y-range obj)) 2)
	 (integer? (low-x obj))
	 (integer? (high-x obj))
	 (integer? (low-y obj))
	 (integer? (high-y obj)))))

(define print-block
  (lambda (block)
    (printf "([~s->~s], [~s->~s])"
      (low-x block) (high-x block)
      (low-y block) (high-y block))))


;;; *********************************************************************
;;; Coordinate ADT

;;; Coordinates are simply x-y pairs
;;;
(define make-coord
  (lambda (x y)
    (list x y)))

(define x-val car)
(define y-val cadr)

(define coord?
  (lambda (obj)
    (and (list? obj)
	 (= (length obj) 2)
	 (integer? (x-val obj))
	 (integer? (y-val obj)))))

(define print-coord
  (lambda (obj)
    (printf "(~s,~s)" (x-val obj) (y-val obj))))

	 
;;; *********************************************************************
;;; Location ADT  This is to abstract across named locations, which
;;; are simply strings appearing in the list below, blocks,
;;; and coordinates.  It combines all three, and a location may be
;;; any of the three.

;;; location? takes a location and returns block, coord, or named
;;; depending on the type of the location.  It return #f if the object
;;; isn't a location
;;;
(define location?
  (lambda (loc)
    (cond
      [(block? loc) 'block]
      [(coord? loc) 'coord]
      [(named? loc) 'named]
      [else #f])))


;;; loc-x-value takes a location and returns an x value for it
;;; coordinates are easy, it just returns the x value
;;; blocks it takes the midpoint's x value
;;; named locations, it looks up the value and recurs
;;;
(define loc-x-value
  (lambda (location)
    (cond
      [(coord? location) (x-val location)]
      [(block? location) (x-val (midpoint-of location))]
      [(named? location) (loc-x-value (value-of-named location))]
      [else (error 'loc-x-value "Not a valid location: ~s" location)])))



;;; loc-y-value takes a location and returns an y value for it
;;; coordinates are easy, it just returns the y value
;;; blocks it takes the midpoint's y value
;;; named locations, it looks up the value and recurs
;;;
(define loc-y-value
  (lambda (location)
    (cond
      [(coord? location) (y-val location)]
      [(block? location) (y-val (midpoint-of location))]
      [(named? location) (loc-y-value (value-of-named location))]
      [else (error 'loc-y-value "Not a valid location: ~s" location)])))

;;; print-location takes a location and prints it appropriately
;;;
(define print-location
  (lambda (loc)
    (cond
      [(coord? loc) (print-coord loc)]
      [(block? loc) (print-block loc)]
      [(named? loc) (display loc)]
      [else (printf "??~s??" loc)])))


;;; *********************************************************************
;;; Named positions in the map

;;; Accessors for individual entries in the list below
(define named-name car)
(define named-value cadr)

;;; an object is a named location if it is in the named-locations
;;; list
;;;
(define named?
  (lambda (obj)
    (and (symbol? obj)
	 (assoc obj named-locations))))


;;; value-of-name takes a named location description and returns the
;;; location associated with it
;;;
(define value-of-name
  (lambda (name)
    (let ([entry (assoc name named-locations)])
      (if (not entry)
	  #f
	  (named-value entry)))))


;;; print-named-locations prints out the list below
;;;
(define print-named-locations
  (lambda ()
    (letrec ([printer
	       (lambda (lst)
		 (if (null? lst)
		     (newline)
		     (begin
		       (printf "~s~n" (named-name (car lst)))
		       (printer (cdr lst)))))])
      (printer named-locations))))



(define named-locations
  (list
    ;; -----------------------------------------------
    ;; Corridors first
    ;; -----------------------------------------------
    ;; First, the east-end, north/south hallway in Olin
    (list 'east-olin-hallway (make-block 0 100 50 55)) 
    ;; Then the three east/west hallways in Olin
    (list 'north-olin-hallway (make-block 0 100 50 55))
    (list 'mid-olin-hallway (make-block 0 100 50 55))
    (list 'south-olin-hallway (make-block 0 100 50 55))

    ;; East/west hallways in Rice
    (list 'northmost-rice-hallway (make-block 0 100 50 55))
    (list 'north-atrium-rice-hallway (make-block 0 100 50 55))
    (list 'mid-atrium-rice-hallway (make-block 0 100 50 55))
    (list 'south-atrium-rice-hallway (make-block 0 100 50 55))
    ;; North/south hallways in Rice
    (list 'eastmost-rice-hallway (make-block 0 100 50 55))
    (list 'mid-rice-hallway (make-block 0 100 50 55))
    (list 'westmost-rice-hallway (make-block 0 100 50 55))
    (list 'office-rice-hallway (make-block 0 100 50 55))
    ;; -----------------------------------------------
    ;; The Atrium
    ;; -----------------------------------------------
    (list 'atrium (make-block 0 100 50 55))
    ;; -----------------------------------------------
    ;; Classrooms on north side Olin
    ;; -----------------------------------------------
    (list 'olri-241 (make-block 0 100 50 55))
    (list 'olri-243 (make-block 0 100 50 55))
    (list 'olri-245 (make-block 0 100 50 55))
    ;; -----------------------------------------------
    ;; Office on south side Olin
    ;; -----------------------------------------------
    (list 'olri-230 (make-block 0 100 50 55))
    ))