1/*  *  <module> 
    2% Uses affordances in which agents belief that some outcome will happen
    3% We also in this file purposelty create disparities
    4% Example: Buy this new car and you will suddenly become sexy!
    5%  Result: less money in pocket now but have vehical - but not sexier!
    6%
    7% Logicmoo Project PrologMUD: A MUD server written in Prolog
    8% Maintainer: Douglas Miles
    9% Dec 13, 2035
   10%
   11 */

   12
   13:- include(prologmud(mud_header)).
   14:- include('improve.pfc').
   15
   16==>tCol(mobSimian).
   17
   18:- dynamic(defined_affordance/1).
   19:- discontiguous(defined_affordance/1).
   20
   21% See the the seemingly white (not dirrectly usable) in some tUsefull way
   22defined_affordance([subjType= "Passable",actionVerb= "TravelThru"]).
   23
   24==>prologHybrid(mudDescription(ftTerm,ftString)).
   25prologHybrid(nameString(ftTerm,ftString)).
   26
   27rtArgsVerbatum(defined_affordance).
   28
   29defined_affordance([subjType= "Television",
   30stringMatch= "TV",
   31actionVerb= "Observe",
   32mudActionMaxDistance= 4,
   33'NonLoneliness_Social'= 3 * -2, % this form means the AI player thinks observing a TV will satisfy their NonLoneliness_Social needs by 3% .. yet instead, it reduces by 2%
   34'NonHunger'= 1 * -1, 
   35'BladderEmpty'= 0 * 0,
   36'Hygiene'= 0 * 0,
   37'Secure_Room'= 1 * 0,
   38'Fun'= 2 * 1,
   39'Sad_To_Happy'= 2 * 1,
   40'Energy'= 1 * -1]).
   41
   42defined_affordance([subjType= "Door",
   43stringMatch= " * doorway",
   44stringMatch= "gate",
   45stringMatch= "Curtain",
   46superType= "Passable"]).
   47
   48defined_affordance([subjType= "Floor",
   49stringMatch= "floor",
   50superType= "Passable"]).
   51
   52defined_affordance([subjType= "Ladder",
   53stringMatch= "ladder",
   54superType= "Passable"]).
   55
   56% looks like a very bad idea but not (this is mainly for testing the system)
   57defined_affordance([subjType= tFurniture,actionVerb= "BumpIntoBarrier",
   58'NonLoneliness_Social'= -300 * 0,
   59'Hygiene'= -300 * 0,
   60'Comfort'= -300 * 0,
   61'Energy'= -300 * 0,
   62'Fun'= -300 * 0]).
   63
   64% yet every minute you are alive, God wishes to punish you
   65defined_affordance([ subjType=tAgent, actionVerb= "LiveAtLeastAMinute",
   66   'Energy'= 0 * -2,
   67   'NonHunger'= 0 * -2,
   68   'BladderEmpty'= 0 * -2,
   69   'Hygiene'= 0 * -2,
   70   'Secure_Room'= 0 * -2,
   71   'NonLoneliness_Social'= 0 * -2,
   72   'Fun'= 0 * -2,
   73   'Sad_To_Happy'= 0 * -2,
   74   'Comfort'= 0 * -2 ]).
   75
   76% TODO hook_one_minute_timer_tick:- \+ suspend_timers, forall(no_repeats(tAgent(X)),agent_command_now(X,actLiveAtLeastAMinute(X))).
   77
   78defined_affordance([subjType= "Shower",
   79actionVerb= "Operate",
   80slAnim= anim_AFRAID,
   81textName= "wash self with X",
   82textName= "take a shower",
   83'Comfort'= 10 * 10,
   84'Hygiene'= 30 * 30,
   85actionVerb= "Clean"]).
   86
   87defined_affordance([subjType= "BathTub",
   88stringMatch= "bath",
   89stringMatch= "bathtub",
   90slExceptFor= "PlasticTub",
   91actionVerb= "Operate",
   92textName= "wash self with X",
   93textName= "Take a Bath",
   94slSit= true,
   95'Comfort'= 20 * 20,
   96'Energy'= -20 * -20,
   97'Hygiene'= 100 * 100,
   98actionVerb= "Clean"]).
   99
  100defined_affordance([subjType= "Sink",
  101actionVerb= "Operate",
  102textName= "Wash Hands",
  103'Comfort'= 0 * 0,
  104'Hygiene'= 10 * 10,
  105actionVerb= "Clean"]).
  106
  107% defined_affordance([subjType= "BigThing",require(mudSize > 8)]).
  108
  109% defined_affordance([actionVerb= "Attach_To_Self",textName= "Attach it",slAnim= anim_RPS_PAPER,'Comfort'= 20 * 20,'LispScript'= "(progn (TheBot.Attach_To_Self Target))"]).
  110
  111defined_affordance([subjType= "DanceBall",
  112actionVerb= "Dance",
  113textName= "Dance! Dance!",
  114slTouch= true,
  115slAnim= anim_DANCE,
  116'NonLoneliness_Social'= 10 * 10,
  117'Energy'= -10 * -20,
  118'Fun'= 10 * 10,
  119'Hygiene'= -10 * -10]).
  120
  121defined_affordance([subjType= "PoseBall",
  122stringMatch= " * pose",
  123stringMatch= " * Pose",
  124slTouch= true]).
  125
  126defined_affordance([subjType= tWashingMachine,
  127stringMatch= "Washing Machine",
  128actionVerb= "actOperate",
  129textName= "Wash The Clothes",
  130'Comfort'= 0 * 0,
  131'Hygiene'= 10 * 10,
  132actionVerb= "Clean"]).
  133
  134defined_affordance([subjType= tClothesDryer,
  135stringMatch= "Dryer",
  136actionVerb= "actOperate",
  137textName= "Dry The Clothes",
  138'Comfort'= 0 * 0,
  139'Hygiene'= 10 * 10,
  140actionVerb= "Clean"]).
  141
  142defined_affordance([subjType= "Bed",
  143actionVerb= "Sleep",
  144textSitName= "Sleep a few",
  145slSit= true,
  146slAnim= anim_SLEEP,
  147'Comfort'= 10 * 30,
  148'Energy'= 100 * 80]).
  149
  150defined_affordance([subjType= "Mattress",
  151actionVerb= "Sleep",
  152textSitName= "Sleep a few",
  153slSit= true,
  154slAnim= anim_SLEEP,
  155'Comfort'= 10 * 30,
  156'Energy'= 100 * 80]).
  157
  158defined_affordance([subjType= "Chair",
  159stringMatch= " * chair",
  160stringMatch= " * stool",
  161stringMatch= " * recliner",
  162actionVerb= "Sit",
  163textSitName= "Sit down",
  164slSit= true,
  165slAnim= anim_SMOKE_IDLE,
  166'Comfort'= 15 * 10,
  167'Energy'= 10 * 20]).
  168
  169defined_affordance([subjType= "Couch",
  170stringMatch= "Sofa",
  171stringMatch= " * luvseat * ",
  172stringMatch= " * loveseat * ",
  173actionVerb= "Sit",
  174textSitName= "Sit down",
  175slSit= true,
  176slAnim= anim_SMOKE_IDLE,
  177'Comfort'= 20 * 20,
  178'Energy'= 10 * 20]).
  179
  180defined_affordance([subjType= "Radio",
  181actionVerb= "Observe",
  182textName= "Listen to Radio",
  183mudActionMaxDistance= 4,
  184'Secure_Room'= 1 * 0,
  185'Fun'= 10 * 10,
  186'Sad_To_Happy'= 10 * 10,
  187'Energy'= 1 * -1]).
  188
  189defined_affordance([subjType= "Mirror",
  190actionVerb= "Observe",
  191textName= "Pop your zits",
  192mudActionMaxDistance= 2,
  193'Secure_Room'= 1 * 0,
  194'Fun'= 10 * 10,
  195'Sad_To_Happy'= 10 * -1,
  196'Energy'= 1 * -1]).
  197
  198defined_affordance([subjType= "Toilet",
  199actionVerb= "Potty",
  200textSitName= "Go potty",
  201slSit= true,
  202'BladderEmpty'= 100 * 100,
  203'Hygiene'= 0 * -10,
  204actionVerb= "Clean",
  205textName= "Flush it",
  206slAnim= anim_POINT_YOU,
  207'Hygiene'= 1 * 4,
  208'Fun'= 5 * 4]).
  209
  210defined_affordance([subjType= "Fridge",
  211stringMatch= " * Fridge * ",
  212stringMatch= " * Frige * ",
  213stringMatch= " * icebox",
  214actionVerb= "Search",
  215textName= "Raid the fridge",
  216slAnim= anim_DRINK,
  217slGrab= true]).
  218
  219defined_affordance([subjType= "Stove",
  220stringMatch= "Oven",
  221stringMatch= " * kitchen range",
  222actionVerb= "actOperate",
  223slAnim= anim_DRINK,
  224slGrab= true]).
  225
  226defined_affordance([subjType= "Microwave",
  227actionVerb= "actOperate",
  228textName= "see what was forgotten in the microwave",
  229slAnim= anim_DRINK,
  230slGrab= true]).
  231
  232defined_affordance([subjType= "Treadmill",
  233   actionVerb= "Operate",
  234   textName= "Excersize with X",
  235   textName= "Tread the mill",
  236   slSit= true]).
  237
  238defined_affordance([subjType= "FixedLamp",
  239   stringMatch= " * floorlamp",
  240   stringMatch= "lamp",
  241   stringMatch= "lantern",
  242   stringMatch= "lightbulb",
  243   stringMatch= "lighting",
  244   actionVerb= "Operate",
  245   textName= "flip the switch",
  246   slAnim= anim_AIM_BAZOOKA_R]).
  247
  248defined_affordance([subjType= "Pooltable",
  249stringMatch= " * pool table * ",
  250actionVerb= "Operate",
  251textName= "Play pool",
  252slAnim= anim_AIM_BAZOOKA_R]).
  253
  254defined_affordance([subjType= "Barrier",
  255stringMatch= " * Wall * ",
  256stringMatch= " * Fence * ",
  257stringMatch= " * Pillar * ",
  258stringMatch= " * Roof * ",
  259stringMatch= " * Beam * "]).
  260
  261defined_affordance([subjType= "Shelf",
  262stringMatch= " * cupboard",
  263stringMatch= " * Cabinet",
  264stringMatch= " * cabinate",
  265stringMatch= " * FoodStore",
  266actionVerb(2)=actPutXOn]).
  267
  268defined_affordance([subjType= "Desk",
  269stringMatch= " * Lab Bench",
  270stringMatch= " * workbench",
  271stringMatch= " * officedesk",
  272actionVerb(2)=actPutXOn]).
  273
  274defined_affordance([subjType= "Counter",stringMatch= "Bar",actionVerb(2)=actPutXOn]).
  275
  276defined_affordance([subjType= "Container",stringMatch= "Plastic",actionVerb(2)="Put_X_In"]).
  277
  278defined_affordance([subjType= "Table",
  279stringMatch= " * Coffee Table",
  280acceptsChild= tReadAble,
  281acceptsChild= tEatAble,
  282actionVerb(2)=actPutXOn]).
  283
  284defined_affordance([subjType= tTrashContainer,
  285   stringMatch= "garbage * c",
  286   stringMatch= "trash * c",
  287   stringMatch= "trash * bin",
  288   stringMatch= "waste",
  289   stringMatch= "recycle * bin",
  290   acceptsChild= "Take",
  291   actionVerb(2)="Put_X_In",acceptsChild= takeAble]).
  292
  293defined_affordance([subjType= "Bookcase",
  294stringMatch= " * Bookcase",
  295stringMatch= " * Bookshelf",
  296stringMatch= " * Bookshelve",
  297acceptsChild= tReadAble,
  298actionVerb(2)=actPutXOn,
  299textName= "Organize books",
  300slAnim= anim_YES,
  301'Fun'= 10 * 10,
  302'Secure_Room'= 20 * 20]).
  303
  304defined_affordance([subjType= tReadAble,
  305stringMatch= "Book",
  306stringMatch= "Magazine",
  307actionVerb= "Observe",
  308textName= "Read book",
  309slGrab= true,
  310slAnim= anim_LAUGH_SHORT,
  311'Fun'= 10 * 10,
  312'Secure_Room'= 20 * 20,
  313actionVerb= "Take",
  314textName= "Take the materials"]).
  315
  316defined_affordance([subjType= tEatAble,
  317'slAcceptsParent'= "Avatar",
  318actionVerb= "Eat",
  319textName= "Eat the food",
  320slAnim= anim_DRINK,
  321actionVerb= "Take",
  322textName= "Take the food"]).
  323
  324defined_affordance([subjType= "Art",
  325stringMatch= "Art  * ",
  326actionVerb= "Observe",
  327textName= "Apreciate the Art",
  328slAnim= anim_YES_HAPPY,
  329'Fun'= 10 * 10,
  330'Secure_Room'= 20 * 20]).
  331
  332defined_affordance([subjType= tDanceFloor,
  333actionVerb= "Operate",
  334textName= "Dance! Dance!",
  335slAnim= anim_DANCE2]).
  336
  337defined_affordance([subjType= "Computer",
  338stringMatch= "keyboard",
  339stringMatch= "keypad",
  340stringMatch= "workstation",
  341stringMatch= "Monitor",
  342actionVerb= "Operate",
  343textName= "Look busy doing something!",
  344slAnim= anim_TYPE]).
  345
  346defined_affordance([subjType= tAgent,
  347actionVerb= "Talk",
  348'NonLoneliness_Social'= 10 * 15,
  349'Fun'= 1 * 1,
  350actionVerb= "Argue",
  351'NonLoneliness_Social'= 10 * 15,
  352'Energy'= 0 * -10,
  353'Sad_To_Happy'= -10 * -10,
  354'Fun'= 20 * 10,
  355actionVerb= "Attack",
  356'NonLoneliness_Social'= 10 * 15,
  357'Energy'= 0 * -10,
  358'Sad_To_Happy'= 0 * -10,
  359'Fun'= 20 * 10,
  360actionVerb= "Kiss",
  361'NonLoneliness_Social'= 10 * 15,
  362'Sad_To_Happy'= 10 * 10,
  363'Fun'= 10 * 10]).
  364
  365defined_affordance([subjType= touchAble,actionVerb= "Touch",
  366textName= "Touch",
  367slGrab= true,
  368'Fun'= 1 * 1,
  369'Secure_Room'= 1 * 1]).
  370
  371defined_affordance([subjType= tSitAble,actionVerb= "Sit",
  372textName= "Sit on",
  373slSit= true,
  374slAnim= anim_SIT,
  375'Comfort'= 1 * 0,
  376'Fun'= 1 * 1,
  377'Secure_Room'= 1 * 1]).
  378
  379defined_affordance([subjType= tHasSurface,actionVerb(2)=actPutXOn,
  380textName= "This is a Put_X_On placeholder",
  381slAnim= anim_FINGER_WAG,
  382'Fun'= -2 * 2,
  383'Energy'= 0 * -1]).
  384
  385
  386defined_affordance([subjType= tEatAble,actionVerb= "Eat",
  387textName= "Eat it",
  388slDestroyedOnUse= true,
  389'NonHunger'= 100 * 100,
  390'Hygiene'= 0 * -10]).
  391
  392defined_affordance([subjType= tCarryAble,actionVerb= "Take", 
  393textName= "Take it",
  394'slAcceptsParent'= "Avatar"]).
  395
  396defined_affordance([subjType= tLayAble,actionVerb= "Sleep",
  397   textName= "Lay on",
  398   slSit= true,
  399   slAnim= anim_SLEEP,
  400   'Comfort'= 5 * 5,
  401   'Energy'= 20 * 20]).
  402
  403defined_affordance([alsoType= tLookAble,actionVerb= "Clean",
  404   textName= "Clean",
  405   slAnim= anim_FINGER_WAG,
  406   'Fun'= -2 * 2,
  407   'Energy'= 0 * -1]).
  408
  409defined_affordance([alsoType= tLookAble,actionVerb= "Observe",
  410   textName= "Observe",
  411   mudActionMaxDistance= 5,
  412   slAnim= anim_CLAP,
  413   'Fun'= 2 * 1,
  414   'Energy'= 0 * -1]).
  415
  416defined_affordance([subjType= tSitAble,actionVerb= "Excersize",
  417textName= "Excersize",
  418slAnim= animETWO_PUNCH,
  419'Fun'= 10 * 10,
  420'Hygiene'= -10 * -10]).
  421
  422defined_affordance([subjType= tAgent,actionVerb= "Tickle",
  423textName= "Play with",
  424slAnim= anim_SHOOT_BOW_L,
  425alsoType= tLookAble,
  426'Energy'= -10 * -10,
  427'Fun'= 20 * 10]).
  428
  429defined_affordance([subjType= tContainer,actionVerb= "Search",
  430textName= "Eat from",
  431slAnim= anim_DRINK,
  432'Hygiene'= 0 * -5,
  433'NonHunger'= 40 * 20]).
  434
  435defined_affordance([subjType= tAgent,actionVerb= "Argue",
  436textName= "Argue",
  437alsoType= tLookAble,
  438slAnim= anim_ONETWO_PUNCH,
  439'Energy'= -11 * -20]).
  440
  441defined_affordance([subjType= tAgent,actionVerb= "Talk",
  442textName= "Talk to",
  443mudActionMaxDistance= 3,
  444alsoType= tLookAble,
  445slAnim= anim_TALK,
  446'NonLoneliness_Social'= 11 * 20]).
  447
  448defined_affordance([subjType= tAgent,actionVerb= "Attack",
  449textName= "Beat up",
  450slAnim= anim_SWORD_STRIKE,
  451'Energy'= -11 * -20]).
  452
  453defined_affordance([subjType= tAgent,actionVerb= "Kiss",
  454textName= "Kiss",
  455slAnim= anim_BLOW_KISS,
  456'NonLoneliness_Social'= 11 * 20,
  457'Fun'= 21 * 20]).
  458
  459defined_affordance([subjType= tLookAble,actionVerb= "Think_About",
  460textName= "Think about",
  461slAnim= anim_SHRUG,
  462'Fun'= 1 * 2]).
  463
  464recreate(F/A):- abolish(F,A),dynamic(F/A),functor(P,F,A),export(F/A),nop(retractall(P)),!.
  465:-recreate(verb_desc/3).
  466:-recreate(verb_for_type/2).
  467:-recreate(verb_affordance_2/2).
  468:-recreate(can_hold_type/2).
  469:-recreate(verb_affordance/5).
  470
  471:- check_clause_counts.
  472:- kb_shared(argIsa/3).
  473:- check_clause_counts.
  474:- kb_shared(genls/2).
  475:- kb_shared(mudActionMaxDistance(vtActionTemplate,  ttObjectType,ftInt)).
  476
  477to_personal(mudEnergy,mudEnergy).
  478to_personal(Pred,APred):-atom_concat('',Pred,APred).
  479
  480do_define_affordance(LIST):-
  481  (member(subjType= SType,LIST);member(alsoType= SType,LIST)),
  482  ti_name('t',SType,Type),!,
  483  ain(tCol(Type)),
  484  do_define_type_affordance(Type,LIST).
  485
  486do_define_type_affordance1(Type,_= Type):-!.
  487do_define_type_affordance1(Type,subjType= String):-
  488 no_repeats(call_u(coerce_hook(String,ftString,StringM))),
  489 ain_expanded(nameString(Type,StringM)).
  490
  491%coerce(A,B,C):-no_repeats(call_u(coerce_hook(A,B,C))),nop((sanity(show_failure(call_u(isa(C,B))))->!;true)).
  492
  493do_define_type_affordance1(Type,alsoType= TWhat):-ti_name(t,TWhat,ParentType),ain(genls(Type,ParentType)).
  494do_define_type_affordance1(Type,superType= TWhat):-ti_name(t,TWhat,ParentType),ain(genls(Type,ParentType)).
  495do_define_type_affordance1(Type,actionVerb= SVerb):-ti_name(act,SVerb,Verb),nb_setval(actionVerb,Verb),!,assert_if_new(verb_for_type(Verb,Type)).
  496do_define_type_affordance1(Type,actionVerb(2)= SVerb):-ti_name(act,SVerb,Verb),nb_setval(actionVerb,Verb),
  497  (nb_current(acceptsChild,ChildType)->true;ChildType=tCarryAble),
  498  assert_if_new(verb_affordance_2(Verb,Type,ChildType)).
  499do_define_type_affordance1(Type,acceptsChild= TWhat):-ti_name(t,TWhat,ChildType),
  500  nb_setval(acceptsChild,ChildType),!,assert_if_new(can_hold_type(Type,ChildType)),
  501 (nb_current(actionVerb,Verb)->assert_if_new(verb_affordance_2(Verb,Type,ChildType));dmsg(warn(verb_affordance_3_no_verb(error(vVerb),Type,ChildType)))),!.
  502do_define_type_affordance1(Type,SPred= Wants * Gets):-ti_name(mud,SPred,Pred),nb_getval(actionVerb,Verb),to_personal(Pred,APred),
  503  to_rel_value(Wants,WantsR),
  504  to_rel_value(Gets,GetsR),
  505  assert_if_new(verb_affordance(Verb,Type,APred,WantsR,GetsR)).
  506do_define_type_affordance1(Type,mudActionMaxDistance= Distance):-nb_getval(actionVerb,Verb),ain(mudActionMaxDistance(Verb,Type,Distance)).
  507do_define_type_affordance1(Type,textSitName= String):-do_define_type_affordance1(Type,textName= String).
  508do_define_type_affordance1(Type,textName= String):-nb_getval(actionVerb,Verb),assert_if_new(verb_desc(Verb,Type,String)).
  509do_define_type_affordance1(Type,stringMatch= String):-assert_if_new(type_desc(Type,String)).
  510do_define_type_affordance1(_,Skipped=_):-atom_concat('sl',_,Skipped).
  511do_define_type_affordance1(Type,Skipped):-dmsg(error(skipped(do_define_type_affordance1(Type,Skipped)))).
  512
  513do_define_type_affordance(_,[]).
  514do_define_type_affordance(Type,[H|LIST]):-do_define_type_affordance1(Type,H),!,do_define_type_affordance(Type,LIST),!.
  515
  516
  517to_rel_value(Val,- NVal):-number(Val), Val<0, NVal is Val * -1.
  518to_rel_value(Val,+ NVal):-number(Val), Val>0, NVal is Val .
  519to_rel_value( - Val,- Val):-!.
  520to_rel_value( + Val,+ Val):-!.
  521to_rel_value(Val,+ Val).
  522
  523world_agent_plan(_World,Agent,Act):-
  524   (isa(Agent,mobSimian);isa(Agent,tAgent)),
  525   simian_idea(Agent,Act).
  526
  527:-export(simian_ideas_possible/2).
  528% simian_ideas_possible(Agent,actTextcmd(Think_about,Visible)) :- verb_for_type(Think_about, Type),available_instances_of_type(Agent,Visible,Type).
  529simian_ideas_possible(Agent,actDo(Think_about,Visible)) :- verb_for_type(Think_about, Type),available_instances_of_type(Agent,Visible,Type).
  530
  531simian_idea(Agent,Act):-
  532   findall(Act,simian_ideas_possible(Agent,Act),CMDS),choose_best(Agent,CMDS,Act).
  533
  534% verb_affordance(Verb,Type,APred,Wants,Gets)
  535choose_best(_Agent,CMDS,Act):-random_permutation(CMDS,[Act|_]).
  536
  537show_call_fmt(Call):-show_failure(Call),fmt(Call).
  538
  539% args_match_types(ARGS,Types).
  540args_match_types(In,Out):-In==[],!,Out=[].
  541args_match_types(TemplIn,Templ):-is_list(TemplIn),is_list(Templ),!,maplist(args_match_types,TemplIn,Templ).
  542args_match_types([X],X):- nonvar(X),!.
  543args_match_types(TemplIn,Templ):-compound(TemplIn),!,TemplIn=..TemplInL, Templ=..TemplL, args_match_types(TemplInL,TemplL).
  544args_match_types(Templ,Templ):-!.
  545args_match_types(Obj,Type):-!,isa(Obj,Type).
  546
  547% hook for toplevel pass 1
  548baseKB:agent_command(Agent,Templ):- on_x_debug(agent_command_affordance(Agent,Templ)).
  549
  550% hook for toplevel pass last
  551agent_command_fallback(Agent,TemplIn):-agent_command_simbots_real(Agent,TemplIn).
  552
  553agent_command_simbots_real(Agent,actImprove(Trait)):- nonvar(Trait),doActImprove(Agent,Trait).
  554
  555actImprove(Trait):- current_agent(Agent),doActImprove(Agent,Trait).
  556
  557agent_command_simbots_real(Agent,TemplIn):- nonvar(TemplIn), 
  558   simbots_templates(Templ),
  559   args_match_types(TemplIn,Templ),
  560    must_det_l((
  561    affordance_side_effects(Agent,Templ,Template),
  562    fmt(agent_command_simbots_real(Agent,Templ,Template)),
  563    ignore(affordance_message(Agent,Templ,Template)))),!.
  564  
  565
  566
  567affordance_side_effects(Agent,Templ,Template):-
  568  must_det_l((
  569      Templ=..[ActVerb|ARGS],
  570      verb_affordance(ActVerb,Types,_,_,_),args_match_types(ARGS,Types),!,must(Template=..[ActVerb,Types]),
  571      findall(t(Trait,Agent,Real), verb_affordance(ActVerb,Types,Trait,_Think,Real),NewAdds),
  572      show_call(forall(member(Add,NewAdds),mpred_ain(Add))))). % db_assert_sv
  573
  574affordance_message(Agent,Templ,Template):- Templ=..[ActVerb|ARGS],
  575      verb_desc_or_else(ActVerb,Types,Mesg),args_match_types(ARGS,Types),!,must(Template=..[ActVerb,Types]),
  576      fmt(affordance_message(Agent,Templ,verb_affordance(ActVerb,Types,Mesg))),!.
  577      
  578verb_desc_or_else(ActVerb,Types,Mesg):-verb_desc(ActVerb,Types,Mesg).
  579verb_desc_or_else(ActVerb,Types,verb_desc(ActVerb,Types)):-nonvar(ActVerb),nonvar(Types),not(verb_desc(ActVerb,Types,_)).
  580
  581agent_command_affordance(Agent,Templ):- simbots_templates(Templ), (fmt(agent_command_simbots_real_3(Agent,Templ)),fail).
  582
  583==> baseKB:action_info(actDo(vtVerb,ftListFn(ftTerm)),"reinterps a action").
  584agent_command_affordance(Agent,actDo(A)):-CMD=..[A],!,agent_command_affordance(Agent,CMD).
  585agent_command_affordance(Agent,actDo(A,B)):-CMD=..[A,B],!,agent_command_affordance(Agent,CMD).
  586agent_command_affordance(Agent,actDo(A,B,C)):- CMD=..[A,B,C],!,agent_command_affordance(Agent,CMD).
  587agent_command_affordance(Agent,actDo(A,B,C,D)):- CMD=..[A,B,C,D],!,agent_command_affordance(Agent,CMD).
  588agent_command_affordance(Agent,actDo(A,B,C,D,E)):- CMD=..[A,B,C,D,E],!,agent_command_affordance(Agent,CMD).
  589
  590==> baseKB:action_info(actTextcmd(ftString),"reinterps a term as text").
  591agent_command_affordance(Agent,actTextcmd(A)):-sformat(CMD,'~w',[A]),!,do_agent_action(Agent,CMD).
  592agent_command_affordance(Agent,actTextcmd(A,B)):-sformat(CMD,'~w ~w',[A,B]),!,do_agent_action(Agent,CMD).
  593agent_command_affordance(Agent,actTextcmd(A,B,C)):-sformat(CMD,'~w ~w ~w',[A,B,C]),!,do_agent_action(Agent,CMD).
  594
  595doActImprove(Agent,Trait):-
  596      findall(agentTODO(Agent,actDo(ActVerb,Types)),
  597        (verb_affordance(ActVerb,Types,Trait,+ Think,_Real),ThinkN is Think,ThinkN>0), NewAdds),
  598      show_call(forall(member(Add,NewAdds),ain(Add))).
  599
  600
  601
  602genls(tShelf,tHasSurface).
  603genls(tCounter,tHasSurface).
  604genls(tFood,tEatAble).
  605genls(tBar,tHasSurface).
  606genls(tSitAble,tHasSurface).
  607genls(tSofa,tCouch).
  608genls(tCouch,tSitAble).
  609genls(tChair,tSitAble).
  610genls(tMattress,tLayAble).
  611genls(tLayAble,tSitAble).
  612genls(tBed,tMattress).
  613genls(tCrib,tLayAble).
  614genls(tHasSurface, tContainer).
  615genls(tHasSurface, tPutTargetAble).
  616genls(tContainer, tPutTargetAble).
  617
  618
  619
  620genls(tClothesDryer,tFurniture).
  621genls(tWashingMachine,tFurniture).
  622genls(tShower,tFurniture).
  623genls(tSitAble,tFurniture).
  624genls(tChair,tFurniture).
  625genls(tBed,tFurniture).
  626genls(tSink,tFurniture).
  627genls(tToilet,tFurniture).
  628genls(tBathTub,tFurniture).
  629genls(tFurniture,tUseAble).
  630genls(tFurniture,tObj).
  631
  632baseKB:text_actverb("observe",actUse).
  633baseKB:text_actverb("operate",actUse).
  634
  635simbots_t_v_o(Templ,V,O):- any_to_atom(V,A),Templ=..[A,O].
  636:- export(simbots_t_v_o/3).
  637
  638
  639==> (baseKB:action_info(Templ,DESC):-verb_desc(V,O,DESC),simbots_t_v_o(Templ,V,O)).
  640==> (baseKB:action_info(Templ,text([verb_for_type,V,O,DOC])):- no_repeats([V,O],verb_affordance(V,O,_,_,_)),simbots_t_v_o(Templ,V,O), 
  641                  findall(pir(P,I,R),((verb_affordance(V, O,P,I,R))),DOC)).
  642
  643simbots_templates(Templ):-no_repeats(simbots_templates0(Templ)).
  644simbots_templates0(Templ):-verb_for_type(V, O),simbots_t_v_o(Templ,V,O).
  645simbots_templates0(Templ):-verb_desc(V,O,_),simbots_t_v_o(Templ,V,O).
  646simbots_templates0(Templ):-verb_affordance(V,O,_,_,_),simbots_t_v_o(Templ,V,O).
  647
  648
  649:-forall(defined_affordance(Attrs),
  650    must(do_define_affordance(Attrs))).
  651
  652:-ain((verb_affordance(Verb, Obj, _,_,_)==>verb_for_type(Verb, Obj))).
  653
  654
  655:- dmsg(call((listing(verb_desc/3),
  656      listing(verb_for_type/2),
  657      listing(verb_affordance_2/2),
  658      listing(can_hold_type/2),
  659      listing(verb_affordance/5)))).
  660
  661
  662/*
  663
  664
  665Yields
  666
  667:- dynamic verb_desc/3.
  668
  669verb_desc(actOperate, tShower, "wash self with X").
  670verb_desc(actOperate, tShower, "take a shower").
  671verb_desc(actOperate, tBathTub, "wash self with X").
  672verb_desc(actOperate, tBathTub, "Take a Bath").
  673verb_desc(actOperate, tSink, "Wash Hands").
  674verb_desc(actDance, tDanceBall, "Dance! Dance!").
  675verb_desc(actOperate, tWashingMachine, "Wash The Clothes").
  676verb_desc(actOperate, tClothesDryer, "Dry The Clothes").
  677verb_desc(actSleep, tBed, "Sleep a few").
  678verb_desc(actSleep, tMattress, "Sleep a few").
  679verb_desc(actSit, tChair, "Sit down").
  680verb_desc(actSit, tCouch, "Sit down").
  681verb_desc(actObserve, tRadio, "Listen to Radio").
  682verb_desc(actObserve, tMirror, "Pop your zits").
  683verb_desc(actPotty, tToilet, "Go potty").
  684verb_desc(actClean, tToilet, "Flush it").
  685verb_desc(actSearch, tFridge, "Raid the fridge").
  686verb_desc(actOperate, tMicrowave, "see what was forgotten in the microwave").
  687verb_desc(actOperate, tTreadmill, "Excersize with X").
  688verb_desc(actOperate, tTreadmill, "Tread the mill").
  689verb_desc(actOperate, tFixedLamp, "flip the switch").
  690verb_desc(actOperate, tPoolTable, "Play pool").
  691verb_desc(actPutXOn, tBookcase, "Browse books").
  692verb_desc(actObserve, tReadAble, "Read book").
  693verb_desc(actTake, tReadAble, "Take the materials").
  694verb_desc(actEat, tEatAble, "Eat the food").
  695verb_desc(actTake, tEatAble, "Take the food").
  696verb_desc(actObserve, tArt, "Apreciate the Art").
  697verb_desc(actOperate, tDanceFloor, "Dance! Dance!").
  698verb_desc(actOperate, tComputer, "Look busy doing something!").
  699verb_desc(actTouch, tTouchAble, "Touch").
  700verb_desc(actSit, tSitAble, "Sit on").
  701verb_desc(actPutXOn, tHasSurface, "This is a Put_X_On placeholder").
  702verb_desc(actEat, tEatAble, "Eat it").
  703verb_desc(actTake, tCarryAble, "Take it").
  704verb_desc(actSleep, tLayAble, "Lay on").
  705verb_desc(actClean, tLookAble, "Clean").
  706verb_desc(actObserve, tLookAble, "Observe").
  707verb_desc(actExcersize, tSitAble, "Excersize").
  708verb_desc(actTickle, tAgent, "Play with").
  709verb_desc(actSearch, tContainer, "Eat_from").
  710verb_desc(actArgue, tAgent, "Argue").
  711verb_desc(actTalk, tAgent, "Talk to").
  712verb_desc(actAttack, tAgent, "Beat up").
  713verb_desc(actKiss, tAgent, "Kiss").
  714verb_desc(actThinkAbout, tLookAble, "Think about").
  715
  716:- dynamic verb_affordance/5.
  717
  718verb_affordance(actObserve, tTelevision, mudNonLonelinessSocial, + 3, + -2).
  719verb_affordance(actObserve, tTelevision, mudNonHunger, 1, + -1).
  720verb_affordance(actObserve, tTelevision, mudBladderEmpty, 0, 0).
  721verb_affordance(actObserve, tTelevision, mudHygiene, 0, 0).
  722verb_affordance(actObserve, tTelevision, mudSecureRoom, 1, 0).
  723verb_affordance(actObserve, tTelevision, mudFun, 2, 1).
  724verb_affordance(actObserve, tTelevision, mudSadToHappy, 2, 1).
  725verb_affordance(actObserve, tTelevision, mudEnergy, + 1, + -1).
  726verb_affordance(actBumpIntoBarrier, tFurniture, mudNonLonelinessSocial, + -300, 0).
  727verb_affordance(actBumpIntoBarrier, tFurniture, mudHygiene, + -300, 0).
  728verb_affordance(actBumpIntoBarrier, tFurniture, mudComfort, + -300, 0).
  729verb_affordance(actBumpIntoBarrier, tFurniture, mudEnergy, + -300, 0).
  730verb_affordance(actBumpIntoBarrier, tFurniture, mudFun, + -300, 0).
  731verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudEnergy, 0, + -1).
  732verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudNonHunger, 0, + -1).
  733verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudBladderEmpty, 0, + -1).
  734verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudHygiene, 0, + -1).
  735verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudSecureRoom, 0, + -1).
  736verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudNonLonelinessSocial, 0, + -1).
  737verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudFun, 0, + -1).
  738verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudSadToHappy, 0, + -1).
  739verb_affordance(actLiveAtLeastAMinute, tAgentSelf, mudComfort, 0, + -1).
  740verb_affordance(actOperate, tShower, mudComfort, 10, 10).
  741verb_affordance(actOperate, tShower, mudHygiene, 30, 30).
  742verb_affordance(actOperate, tBathTub, mudComfort, 20, 20).
  743verb_affordance(actOperate, tBathTub, mudHygiene, 100, 100).
  744verb_affordance(actOperate, tSink, mudComfort, 0, 0).
  745verb_affordance(actOperate, tSink, mudHygiene, 10, 10).
  746verb_affordance(actDance, tDanceBall, mudNonLonelinessSocial, 10, 10).
  747verb_affordance(actDance, tDanceBall, mudFun, 10, 10).
  748verb_affordance(actDance, tDanceBall, mudHygiene, + -10, + -10).
  749verb_affordance(actOperate, tWashingMachine, mudComfort, 0, 0).
  750verb_affordance(actOperate, tWashingMachine, mudHygiene, 10, 10).
  751verb_affordance(actOperate, tClothesDryer, mudComfort, 0, 0).
  752verb_affordance(actOperate, tClothesDryer, mudHygiene, 10, 10).
  753verb_affordance(actSleep, tBed, mudComfort, 10, 30).
  754verb_affordance(actSleep, tBed, mudEnergy, 100, 80).
  755verb_affordance(actSleep, tMattress, mudComfort, 10, 30).
  756verb_affordance(actSleep, tMattress, mudEnergy, 100, 80).
  757verb_affordance(actSit, tChair, mudComfort, 15, 10).
  758verb_affordance(actSit, tChair, mudEnergy, 10, 20).
  759verb_affordance(actSit, tCouch, mudComfort, 20, 20).
  760verb_affordance(actSit, tCouch, mudEnergy, 10, 20).
  761verb_affordance(actObserve, tRadio, mudSecureRoom, 1, 0).
  762verb_affordance(actObserve, tRadio, mudFun, 10, 10).
  763verb_affordance(actObserve, tRadio, mudSadToHappy, 10, 10).
  764verb_affordance(actObserve, tRadio, mudEnergy, 1, + -1).
  765verb_affordance(actObserve, tMirror, mudSecureRoom, 1, 0).
  766verb_affordance(actObserve, tMirror, mudFun, 10, 10).
  767verb_affordance(actObserve, tMirror, mudSadToHappy, 10, + -1).
  768verb_affordance(actObserve, tMirror, mudEnergy, 1, + -1).
  769verb_affordance(actPotty, tToilet, mudBladderEmpty, 100, 100).
  770verb_affordance(actPotty, tToilet, mudHygiene, 0, + -10).
  771verb_affordance(actClean, tToilet, mudHygiene, 1, 4).
  772verb_affordance(actClean, tToilet, mudFun, 5, 4).
  773verb_affordance(actPutXOn, tBookcase, mudFun, 10, 10).
  774verb_affordance(actPutXOn, tBookcase, mudSecureRoom, 20, 20).
  775verb_affordance(actObserve, tReadAble, mudFun, 10, 10).
  776verb_affordance(actObserve, tReadAble, mudSecureRoom, 20, 20).
  777verb_affordance(actObserve, tArt, mudFun, 10, 10).
  778verb_affordance(actObserve, tArt, mudSecureRoom, 20, 20).
  779verb_affordance(actTalk, tAgent, mudNonLonelinessSocial, 10, 15).
  780verb_affordance(actTalk, tAgent, mudFun, 1, 1).
  781verb_affordance(actArgue, tAgent, mudNonLonelinessSocial, 10, 15).
  782verb_affordance(actArgue, tAgent, mudEnergy, 0, + -10).
  783verb_affordance(actArgue, tAgent, mudSadToHappy, + -10, + -10).
  784verb_affordance(actArgue, tAgent, mudFun, 20, 10).
  785verb_affordance(actAttack, tAgent, mudNonLonelinessSocial, 10, 15).
  786verb_affordance(actAttack, tAgent, mudSadToHappy, 0, + -10).
  787verb_affordance(actAttack, tAgent, mudEnergy, 0, + -10).
  788verb_affordance(actAttack, tAgent, mudFun, 20, 10).
  789verb_affordance(actKiss, tAgent, mudNonLonelinessSocial, 10, 15).
  790verb_affordance(actKiss, tAgent, mudSadToHappy, 10, 10).
  791verb_affordance(actKiss, tAgent, mudFun, 10, 10).
  792verb_affordance(actTouch, tTouchAble, mudFun, 1, 1).
  793verb_affordance(actTouch, tTouchAble, mudSecureRoom, 1, 1).
  794verb_affordance(actSit, tSitAble, mudComfort, 1, 0).
  795verb_affordance(actSit, tSitAble, mudFun, 1, 1).
  796verb_affordance(actSit, tSitAble, mudSecureRoom, 1, 1).
  797verb_affordance(actPutXOn, tHasSurface, mudFun, + -2, 2).
  798verb_affordance(actPutXOn, tHasSurface, mudEnergy, 0, + -1).
  799verb_affordance(actEat, tEatAble, mudNonHunger, 100, 100).
  800verb_affordance(actEat, tEatAble, mudHygiene, 0, + -10).
  801verb_affordance(actSleep, tLayAble, mudComfort, 5, 5).
  802verb_affordance(actSleep, tLayAble, mudEnergy, 20, 20).
  803verb_affordance(actClean, tLookAble, mudFun, + -2, 2).
  804verb_affordance(actClean, tLookAble, mudEnergy, 0, + -1).
  805verb_affordance(actObserve, tLookAble, mudFun, 2, 1).
  806verb_affordance(actObserve, tLookAble, mudEnergy, 0, + -1).
  807verb_affordance(actExcersize, tSitAble, mudFun, 10, 10).
  808verb_affordance(actExcersize, tSitAble, mudHygiene, + -10, + -10).
  809verb_affordance(actTickle, tAgent, mudEnergy, + -10, + -10).
  810verb_affordance(actTickle, tAgent, mudFun, 20, 10).
  811verb_affordance(actSearch, tContainer, mudHygiene, 0, + -5).
  812verb_affordance(actSearch, tContainer, mudNonHunger, 40, 20).
  813verb_affordance(actArgue, tAgent, mudEnergy, + -11, + -20).
  814verb_affordance(actTalk, tAgent, mudNonLonelinessSocial, 11, 20).
  815verb_affordance(actAttack, tAgent, mudEnergy, + -11, + -20).
  816verb_affordance(actKiss, tAgent, mudNonLonelinessSocial, 11, 20).
  817verb_affordance(actKiss, tAgent, mudFun, 21, 20).
  818verb_affordance(actThinkAbout, tLookAble, mudFun, 1, 2).
  819
  820:- dynamic verb_for_type/2.
  821
  822verb_for_type(actTravelThru, tPassAble).
  823verb_for_type(actObserve, tTelevision).
  824verb_for_type(actBumpIntoBarrier, tFurniture).
  825verb_for_type(actLiveAtLeastAMinute, tAgentSelf).
  826verb_for_type(actOperate, tShower).
  827verb_for_type(actClean, tShower).
  828verb_for_type(actOperate, tBathTub).
  829verb_for_type(actClean, tBathTub).
  830verb_for_type(actOperate, tSink).
  831verb_for_type(actClean, tSink).
  832verb_for_type(actDance, tDanceBall).
  833verb_for_type(actOperate, tWashingMachine).
  834verb_for_type(actClean, tWashingMachine).
  835verb_for_type(actOperate, tClothesDryer).
  836verb_for_type(actClean, tClothesDryer).
  837verb_for_type(actSleep, tBed).
  838verb_for_type(actSleep, tMattress).
  839verb_for_type(actSit, tChair).
  840verb_for_type(actSit, tCouch).
  841verb_for_type(actObserve, tRadio).
  842verb_for_type(actObserve, tMirror).
  843verb_for_type(actPotty, tToilet).
  844verb_for_type(actClean, tToilet).
  845verb_for_type(actSearch, tFridge).
  846verb_for_type(actOperate, tStove).
  847verb_for_type(actOperate, tMicrowave).
  848verb_for_type(actOperate, tTreadmill).
  849verb_for_type(actOperate, tFixedLamp).
  850verb_for_type(actOperate, tPoolTable).
  851verb_for_type(actPutXOn, tShelf).
  852verb_for_type(actPutXOn, tDesk).
  853verb_for_type(actPutXOn, tCounter).
  854verb_for_type(actPutXIn, tContainer).
  855verb_for_type(actPutXOn, tTable).
  856verb_for_type(actPutXIn, tTrashContainer).
  857verb_for_type(actPutXOn, tBookcase).
  858verb_for_type(actObserve, tReadAble).
  859verb_for_type(actTake, tReadAble).
  860verb_for_type(actEat, tEatAble).
  861verb_for_type(actTake, tEatAble).
  862verb_for_type(actObserve, tArt).
  863verb_for_type(actOperate, tDanceFloor).
  864verb_for_type(actOperate, tComputer).
  865verb_for_type(actTalk, tAgent).
  866verb_for_type(actArgue, tAgent).
  867verb_for_type(actAttack, tAgent).
  868verb_for_type(actKiss, tAgent).
  869verb_for_type(actTouch, tTouchAble).
  870verb_for_type(actSit, tSitAble).
  871verb_for_type(actPutXOn, tHasSurface).
  872verb_for_type(actEat, tEatAble).
  873verb_for_type(actTake, tCarryAble).
  874verb_for_type(actSleep, tLayAble).
  875verb_for_type(actClean, tLookAble).
  876verb_for_type(actObserve, tLookAble).
  877verb_for_type(actExcersize, tSitAble).
  878verb_for_type(actTickle, tAgent).
  879verb_for_type(actSearch, tContainer).
  880verb_for_type(actThinkAbout, tLookAble).
  881
  882
  883*/
  884
  885
  886:-ain({simbots_templates(Templ)} ==> vtActionTemplate(Templ)).
  887
  888:- dmsg(call(listing(vtActionTemplate))).