;  This file is small example of the GUS system.  It only includes the
;  process of building the knowledge and does not include the English
;  input and output support.  The sample program is run by calling the
;  function CALL_TO_GUS.  This function activates a copy of the root frame
;  TRIPPLAN.  This frame then activates copies of the rest of the tree of
;  frames.  The if-needed triggers in each frame are stroked.  These
;  triggers then ask for information and activate copies of other nodes
;  in the tree.  The tree is built using the slots CHILDREN and PARENT.
;  Each parent will have a list of all of its direct children frame in
;  its slot CHILDREN.  Each direct child will have its parent's frame
;  name in its slot PARENT.  In addition the child will have have a
;  PARENT_SLOT slot to indicate which slot of the parent is a child of.
;  
;  The program is designed so it can be rerun, each time it is run
;  it collects a distinct set of information.  To support this rerunning,
;  the prototype frames can not be directly modified.  As information is
;  collected for a frame, a copy of the frame is created (FISTANTIATE).
;  The function FISTANTIATE returns the name of the created frame and
;  links the two frames.  The prototype frame has a slot INSTANCES with
;  the name of the new copy e.g. (instances ($value f00007)).  The mew
;  copy has a TYPE slot indicating the frame it was created from e.g.
;  (type ($value (tripspecification))).  This TYPE slot indicates that
;  the frame is to inherit all values currently found in the specified
;  frame.  These instantiated frames will then be the depository for all
;  of the information collected from the user.
;  
;  The function CALL_TO_GUS instantiates a copy of the frame TRIPPLAN and
;  then invokes the function TREE_AND_SLOT_WALK.  Once that function has
;  created copies of the prototype frames and filled in the values,
;  CALL_TO_GUS prints a short report of the collected data.   This report
;  is made by also using the function TREE_AND_SLOT_WALK.  The function
;  CALL_TO_GUS strokes all of the if-needed triggers. Stroking a trigger
;  causes the code in the trigger to run.  Although any code can be
;  placed in the trigger, typically the code will be:
;  a PROMPT_FOR to ask for a value from the user to place in the slot,
;  an ADD_CHILD to build up the tree, or  a FPUT to place a value in the
;  slot.  All of these can use the values in FRAME- and SLOT- which
;  contain the name of the current frame and slot respectably.
;  
;  Following is a summary of major functions in this program and then
;  some general function found in our version of the FRL system.
;  
;    (create_child_instence prototype-frame-name)
;          instantuate prototpye-frame-name and call
;          add_child to add the new frame into the hierarchy
;
;    (add_child parent-frame parent-slot child-frame)
;          interconnect the two specified frames with 
;          values in PARENT and CHILDREN slots.  In addition
;          the name of the child-frame will be stored in
;          the parent-frame parent-slot.
;    
;    (request)
;           call prompt_for the current frame and slot passing as
;           the prompting message the value from the prompt_msg facet
;
;    (prompt_for frame- slot- prompt-message)
;           ask the user for a value to place in frame- slot-.  This
;           function also permits specifying other slots in the current frame
;           or other frames slots to add a value to
;    
;    (tree_and_slot_walk rootframe function)
;           walks the tree with a root of rootframe.  Each frame it walks
;           slots applying the specified function to each slot.  This can
;           be used to stroke the if-needed triggers and for other
;           operations.  The tree walk is based on the PARENT and CHILDREN 
;           slots.
;  
;    (call_to_gus)
;           runs the program and produces a short summary of the results
;  
;    (fget frame slot '$value)
;           gets the value from the specified frame slot
;  
;    (fput frame slot '$value '(a value))
;            places the value (a value) in the specified frame slot
;  
;     (fname frame)
;            gives the name of the frame. Some of the functions will give
;            a large list usable by the FRL system, but not readable to
;            us.
;  
;    (myshowall *frames*)
;            list all of the frames.  *frames* is a variable with the
;            list of all frames known to FRL
;  
;    trigger if-needed
;             stroked by fneed or in our code fneedcond
;  
;    trigger if-added
;             stroked when a value is added to the slot
;  

;(load "/keeper/doc/ai/frl.l")

(defun create_child_instance (prototype)
  (add_child frame- slot- (finstantiate prototype))
)
(defun add_child (f s child)
  (fput (fname f) 'children  '$value (fname child))
  (fput (fname child) 'parent '$value (fname f))
  (fput (fname child) 'parent_slot '$value s)
  (and s (fput f s '$value (fname child)))
)

(defun request ()
  (let ((prompt_msg (fget frame- slot- 'prompt_msg)))
    (or prompt_msg 
	(seq prompt_msg (list (fget frame- 'type '$value) slot-)))
    (prompt_for frame- slot- prompt_msg)
  )
)
(defun prompt_for (f s prompt)
  (do
    ((done (fget f s '$value) (fget f s '$value)) ;need to keep retesting
                                                  ;because other calls may set
     (val nil)
    )
    (done val)
    (print `(enter value for ,prompt))(terpri)
    (print '(please enter value as atom (no spaces) in response to question))(terpri)
    (print '(or list of (slot-name slot-value) or list of (slot-name)))(terpri)
    (setq val (read))
    (and (atom val) (setq done t)
         (fput f s '$value val)
    )
    (and (null(atom val))
     (do
      ((wf f)
       (wf (fget f 'parent '$value)(fget wf 'parent '$value))
       (ws (car var))
       (wv (cond ((eq(length var) 2)(cadr var))(t nil)))
      )
      ((or (null wf) done) nil)
      ;find if slot is in frame, is then do following
      (and
         (or (member ws (fslots wf))
             (member ws (fslots (fget wf 'type '$value)))
         )
         (progn
           (setq done t)
           (and wv (fput wf ws '$value wv))
           (or wv  (prompt_for wf ws ws))
         )
      )
    ))
    (and (null done)(null (atom val))
     (progn (print `(I could not find a slot corresponding to ,val))(terpri) t)
    )
  )
)

(defun slot_walk (rootframe function)
 (do
  (
    (wslots (setdiff(fslots (car(fget rootframe 'type '$value))) 
	       '(type instances parent children parent_slot))
	    (cdr wslots))
    (wslot nil)
  )
  ((null wslots) nil)
  ;(print `(looking at slots of ,wslots))(terpri)
  (setq wslot (car wslots))
  (setq slot- wslot)
  (eval function)
 )
)
(defun tree_walk (rootframe function)
  (setq frame- rootframe)
  (eval function)
  (do
   (
     (children (fget rootframe 'children '$value)(cdr children))
   )
   ((null children) nil)
   (setq frame- (car children))
   (tree_walk (car children) function)
  )
)

(defun fneedcond (f s)
 (or
     (fget f s '$value)
     (fneed f s)
 )
)
(defun tree_and_slot_walk (root function)
  (tree_walk root `(slot_walk frame- (quote ,function)))
)


(defun call_to_gus ()
  (let
   ((root (fname(finstantiate 'tripplan))))
   (fneedcond root 'tripspecification)
   (tree_and_slot_walk root '(fneedcond frame- slot-))
   (tree_and_slot_walk root '(report-line frame- slot-))
  )
)
(defun report-line (f s)
	  (print (list 
	   (car (fget f 'type '$value)) ;get parent name
	   f s
           (fget f s '$value)))
	   (terpri)
)

(defun setdiff (set diff)
 (cond
   ((null diff) set)
   ((null set)  set)
   ((member (car set) diff) (setdiff (cdr set) diff))
   (t        (cons (car set)(setdiff (cdr set) diff)))
 )
)

;(trace call_to_gus)
;(trace tree_and_slot_walk)
;(trace tree_walk slot_walk)
;(trace add_child)
;(trace prompt_for)
;(trace fget fput fneed finstantiate)
;(trace fslots)

;---------------------------------------------------------------------
;-------------- the GUS program --------------------------------------
;---------------------------------------------------------------------
(fassert tripplan
  (order-date	($if-needed ((request)))
                (prompt_msg ((please enter todays date))))
  (client       ($if-needed ((request)))
		(prompt_msg ((please enter your name))))
  (tripspecification
		($if-needed ((create_child_instance 'tripspecification)))
  )
)

(fassert tripspecification
  (homeport	($if-needed ((fput frame- slot- '$value 'fargo)))
  )
  (foreignport  ($if-needed ((request)))
		(prompt_msg ((what city are you flying to?)))
  )
  (outwardleg   ($if-needed ((create_child_instance 'tripleg)))
  )
  (inwardleg    ($if-needed ((create_child_instance 'tripleg)))
  )
)

(fassert tripleg
  (flightnum   ($if-needed
		  ((prompt_for frame- slot- 
		     `(filght number for 
			,(fget frame-  'parent_slot '$value))))

               )
  )
)
;(call_to_gus)
;(myshowall *frames*)
(print '(to run the program issue the function (call_to_gus)))
(print '(after running it issue the function (myshowall *frames*)))