1% planner.pl
    2% July 1, 1996
    3% John Eikenberry
    4%
    5% Dec 13, 2035
    6% Douglas Miles
    7%
    8/* * module * 
    9% This file defines the agents action of planning and carries out plan. 
   10% Very simple... but kept separate to maintain modularity
   11%
   12*/
   13
   14
   15:- swi_module(modPlan, []).   16:- include(prologmud(mud_header)).   17% :- register_module_type (mtCommand).
   18
   19%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   20% [Mostly Required] Load the Logicmoo Plan Generator System
   21%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   22:- absolute_file_name(library(logicmoo_planner),P,[file_type(prolog),access(read)]),dmsg(library(logicmoo_planner)=P).   23:- load_library_system(library(logicmoo_planner)).   24
   25
   26:- dynamic on_command_show/3.   27:- multifile on_command_show/3.   28
   29
   30on_command_show(Agent,actLook,goals=nop(SHOW)):- findall(Value,agentGOAL(Agent,Value),SHOW),SHOW\==[].
   31on_command_show(Agent,actLook,todo=nop(SHOW)):- findall(Value,agentTODO(Agent,Value),SHOW),SHOW\==[].
   32
   33baseKB:action_info(actPlan(ftTerm),"carry out a plan").
   34
   35% Plan something
   36baseKB:agent_call_command(Agent,actPlan(Goal)) :-
   37   ain(agentGOAL(Agent,Goal)),
   38   dmsg(call(listing(agentGOAL(Agent,_)))),
   39   pddl_idea(Agent,Act),
   40   dmsg(call(listing(agentTODO(Agent,_)))),
   41   pddl_vette_idea(Agent,Act,_ActV).
   42  
   43
   44update_charge(Agent,actPlan) :- padd(Agent,mudEnergy(+ -1)).
   45
   46
   47
   48tpf_sanity:-flag(time_used,_,0),
   49  must(if_defined((parseDomain(string("
   50
   51(define (domain domAgentVehical)
   52  (:requirements :strips) 
   53  (:predicates 	(tItem ?obj)
   54	       	(tVehical ?truck)
   55               	(tRegion ?loc)
   56		(tAgent ?d)
   57		(inRegion ?obj ?loc)
   58		(mudInside ?obj1 ?obj)
   59		(mudDriving ?d ?v)
   60		(mudVehicalPath ?x ?y) (mudFootPath ?x ?y)
   61		(is_Empty ?v)
   62)
   63
   64
   65(:action LOAD-VEHICAL
   66  :parameters
   67   (?obj
   68    ?truck
   69    ?loc)
   70  :precondition
   71   (and (tItem ?obj) (tVehical ?truck) (tRegion ?loc)
   72   (inRegion ?truck ?loc) (inRegion ?obj ?loc))
   73  :effect
   74   (and (not (inRegion ?obj ?loc)) (mudInside ?obj ?truck)))
   75
   76(:action UNLOAD-VEHICAL
   77  :parameters
   78   (?obj
   79    ?truck
   80    ?loc)
   81  :precondition
   82   (and (tItem ?obj) (tVehical ?truck) (tRegion ?loc)
   83        (inRegion ?truck ?loc) (mudInside ?obj ?truck))
   84  :effect
   85   (and (not (mudInside ?obj ?truck)) (inRegion ?obj ?loc)))
   86
   87(:action BOARD-VEHICAL
   88  :parameters
   89   (?tAgent
   90    ?truck
   91    ?loc)
   92  :precondition
   93   (and (tAgent ?tAgent) (tVehical ?truck) (tRegion ?loc)
   94   (inRegion ?truck ?loc) (inRegion ?tAgent ?loc) (is_Empty ?truck))
   95  :effect
   96   (and (not (inRegion ?tAgent ?loc)) (mudDriving ?tAgent ?truck) (not (is_Empty ?truck))))
   97
   98(:action DISEMBARK-VEHICAL
   99  :parameters
  100   (?tAgent
  101    ?truck
  102    ?loc)
  103  :precondition
  104   (and (tAgent ?tAgent) (tVehical ?truck) (tRegion ?loc)
  105        (inRegion ?truck ?loc) (mudDriving ?tAgent ?truck))
  106  :effect
  107   (and (not (mudDriving ?tAgent ?truck)) (inRegion ?tAgent ?loc) (is_Empty ?truck)))
  108
  109(:action actDrive
  110  :parameters
  111   (?truck
  112    ?loc-from
  113    ?loc-to
  114    ?tAgent)
  115  :precondition
  116   (and (tVehical ?truck) (tRegion ?loc-from) (tRegion ?loc-to) (tAgent ?tAgent) 
  117   (inRegion ?truck ?loc-from)
  118   (mudDriving ?tAgent ?truck) (mudVehicalPath ?loc-from ?loc-to))
  119  :effect
  120   (and (not (inRegion ?truck ?loc-from)) (inRegion ?truck ?loc-to)))
  121
  122(:action actWalk
  123  :parameters
  124   (?tAgent
  125    ?loc-from
  126    ?loc-to)
  127  :precondition
  128   (and (tAgent ?tAgent) (tRegion ?loc-from) (tRegion ?loc-to)
  129	(inRegion ?tAgent ?loc-from) (mudFootPath ?loc-from ?loc-to))
  130  :effect
  131   (and (not (inRegion ?tAgent ?loc-from)) (inRegion ?tAgent ?loc-to)))
  132
  133)
  134"
  135),DD)))),(if_defined((parseProblem(string("
  136(define (problem DLOG-2-2-2)
  137	(:domain domAgentVehical)
  138	(:objects
  139	tAgent1
  140	tAgent2
  141	truck1
  142	truck2
  143	iPackage1
  144	iPackage2
  145	s0
  146	s1
  147	s2
  148	p1-0
  149	p1-2
  150	)
  151	(:init
  152	(inRegion tAgent1 s2)
  153	(tAgent tAgent1)
  154	(inRegion tAgent2 s2)
  155	(tAgent tAgent2)
  156	(inRegion truck1 s0)
  157	(is_Empty truck1)
  158	(tVehical truck1)
  159	(inRegion truck2 s0)
  160	(is_Empty truck2)
  161	(tVehical truck2)
  162	(inRegion iPackage1 s0)
  163	(tItem iPackage1)
  164	(inRegion iPackage2 s0)
  165	(tItem iPackage2)
  166	(tRegion s0)
  167	(tRegion s1)
  168	(tRegion s2)
  169	(tRegion p1-0)
  170	(tRegion p1-2)
  171	(mudFootPath s1 p1-0)
  172	(mudFootPath p1-0 s1)
  173	(mudFootPath s0 p1-0)
  174	(mudFootPath p1-0 s0)
  175	(mudFootPath s1 p1-2)
  176	(mudFootPath p1-2 s1)
  177	(mudFootPath s2 p1-2)
  178	(mudFootPath p1-2 s2)
  179	(mudVehicalPath s0 s1)
  180	(mudVehicalPath s1 s0)
  181	(mudVehicalPath s0 s2)
  182	(mudVehicalPath s2 s0)
  183	(mudVehicalPath s2 s1)
  184	(mudVehicalPath s1 s2)
  185)
  186	(:goal (and
  187	(inRegion tAgent1 s1)
  188	(inRegion truck1 s1)
  189	(inRegion iPackage1 s0)
  190	(inRegion iPackage2 s0)
  191	))
  192
  193
  194)
  195"
  196),PP)))), !,if_defined(solve_files_ddpp(DD, PP)),
  197   show_call(flag(time_used,W,W)).
  198
  199% :-tpf_sanity.
  200
  201%:- test_domain('domains_ocl/chameleonWorld/domain*').
  202%:- test_all(7).
  203
  204
  205%:-prolog.
  206
  207:- include(prologmud(mud_footer)).