;;;-*- Mode: Lisp; Package: YAPS; Base: 10 -*-

;;;Date: 12 Nov 1985 09:55-EST 
;;;From: Hans.Tallis@ML.RI.CMU.EDU
;;;To: Liz Allen <liz@tove.umd.edu>
;;;Subject: Re: YAPS

;;;Liz,
;;;Here is ex.lsp, ex.dat, and yaps.l.  The first two implement your own
;;;monkey and bananas example.  Yaps.l should be able to run under Franz
;;;38.91, Symbolics 5.2, and LMI (what we call release two, I'm not sure of
;;;the exact version number.)
;;;Please send mail to me, tallis@mitre, if you get this; I don't trust our
;;;mailer that much.
;;;				--Hans
;;;--------------------------------------------------------------------------
	 

; I modified this to use the y- calls of yaps--hct...6/17/85
(p take-bananas
        (goal (has monkey bananas))
        (reach monkey -r)
        (height bananas -b)
        (location monkey -x)
        (location bananas -x)
   test (>= -r -b)
   -->  (fact has monkey bananas)
        (printline "** monkey has the bananas")
        (y-remove 1)
        )

(p get-to-bananas
        (goal (has monkey bananas))
        (height bananas -h)
        (location bananas -x)
   -->  (fact goal (reach monkey -h) (location monkey -x))
        )

(p can-begin-climb
        (goal (reach monkey -h) (location monkey -x))
        (size monkey -s)
        (location monkey -)
   test (>= -s -h)
   -->  (y-remove 1)
        (fact goal (location monkey -x))
        )

(p can-reach
        (goal (reach monkey -h) (location monkey -x))
        (reach monkey -r)
        (location monkey -x)
   test (>= -r -h)
   -->  (y-remove 1)
        )

(p climb
        (goal (reach monkey -h) (location monkey -x))
        (box -b -size)
        (reach monkey -r)
        (location -b -x)
        (location monkey -x)
        (size monkey -s)
   test (>= -r -size)           ; the monkey can reach the box
        (<= -h (+ -s -size))    ; the box will put him at least as
                                ;       high as -h
        (> -h -r)               ; the monkey wants to reach higher
                                ;       than he now can
   -->  (y-remove 1 3)
        (fact reach monkey ^(+ -s -size))
        (printline "Monkey climbs onto " -b)
        (printline ":Monkey can now reach " (+ -s -size) ":")
        )

(p find-box
        (goal (reach monkey -h) (location monkey -x))
        (box -b -size)
        (size monkey -s)
   test (>= (+ -s -size) -h)    ; must be able to make reach from box
        (< -size -h)
   -->  (fact goal (reach monkey -size) (location monkey -x))
        (fact goal (location -b -x))
        )

(p at-location
        (goal (location -obj -x))
        (location -obj -x)
   -->  (y-remove 1)
        )

(p move-box
        (goal (location -b -x))
        (box -b -)
        (location monkey -y)
        (location -b -y)
   test (<> -x -y)
   -->  (y-remove 1 3 4)
        (fact location monkey -x)
        (fact location -b -x)
        (printline "Monkey pushes " -b " from " -y " to " -x)
        )

(p prepare-move-box
        (goal (location -b -x))
        (box -b -)
        (location monkey -y)
        (location -b -z)
   test (<> -x -z)
        (<> -y -z)
   -->  (fact goal (location monkey -z))
        )

(p climb-down
        (goal (location monkey -x))
        (location monkey -y)
        (reach monkey -r)
        (size monkey -s)
   test (<> -x -y)
        (<> -r -s)
   -->  (y-remove 3)
        (fact reach monkey -s)
        (printline "Monkey climbs down")
        (printline ":Monkey can now reach only " -s ":")
        )
(p move-monkey
        (goal (location monkey -x))
        (location monkey -y)
        (reach monkey -r)
        (size monkey -s)
   test (<> -x -y)
        (= -r -s)
   -->  (y-remove 1 2)
        (fact location monkey -x)
        (printline "Monkey moves from " -y " to " -x)
        )

;--------------------------------------------------------------------------