;;; File: shopping.lisp -*- Mode: Lisp; Syntax: Common-Lisp; -*-

;;;; The Shopping World: Top Level Functions

(defun run-shopping (&key (agents (list (shopping-agent 'A)))
                          (max-steps 200) (display 'unchanged)
                          (env (make-shopping-world :agents agents)))
  "Run an agent in a shopping world."
  (run-eval-environment env :max-steps max-steps :display display))

;;;; New Structures

(defstruct (credit-card (:include object (name "$"))))
(defstruct (food (:include object (shape :round) (size .1) (name 'f))))
(defstruct (tomato (:include food (color 'red) (size .08) (name 't))))
(defstruct (lettuce (:include food (color 'green) (size .09) (name 'l))))
(defstruct (onion (:include food (color 'yellow) (size .07) (name 'o))))
(defstruct (orange (:include food (color 'orange) (size .07) (name 'o))))
(defstruct (apple (:include food (color 'red) (size .07) (name 'a))))
(defstruct (grapefruit (:include food (color 'yellow) (size .1) (name 'g))))
(defstruct (sign (:include object (name 'S) (size .09)
                  (color '(white (with black)))))
  (words '()))
(defstruct (cashier-stand (:include object (color '(black (with chrome))) 
		           (shape 'flat) (size .9) (name 'C))))
(defstruct (cashier (:include agent-body (name "c"))))
(defstruct (seeing-agent-body (:include agent-body (name ":")))
  (zoomed-at nil)    ; Some have a camera to zoom in and out at a location
  (can-zoom-at '((0 0) (0 +1) (+1 +1) (-1 +1)))
  (visible-offsets '((0 +1) (+1 +1) (-1 +1))))
(defstruct (shopper (:include seeing-agent-body (name "@")
                     (contents (list (make-credit-card)))
                     (legal-actions '(forward turn zoom grab release)))))
;;;; Percepts

(defun shopping-percept-fn (agent env)
  "The percept is a sequence of sights, touch (i.e. bump), and sounds."
  (list (see agent env)	(feel agent env) (hear agent env)))

(defun feel (agent env)
  (declare (ignore env))
  (if (object-bump (agent-body agent)) 'bump))

(defun hear (agent env)
  ;; We can hear anything within 2 squares
  (let* ((body (agent-body agent))
         (loc (true-loc body)))
    (with-collection ()
     (for each obj in (grid-environment-objects env) do
          (when (and (object-sound obj) (near? (true-loc obj) loc))
	    (collect (object-sound obj)))))))

(defun see (agent env)
  "Return a list of visual percepts for an agent.  Note the agent's camera may
  either be zoomed out, so that it sees several squares, or zoomed in on one."
  (let* ((body (agent-body agent))
         (zoomed-at (seeing-agent-body-zoomed-at body)))
    (mappend #'(lambda (offset)
		 (see-loc (absolute-loc body offset) env zoomed-at))
	     (seeing-agent-body-visible-offsets body))))

(defun see-loc (loc env zoomed-at)
  (let ((objects (grid-contents env loc)))
    (if zoomed-at
        (mappend #'appearance objects)
      (summarize-appearance objects)))) ;???

(defun appearance (object)
  "Return a list of visual attributes: (loc size color shape words)"
  (list (object-loc object) (fuzz (object-size object)) (object-color object)
	(object-shape object) (object-words object)))

(defun object-words (object)
  (if (sign-p object)
      (sign-words object)
    nil))

(defun zoom (agent-body env offset)
  "Zoom the camera at an offset if it is feasible; otherwise zoom out."
  (declare (ignore env))
  (cond ((member offset (seeing-agent-body-can-zoom-at agent-body))
	 (setf (seeing-agent-body-zoomed-at agent-body) offset)
	 (setf (seeing-agent-body-visible-offsets agent-body) (list offset)))
	(t ;; Zoom out
	   (setf (seeing-agent-body-zoomed-at agent-body) nil)
	   (setf (seeing-agent-body-visible-offsets agent-body)
                 (remove '(0 0) (seeing-agent-body-can-zoom-at agent-body)
                         :test #'equal)))))

;;;; Updating

(defun shopping-update-fn (env)
  ;; Sounds dissipate:
  (for each object in (grid-environment-objects env) do
       (setf (object-sound object) nil))
  ;; Do each agent's action
  (simple-grid-update-fn env))

;;;; Agents

(defun shopping-agent (name &optional (program (human-shopping-program name)))
  (make-agent :name name :program program :body (make-shopper)))

(defun human-shopping-program (name)
  #'(lambda (percept)
      (format t "~&Agent ~A~%~@[Feels: ~A~%~]~{~^Hears: ~A~%~}~{~^Sees: ~A~%~}"
	      name (second percept) (third percept) (first percept))
      (format t "ACTION: ")
      (read)))


;;;; Defining Shopping Worlds

(defparameter *page250-supermarket*
    '((edge wall)   
      ((1 1) (sign :words (exit)))
      ((list (2 2) (6 2)) shopper)
      ((list (3 2) (7 2)) cashier-stand)
      ((list (4 2) (8 2) (4 7)) cashier)

      ((2 4) (sign :words (Aisle 1 Vegetables)))
      ((2 5) (-15 tomato) (sign :words (Tomatoes $ .79 lb)))
      ((2 6) (-6 lettuce) (sign :words (Lettuce $ .89)))
      ((2 7) (-8 onion)   (sign :words (Onion $ .49 lb)))

      ((3 4) (sign :words (Aisle 2 Fruit)))
      ((3 5) (-12 apple)  (sign :words (Apples $ .69 lb)))
      ((3 6) (-9 orange)  (sign :words (Oranges $ .75 lb)))
      ((3 7) (-3 grapefruit :size 0.06  :color yellow)
       (-3 grapefruit :size 0.07 :color pink)
       (sign :words (Grapefruit $ .49 each)))

      ;; The rest of the store is temporarily out of stock ...
      ((5 4) (sign :words (Aisle 3 Soup Sauces)))
      ((6 4) (sign :words (Aisle 4 Meat)))
      ((8 4) (sign :words (Aisle 5 Sundries)))
      ))

(defun make-shopping-world (&key (x-size 10) (y-size x-size)
                                 (agents (list (shopping-agent "@")))
                                 (object-specs *page250-supermarket*))
  "Build a Shopping World."
  (init-environment
   :x-size x-size :y-size y-size :name "Shopping World"
   :agents agents :object-specs object-specs 
   :update-fn #'shopping-update-fn
   :percept-fn #'shopping-percept-fn))