```;;;   specs  =>  (spec...)
;;;   spec   =>  (AT where what...) | (* n spec...) | what
;;;   where  =>  EDGE | ALL | FREE? | START | (x y) | (AND where...)
;;;   what   =>  object | type | (type arg...) | (* n what...)  | (P x what...)
;;;   n      =>  integer | (+- integer integer)
;;;
;;; The location FREE? means a randomly chosen free loc, ALL means every loc.
;;; If no location is specified, the default is START for agents, FREE?
;;; otherwise.
;;;
;;; Examples of spec:
;;;
;;;  (at edge wall)                  1 wall in every perimeter location
;;;  (at free? wumpus)               1 wumpus in some random free location
;;;  wumpus                          Same as above
;;;  (* 2 apple)                     An apple in each of 2 random locations
;;;  (* 2 (apple :color green))      A green apple in each of 2 random locs
;;;  (at all (p 0.25 dirt))          All free locations have 1/4 chance of dirt
;;;  (at (2 3) (* 8 apple) sign)     Location (2 3) has 8 apples and a sign
;;;  (* (+- 10 4) apple)             10 plus or minus 4 (at random) apples
;;;  (at (and (1 2) (1 4)) cashier)  These two locations each get a cashier
;;;  (* 2 smoke fire)                2 random locs get both smoke and fire
;;;```
(defun parse-specs (env specs) "Place objects, defined by specs, in the environment." (for each spec in specs do (parse-spec env spec))) (defun parse-spec (env spec) (case (op spec) (AT (parse-where env (arg1 spec) (rest (args spec)))) (* (for i = 1 to (parse-n (arg1 spec)) do (parse-specs env (rest (args spec))))) (t (parse-what env nil spec)))) (defun parse-where (env where whats) (cond ((eq where 'EDGE) (let ((x-size (xy-x (grid-environment-size env))) (y-size (xy-y (grid-environment-size env)))) (for i = 0 to (- x-size 1) do (parse-whats env (@ i 0) whats) (parse-whats env (@ i (- y-size 1)) whats)) (for i = 1 to (- y-size 2) do (parse-whats env (@ 0 i) whats) (parse-whats env (@ (- x-size 1) i) whats)))) ((eq where 'ALL) (dotimes (x (xy-x (grid-environment-size env))) (dotimes (y (xy-y (grid-environment-size env))) (when (free-loc? (@ x y) env) (parse-whats env (@ x y) whats))))) ((eq where 'FREE?) (parse-whats env (random-loc env :if 'free-loc?) whats)) ((eq where 'START) (parse-whats env (grid-environment-start env) whats)) ((xy-p where) (parse-whats env where whats)) ((eq (op where) 'AND)(for each w in (args where) do (parse-where env w whats))) (t (warn "Unrecognized object spec ignored: ~A" `(at ,where ,@whats))))) (defun parse-whats (env loc what-list) (for each what in what-list do (parse-what env loc what))) (defun parse-what (env loc what) "Place the objects specified by WHAT-LIST at the given location The default location is START for an agent, random otherwise. The notation (P 0.5 what...) means 50% chance of placing each what, and (* n what...) means place n copies of each what." (case (op what) (* (for i = 1 to (parse-n (arg1 what)) do (parse-whats env loc (rest (args what))))) (P (for each w in (rest (args what)) do (when (< (random 1.0) (arg1 what)) (parse-what env loc w)))) (t (let* ((object (if (object-p what) what (apply #'make (op what) (args what)))) (location (or loc (if (agent-p object) (grid-environment-start env) (random-loc env :if #'free-loc?))))) (place-object object location env t))))) (defun parse-n (n) (if (eq (op n) '+-) (round (+ (arg1 n) (random (float (arg2 n))) (- (random (float (arg2 n)))))) n)) (defun make (type &rest args) "Make an instance of the specified type by calling make-TYPE." (apply (concat-symbol 'make- type) args)) (defun random-loc (env &key (if #'true) (tries 100)) "Return a random loc, somewhere in the environment. The loc must satisfy the :IF predicate. If it can't find such a location after a number of TRIES, it signals an error." (or (for i = 1 to tries do (let ((loc (mapcar #'random (grid-environment-size env)))) (when (funcall if loc env) (RETURN loc)))) (error "Can't find a location."))) (defun free-loc? (loc env) "A location is free if there is no obstacle there and it is not the start." (and (not (find-object-if #'obstacle-p loc env)) (not (equal loc (grid-environment-start env)))))