1:-include(library('ec_planner/ec_test_incl')).    2:-expects_dialect(pfc).    3 %  loading(always,'ecnet/HungerNeed.e').
    4
    5
    6% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:0
    7%;
    8%; Copyright (c) 2005 IBM Corporation and others.
    9%; All rights reserved. This program and the accompanying materials
   10%; are made available under the terms of the Common Public License v1.0
   11%; which accompanies this distribution, and is available at
   12%; http://www.eclipse.org/legal/cpl-v10.html
   13%;
   14%; Contributors:
   15%; IBM - Initial implementation
   16%;
   17%; hunger need
   18%;
   19
   20% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:13
   21% fluent Hungry(agent)
   22 %  fluent(hungry(agent)).
   23% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:14
   24==> mpred_prop(hungry(agent),fluent).
   25==> meta_argtypes(hungry(agent)).
   26
   27% fluent Satiated(agent)
   28 %  fluent(satiated(agent)).
   29% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:16
   30==> mpred_prop(satiated(agent),fluent).
   31==> meta_argtypes(satiated(agent)).
   32
   33% noninertial Satiated
   34% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:17
   35==> noninertial(satiated).
   36
   37
   38% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:18
   39% [agent,time]
   40 % HoldsAt(Hungry(agent),time) <-> !HoldsAt(Satiated(agent),time).
   41
   42 /*  holds_at(hungry(Agent), Time) <->
   43       not(holds_at(satiated(Agent), Time)).
   44 */
   45axiom(holds_at(hungry(Agent), Time),
   46    [not(holds_at(satiated(Agent), Time))]).
   47axiom(not(holds_at(satiated(Agent), Time)),
   48    [holds_at(hungry(Agent), Time)]).
   49
   50% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:20
   51% event Eat(agent,food)
   52 %  event(eat(agent,food)).
   53% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:21
   54==> mpred_prop(eat(agent,food),event).
   55==> meta_argtypes(eat(agent,food)).
   56
   57
   58% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:22
   59% [agent,food,time]
   60% Happens(Eat(agent,food),time) ->
   61% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:24
   62% {location}% 
   63% HoldsAt(At(agent,location),time) &
   64% HoldsAt(At(food,location),time).
   65
   66 /*   exists([Location],
   67             if(happens(eat(Agent, Food), Time),
   68                 (holds_at(at(Agent, Location), Time), holds_at(at(Food, Location), Time)))).
   69 */
   70
   71 /*  not(some(Location6, '$kolem_Fn_146'(Fn_146_Param, At_Param, Maptime))) :-
   72       happens(eat(Fn_146_Param, At_Param), Maptime),
   73       (   not(holds_at(at(Fn_146_Param, Location6), Maptime))
   74       ;   not(holds_at(at(At_Param, Location6), Maptime))
   75       ).
   76 */
   77% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:26
   78axiom(not(some(Location6, '$kolem_Fn_146'(Fn_146_Param, At_Param, Maptime))),
   79   
   80    [ not(holds_at(at(Fn_146_Param, Location6), Maptime)),
   81      happens(eat(Fn_146_Param, At_Param), Maptime)
   82    ]).
   83axiom(not(some(Location6, '$kolem_Fn_146'(Fn_146_Param, At_Param, Maptime))),
   84   
   85    [ not(holds_at(at(At_Param, Location6), Maptime)),
   86      happens(eat(Fn_146_Param, At_Param), Maptime)
   87    ]).
   88
   89 /*  not(happens(eat(Eat_Param, At_Param12), Maptime9)) :-
   90       (   not(holds_at(at(Eat_Param, Location10), Maptime9))
   91       ;   not(holds_at(at(At_Param12, Location10), Maptime9))
   92       ),
   93       some(Location10,
   94            '$kolem_Fn_146'(Eat_Param, At_Param12, Maptime9)).
   95 */
   96axiom(not(happens(eat(Eat_Param, At_Param12), Maptime9)),
   97   
   98    [ not(holds_at(at(Eat_Param, Location10), Maptime9)),
   99      some(Location10,
  100           '$kolem_Fn_146'(Eat_Param, At_Param12, Maptime9))
  101    ]).
  102axiom(not(happens(eat(Eat_Param, At_Param12), Maptime9)),
  103   
  104    [ not(holds_at(at(At_Param12, Location10), Maptime9)),
  105      some(Location10,
  106           '$kolem_Fn_146'(Eat_Param, At_Param12, Maptime9))
  107    ]).
  108
  109 /*  holds_at(at(At_Param15, Location13), Time14) :-
  110       happens(eat(At_Param15, Eat_Ret), Time14),
  111       some(Location13,
  112            '$kolem_Fn_146'(At_Param15, Eat_Ret, Time14)).
  113 */
  114axiom(holds_at(at(At_Param15, Location13), Time14),
  115   
  116    [ happens(eat(At_Param15, Eat_Ret), Time14),
  117      some(Location13,
  118           '$kolem_Fn_146'(At_Param15, Eat_Ret, Time14))
  119    ]).
  120
  121 /*  holds_at(at(At_Param19, Location17), Time18) :-
  122       happens(eat(Eat_Param20, At_Param19), Time18),
  123       some(Location17,
  124            '$kolem_Fn_146'(Eat_Param20, At_Param19, Time18)).
  125 */
  126axiom(holds_at(at(At_Param19, Location17), Time18),
  127   
  128    [ happens(eat(Eat_Param20, At_Param19), Time18),
  129      some(Location17,
  130           '$kolem_Fn_146'(Eat_Param20, At_Param19, Time18))
  131    ]).
  132
  133
  134% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:28
  135% [agent,food,time]
  136% Terminates(Eat(agent,food),Hungry(agent),time).
  137% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:29
  138axiom(terminates(eat(Agent, Food), hungry(Agent), Time),
  139    []).
  140
  141
  142% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/ecnet/HungerNeed.e:31
  143%; End of file.