1% :- if(( ( \+ ((current_prolog_flag(logicmoo_include,Call),Call))) )). 
    2% :- swi_module(mud_simple_decl_parser, [parserVars/3,parserVars/4,asserta_parserVars/3]).
    3/* * <module> simple_decl_parser - an example of simple parsing of an inform7 like languages.
    4%
    5% Logicmoo Project PrologMUD: A MUD server written in Prolog
    6% Maintainer: Douglas Miles
    7% Dec 13, 2035
    8%
    9*/
   10% :- endif.
   11
   12:- check_clause_counts.   13:- include(prologmud(mud_header)).   14:- expects_dialect(pfc).   15:- check_clause_counts.   16
   17:-discontiguous((translation_spo/6,parserTest/2,parserTest/3,translation_w//
   18                                                                              1)).   19:-dynamic((translation_spo/6,parserTest/2,parserTest/3,translation_w//
   20                                                                         1)).   21:-thread_local(loosePass/0).   22:-thread_local(debugPass/0).   23:-dynamic(parserVars/4).   24
   25
   26glue_words(W):- member(W,[is,a,the,in,carries,'An','A','The',was,of,type]).
   27
   28toCamelAtom(List,O):-((\+((member(IS,List),glue_words(IS))),toCamelAtom00(List,O))),!.
   29
   30% toCamelAtom00(I,O):-toCamelAtom0(I,O).
   31toCamelAtom00(I,O):-toCamelcase(I,O).
   32
   33 % :- set_prolog_flag(subclause_expansion,true).
   34
   35
   36==>vtColor(vRed).
   37
   38==>ttValueType(vtColor).
   39
   40'==>'((isa(X,ttValueType)/(X\==vtValue)),
   41  (genls(X,vtValue),completelyAssertedCollection(X))).
   42
   43==>completelyAssertedCollection(vtValue).
   44
   45==>isa(vtValue,ttValueType).
   46
   47
   48==>typeGenls(ttValueType,vtValue).
   49
   50
   51:-must(vtColor(vRed)).   52:-must((isa(vRed,REDISA),genls(REDISA,vtValue))).   53
   54
   55 % :- set_prolog_flag(subclause_expansion,false).
   56
   57:- baseKB:ensure_loaded(library(multimodal_dcg)).   58
   59
   60asserta_parserVars(N,V,Type):- show_failure(current_agent(A)),asserta(parserVars(A,N,V,Type)).
   61:-export(parserVars/3).   62parserVars(N,V,Type):- show_failure(current_agent(A);A=iCurrentAgentFn),
   63   (parserVars_local(A,N,V,Type)*->true;parserVars_falback(global,N,V,Type)).
   64
   65parserVars_local(A,(N1;N2),V,Type):-!,parserVars_local(A,N1,V,Type);parserVars_local(A,N2,V,Type).
   66parserVars_local(A,N,V,Type):-parserVars(A,N,V,Type).
   67
   68parserVars_falback(_,N,V,Type):-parserVars_local(global,N,V,Type).
   69
   70toCol(Txt,I,TCOL):-member(TCOL,[tCol,tObj,tSpatialThing,vtValue,ttTypeType]),show_success(toCol_0,toCol_0(Txt,I,TCOL)),!.
   71
   72toCol_0(Txt,O,TCOL):-member(Pfx-Sfx- _ISACISA, 
   73         [
   74          ''-''-_,
   75          't'-''-'tCol',
   76          'tt'-'Type'-'ttTypeType',
   77          'vt'-''-'ttValueTypeType',
   78          'v'-''-'vtValue',
   79          'i'-'7'-'tSpatialThing',
   80          'i'-'7'-'ttSpatialType',
   81          't'-'Able'-'ttTypeByAction',
   82          'tt'-''-'ttTypeType',
   83          ''-''-_
   84           ]),atom_concat(Pfx,Txt,I),atom_concat(I,Sfx,O),isa(O,TCOL),!.
   85
   86is_a --> is_was, [a].
   87is_a --> is_was.
   88
   89is_was --> [is].
   90is_was --> [was].
   91is_was --> [be].
   92is_was --> [are].
   93
   94is_in --> is_was, [in].
   95is_in --> is_was, [inside,of].
   96is_in --> is_was, [carried,by].
   97
   98is_type_of --> is_a, [type,of].
   99is_type_of --> is_a, [type].
  100
  101detn(exists) --> [the].
  102detn(exists) --> ['The'].
  103detn(exists) --> [some].
  104detn(all) --> [all].
  105detn(indef) --> [a].
  106detn(indef) --> ['A'].
  107detn(indef) --> [an].
  108detn(indef) --> ['An'].
  109
  110collection(I,Col,More)--> detn(_),!,collection(I,Col,More).
  111collection(I,Col,true)--> collection0(I,Col).
  112collection(I,Col,More)--> attribute(_Pred,I,_Value,More),collection0(I,Col).
  113collection(I,Col,More)--> attribute(_Pred,I,_Value,More),{call_u(isa(I,Col))}.
  114
  115
  116collection0(I,Col)--> [A,B,C],{toCamelAtom([A,B,C],O),collection00(O,I,Col)}.
  117collection0(I,Col)--> [A,B],{toCamelAtom([A,B],O),collection00(O,I,Col)}.
  118collection0(I,Col)--> [O],{collection00(O,I,Col)}.
  119
  120collection00(A,I,Col):-mudKeyword(I,W),string_equal_ci(A,W),toCol(A,I,Col).
  121collection00(M,I,Col):-toCol(M,I,Col).
  122collection00(A,I,Col):-toPropercase(A,O),toCol(O,I,Col).
  123
  124subject(I,More)-->subject(I,_,More).
  125subject(I,T,true)-->(['This'];['this']),!,{must((parserVars(isThis,I,T);parserVars(_,I,T)))}.
  126subject(I,T,true)--> [IT],{string_equal_ci(IT,ITLC),parserVars(isParserVar(ITLC),I,T)},!.
  127subject(I,T,true)--> [IT],{string_equal_ci(IT,ITLC),parserVars((ITLC),I,T)},!.
  128subject(I,T,More)--> dcgOptional(detn(_)),collection(I,T,More),{(asserta_parserVars(isThis,I,T))}.
  129
  130object(I,More)-->object(I,_,More).
  131object(I,T,true)-->([it];['It'];['This'];['this']),!,{must((parserVars(object,I,T);parserVars(_,I,T)))}.
  132object(I,T,More)--> detn(_),!,collection(I,T,More),{(asserta_parserVars(object,I,T))}.
  133object(I,T,More)--> collection(I,T,More),{(asserta_parserVars(object,I,T))}.
  134
  135% big , red , flat, etc
  136attribute(Pred,I,C,t(Pred,I,C))--> [W],{ \+ glue_words(W),collection00(W,C,vtValue), isa(C,What),\=(What,vtValue),isa(What,ttValueType),argIsa(Pred,2,What)}.
  137
  138
  139dcgParse213(A1,A2,A3,S,E):-append([L|Left],[MidT|RightT],S),phrase(A2,[MidT|RightT],EE),     ((phrase(A1,[L|Left],[]),phrase(A3,EE,E))).
  140dcgParse213(A1,A2,A3,S,E):-debugPass,append([L|Left],[MidT|RightT],S),phrase(A2,[MidT|RightT],EE), trace, must((phrase(A1,[L|Left],[]),phrase(A3,EE,E))).
  141
  142p_predicate(Pred,_Arg1Isa,_Arg2Isa)-->predicate0(Pred),{current_predicate(Pred/_),!}.
  143p_predicate(Pred,_Arg1Isa,_Arg2Isa)-->{loosePass},predicate0(Pred).
  144
  145
  146predicate0(mudStowing)-->[carries].
  147predicate0(mudWielding)-->[wields].
  148predicate0(mudLikes)-->[likes].
  149predicate0(mudColor)-->[is,colored].
  150predicate0(localityOfObject)-->is_in.
  151predicate0(Pred)-->[has,Color],{i_name(mud,Color,Pred)}.
  152predicate0(isa)-->is_type_of.
  153predicate0(Pred)-->[is,the,Color],{i_name(mud,Color,Pred)}.
  154predicate0(Pred)-->[Likes],{atom_concat(Like,'s',Likes),i_name(mud,Like,Pred)}.
  155predicate0(Pred)-->[is,Colored],{atom_concat(Color,'ed',Colored),i_name(mud,Color,Pred)}.
  156predicate0(isa)-->is_a.
  157predicate0(mudRelates)-->is_was.
  158predicate0(isa)-->[is].
  159
  160 % :- set_prolog_flag(subclause_expansion,true).
  161
  162
  163:- kb_shared((onSpawn)/1).  164
  165:- expects_dialect(pfc).  166
  167tCol('tRoom').
  168
  169% :-ignore(show_call(phrase(collection(I,T,More),[red,room]))).
  170
  171%TODO "All couches are things."
  172
  173% assert_text(iWorld7,"couches are hard sometimes").
  174
  175parserTest(A,B):-parserTest(A,B,_).
  176
  177:-assertz_if_new(parserTest(iWorld7,"A television is usually in the living room.")).  178
  179% :-assert_text_now(iWorld7,"You are in a well kept garden.").
  180
  181
  182translation_spo(Prolog,localityOfObject,I,C) --> dcgParse213(subject(I,More1),is_in,object(C,More2)),{conjoin(More1,More2,Prolog)}.
  183
  184
  185% :-assertz_if_new(parserTest(iKitchen7,"This is the red room.")).
  186
  187:-assertz_if_new(parserTest(iWorld7,"The player carries the sack.")).  188translation_spo(Prolog,Pred,I,C) --> dcgParse213(subject(I,Arg1Isa,More1),p_predicate(Pred,Arg1Isa,Arg2Isa),object(C,Arg2Isa,More2)),{conjoin(More1,More2,Prolog)}.
  189
  190:-assertz_if_new(parserTest(iWorld7,"room is type of tRegion")).  191translation_spo(Prolog,isa,I,C) --> dcgParse213(subject(I,tCol,More1),is_type_of,object(C,tCol,More2)),{conjoin(More1,More2,Prolog)}.
  192
  193:-assertz_if_new(parserTest(iWorld7,"The Living room is a room.")).  194tCol('tSack').
  195
  196:-assertz_if_new(parserTest(iWorld7,"The sack is a container.")).  197translation_spo(Prolog,isa,I,C) --> dcgParse213(subject(I,More1),is_a,object(C,tCol,More2)),{conjoin(More1,More2,Prolog)}.
  198
  199
  200:-assert_if_new(vtSize('vBulky')).  201
  202translation_spo(Prolog,isa,I,C) --> dcgParse213(subject(I,More1),is_was,object(C,_,More2)),{conjoin(More1,More2,Prolog)}.
  203translation_spo(Prolog,Pred,I,C) --> dcgParse213(subject(I,More1),is_was,attribute(Pred,I,C,More2)),{conjoin(More1,More2,Prolog)}.
  204
  205%:-assertz_if_new(parserTest(iWorld7,"A coffee table is in the living room.")).
  206%:-assertz_if_new(parserTest(iWorld7,"It is bulky.")).
  207
  208tCol('tRemoteControl').
  209:-assertz_if_new(parserTest(iWorld7,"A remote control is in the living room.")).  210:-assertz_if_new(parserTest(iWorld7,"A tv guide is a type of item.")).  211
  212tCol('tTvGuide').
  213:-assertz_if_new(parserTest(iWorld7,"A tv guide is in the living room.")).  214
  215%:-assertz_if_new(parserTest(iWorld7,"The paper clip is on the coffee table.")).
  216
  217:-assertz_if_new(parserTest(iWorld7,"A tv guide is a type of book.")).  218
  219toplevel_type(InstISA):-member(InstISA,[tWorld,tRegion,tAgent,tItem,tObj,ftSpec,tCol,ftTerm]).
  220% toplevel_type(InstISA):-ftSpec(InstISA).
  221
  222
  223get_ctx_isa(InstISA,Inst,InstISA):- toplevel_type(InstISA),must((isa(Inst,InstISA))),!.
  224get_ctx_isa(Inst,Inst,InstISA):- must(show_call(once(((toplevel_type(InstISA),isa(Inst,InstISA)))))),!.
  225
  226system:assert_text(InstIn,String):- cwc, get_ctx_isa(InstIn,Inst,InstISA),!,assert_text(Inst,InstISA,String).
  227
  228assert_text(Inst,InstISA,String):-  cwc, 
  229       % context changed   and not the tWorld?                
  230          % v this is for when there was no prior context
  231  ((parserVars(context,Inst0,_) -> (((Inst0 \==Inst),InstISA\==tWorld) 
  232   -> (asserta_parserVars(isThis,Inst,InstISA)); true) ; (asserta_parserVars(isThis,Inst,InstISA))), 
  233    locally(parserVars(context,Inst,InstISA),assert_text_now(Inst,InstISA,String))).
  234
  235assert_text_now(Inst,InstISA,String):-   
  236 on_f_log_ignore(( 
  237  % parse the string to attributed text
  238 to_word_list(String,WL),!,to_icase_strs(WL,IC),!,   
  239   ((phrase(translation_dbg_on_fail(Inst,InstISA,PrologO),IC),
  240   ain(asserted_text(Inst,String,PrologO)),     
  241     ain(onSpawn(PrologO)))))).
  242
  243:- kb_shared(asserted_text/3).  244
  245tCol(describedTyped).
  246describedTyped(tRegion).
  247describedTyped(tObj).
  248(describedTyped(Col),isa(Inst,Col),mudDescription(Inst,String)/ 
  249  ( \+asserted_text(Inst,String,_), \+assert_text(Inst,String))) ==> mudDescriptionHarder(Inst,String).
  250
  251:- export(to_icase_strs/2).  252to_icase_strs(WL,IC):-maplist(to_icase_str,WL,IC).
  253
  254
  255:- export(to_icase_str/2).  256% to_icase_str(SL,IC):-string_to_atom(SL,SA),string_to_atom(SS,SA),when(?=(IC,Y),(trace,(Y=SA;Y=SS))).
  257to_icase_str(SL,IC):-string_to_atom(SL,SA),string_to_atom(SS,SA),when(nonvar(IC);?=(IC,IC),(IC=SA;IC=SS)).
  258
  259
  260% somethingCanBe(tFountainDrink,[vSmall,vMedium,vLarge]).
  261
  262translation_for(Room,'tRegion',(isa(Room,'tCorridor'),isa(Room,'tWellLit')),WS,[]):-concat_atom(WS,' ',O),if_defined(tag_pos(O,IO),fail),IO = 
  263 ('S'('NP'('PRP'('You')),'VP'('VBP'(find),'NP'('PRP'(yourself)),'PP'('IN'(in),'NP'('NP'('DT'(the),'NN'(middle)),'PP'('IN'(of),
  264  'NP'('NP'('DT'(a),'ADJP'('RB'(well),'JJ'(lit)),'NN'(corridor)),'PP'('IN'(on),'NP'('DT'(the),'NN'('Enterprise')))))))))).
  265
  266translation_for(_Inst,_InstISA,t(M,Prolog),WS,WE):- once((append(LeftSide,RightSide,WS), modality(M,List,Replace),append(LeftL,List,LeftSide),
  267  append(LeftL,List,LeftSide),append(LeftL,Replace,Left),
  268   append(Left,RightSide,NewWS))),
  269   translation_w(Prolog,NewWS,WE),!.
  270translation_for(_Inst,_InstISA,Prolog) --> translation_w(Prolog).
  271translation_for(_Inst,_InstISA,Prolog,WS,WE):-locally(loosePass,translation_w(Prolog,WS,WE)).
  272
  273
  274translation_dbg_on_fail(Inst,InstISA,Prolog)-->translation_for(Inst,InstISA,Prolog),!.
  275translation_dbg_on_fail(Inst,InstISA,Prolog,WS,WE):-locally(debugPass,translation_for(Inst,InstISA,Prolog,WS,WE)).
  276
  277%:-assertz_if_new(parserTest(iWorld7,"Buffy the Labrador retriever is lounging here, shedding hair all over the place.")).
  278%:-assertz_if_new(parserTest(iWorld7,"You can also see a sugar candy doll house here.")).
  279
  280mudKeyword(tItem,"thing").
  281mudKeyword(isSelfRegion,"here").
  282mudKeyword(tThing,"object").
  283
  284==>
  285 baseKB:type_action_info(tHumanControlled,
  286   actAddText(isOptional(tTemporalThing,isThis),ftText),
  287     "Development add some Text to a room.  Usage: addtext a sofa is in here").
  288
  289
  290a_command(Agent,actAddText(What,StringM)):- ground(What:StringM),
  291 locally(parserVars(isThis,What,ftTerm),
  292   locally(parserVars(isSelfAgent,Agent,tAgent),   
  293       must(assert_text(What,StringM)))).
  294
  295
  296translation_w(t(M,Prolog),WS,WE):- once((append(LeftSide,RightSide,WS), modality(M,List,Replace),append(LeftL,List,LeftSide),append(LeftL,Replace,Left),
  297   append(Left,RightSide,NewWS))),translation_w(Prolog,NewWS,WE),!.
  298translation_w(Prolog) --> translation_spo(More2,P,S,O),!,{conjoin(More2,t(P,S,O),Prolog)}.
  299
  300:-assertz_if_new(parserTest(iWorld7,"An emitter has a truth state called action keeping silent.",
  301   relationAllExists(mudActionKeepingSilient,tEmitter,ftBool))).  302
  303translation_w(relationAllExists(mudActionKeepingSilient,tEmitter,ftBoolean))
  304  --> ['An',emitter,has,a,truth,state,called,action,keeping,silent].
  305
  306:-assertz_if_new(parserTest(iWorld7,"An object has a text called printed name.")).  307translation_w(relationAllExists(P,C,DT))  
  308  --> collection(C),[has,a],datatype(DT),[called],predicate_named(P).
  309
  310collection(C)-->subject(C,tCol,true).
  311datatype(ftBoolean)--> dcgOptional(detn(_)),[truth,state].
  312datatype(ftText)--> dcgOptional(detn(_)),[text].
  313datatype(ftTerm)--> dcgOptional(detn(_)),[value].
  314
  315predicate_named(Pred) --> dcgAnd(theText(Text),dcgLenBetween(1,5)),
  316  {toCamelAtom(Text,O),i_name(mud,O,Pred),ignore(assumed_isa(Pred,tPred))}.
  317
  318:- dmsg(call(listing(predicate_named//1
  319              ))).  320
  321assumed_isa(I,C):-isa(I,C),!.
  322assumed_isa(I,C):-loosePass,assert_isa(I,C),!.
  323
  324:- call(must(dcgAnd(dcgLenBetween(5,1),theText(_Text),[a,b,c],[]))).  325:- must_or_rtrace(call(must(predicate_named(_P,[proper,-,named],[])))).  326
  327
  328:-assertz_if_new(parserTest(iWorld7,"An object can be proper-named or improper-named.",partitionedInto(tObj,tProperNamed,tImproperNamed))).  329translation_w(partitionedInto(C1,C2,C3)) --> collection(C1),[be],collection(C2),[or],collection(C3).
  330
  331
  332:-assertz_if_new(parserTest(iWorld7,"An object is usually improper-named.",relationMostInstance(isa,tObj,tImproperNamed))).  333translation_w(relationMostInstance(isa,C1,C2)) --> collection(C1),[is,usually],collection(C2).  
  334
  335:-assertz_if_new(parserTest(iWorld7,"A thing can be scenery.", relationSomeInstance(isa,tItem,tScenery))).  336translation_w(relationSomeInstance(isa,C1,C2)) --> collection(C1),[be],collection(C2).  
  337
  338:-assertz_if_new(parserTest(iWorld7,"The outside is a direction.", t(isa,vOutside,vtDirection))).  339translation_w(isa(C1,C2)) --> detn(exists),col(v,C1),[is,a],col(vt,C2).  
  340
  341col(Pfx,C)-->subject(C,_,true),{atom_concat(Pfx,_,C)}.
  342col(_Pfx,C)-->{loosePass},subject(C,_,true).
  343
  344% set of small things in the world
  345tCol(tSmall).  % I dont like doing this with adjectives.. but it cant be argued to be sane
  346tSmall(X) <==> mudSize(X,vSmall).
  347
  348% set of green things in the world
  349tCol(tGreen).
  350tGreen(X) <==> mudColor(X,vGreen).
  351
  352:-check_clause_counts.  353
  354%:-assertz_if_new(parserTest(iWorld7,"All green books are small.", (tGreen(X),tBook(X))==>tSmall(X))).
  355%:-assertz_if_new(parserTest(iWorld7,"Most green books are small.", pfc_default((tGreen(X),tBook(X))==>tSmall(X)))).
  356
  357/*   The litmus
  358
  359A thing can be lit or unlit. A thing is usually unlit.
  360
  361Y can be C1 or C2.  
  362Y is [usually] C2.
  363
  364
  365An object has a text called printed name.  --> relationAllExists(mudPrintedName,tObj,ftText).
  366An object has a text called printed plural name.  --> mudPrintedPluralName(tObj,ftText).
  367An object has a text called an indefinite article.  --> mudIndefinateArticle(tObj,ftText).
  368An object can be plural-named or singular-named. An object is usually singular-named.  
  369                                                     --> partitionedInto(tObj,tSingularNamed,tPluralNamed). 
  370                                                         relationMostInstance(isa,tObj,tSingularNamed).
  371
  372An object can be proper-named or improper-named. An object is usually improper-named.
  373                                             --> partitionedInto(tObj,tProperNamed,tImproperNamed).  
  374                                                 relationMostInstance(isa,tObj,tImproperNamed).
  375
  376A room can be privately-named or publically-named. A room is usually publically-named.
  377                                             --> partitionedInto(tRoom,tPrivatelyNamed,tPublicallyNamed). 
  378                                                 relationMostInstance(isa,tObj,tPublicallyNamed).
  379
  380
  381A room can be lighted or dark. A room is usually lighted.
  382A room can be visited or unvisited. A room is usually unvisited.
  383A room has a text called description.
  384
  385
  386
  387
  388A thing can be edible or inedible. A thing is usually inedible.
  389A thing can be fixed in place or portable. A thing is usually portable.
  390
  391A thing can be scenery.   -->  relationSomeInstance(isa,tItem,tScenery).
  392A thing can be wearable.  -->  relationSomeInstance(isa,tItem,tWearAble).
  393
  394A thing can be pushable between rooms.   -->  relationSomeInstance(isa,tItem,tPushAble).  % between rooms?
  395
  396A direction is a type of value.  -->  isa(vtDirection,ttValueType).
  397The north is a direction.  -->  isa(vNorth,vtDirection).
  398The northeast is a direction.  --> ..
  399The northwest is a direction.
  400The south is a direction.
  401The southeast is a direction.
  402The southwest is a direction.
  403The east is a direction.
  404The west is a direction.
  405The up is a direction.
  406The down is a direction.
  407The inside is a direction.
  408The outside is a direction.
  409
  410The north has opposite south. Understand "n" as north.   --> mudHasOpposite(vNorth,vSouth).  mudKeyword(vNorth,"n").
  411The northeast has opposite southwest. Understand "ne" as northeast.
  412The northwest has opposite southeast. Understand "nw" as northwest.
  413The south has opposite north. Understand "s" as south.
  414The southeast has opposite northwest. Understand "se" as southeast.
  415The southwest has opposite northeast. Understand "sw" as southwest.
  416The east has opposite west. Understand "e" as east.
  417The west has opposite east. Understand "w" as west.
  418Up has opposite down. Understand "u" as up.
  419Down has opposite up. Understand "d" as down.
  420Inside has opposite outside. Understand "in" as inside.
  421Outside has opposite inside. Understand "out" as outside.
  422
  423??????? TODO ?????????
  424The inside object translates into I6 as "in_obj".
  425The outside object translates into I6 as "out_obj".
  426
  427??????? TODO ?????????
  428The verb to be above implies the mapping up relation.
  429The verb to be mapped above implies the mapping up relation.
  430The verb to be below implies the mapping down relation.
  431The verb to be mapped below implies the mapping down relatio
  432
  433A door has an object called other side.
  434The other side property translates into I6 as "door_to".
  435Leading-through relates one room (called the other side) to various doors.
  436The verb to be through implies the leading-through relation.
  437
  438S33. Containers and supporters. The carrying capacity property is the exception to the remarks above
  439about the qualitative nature of the world model: here for the first and only time we have a value which can
  440be meaningfully compared.
  441Section SR1/6 - Containers
  442The specification of container is "Represents something into which portable
  443things can be put, such as a teachest or a handbag. Something with a really
  444large immobile interior, such as the Albert Hall, had better be a room
  445instead."
  446A container can be enterable.
  447A container can be opaque or transparent. A container is usually opaque.
  448A container has a number called carrying capacity.
  449The carrying capacity of a container is usually 100.
  450Include (- has container, -) when defining a container
  451
  452The specification of supporter is "Represents a surface on which things can be
  453placed, such as a table."
  454A supporter can be enterable.
  455A supporter has a number called carrying capacity.
  456The carrying capacity of a supporter is usually 100.
  457A supporter is usually fixed in place.
  458Include (-
  459has transparent supporter
  460-) when defining a supporte
  461
  462A door can be open or closed. A door is usually closed.
  463A door can be openable or unopenable. A door is usually openable.
  464A container can be open or closed. A container is usually open.
  465A container can be openable or unopenable. A container is usually unopenable.
  466
  467Before rules is a rulebook. [20]
  468Instead rules is a rulebook. [21]
  469Check rules is a rulebook. [22]
  470Carry out rules is a rulebook. [23]
  471After rules is a rulebook. [24]
  472Report rules is a rulebook. [25]
  473
  474Action-processing rules is a rulebook. [10]
  475The action-processing rulebook has a person called the actor.
  476Setting action variables is a rulebook. [11]
  477The specific action-processing rules is a rulebook. [12]
  478The specific action-processing rulebook has a truth state called action in world.
  479The specific action-processing rulebook has a truth state called action keeping silent.
  480The specific action-processing rulebook has a rulebook called specific check rulebook.
  481The specific action-processing rulebook has a rulebook called specific carry out rulebook.
  482The specific action-processing rulebook has a rulebook called specific report rulebook.
  483The specific action-processing rulebook has a truth state called within the player''s sight.
  484The player''s action awareness rules is a rulebook. [13]
  485S16. The rules on accessibility and visibility, which control whether an action is physically possible, have
  486named outcomes as a taste of syntactic sugar.
  487Accessibility rules is a rulebook. [14]
  488Reaching inside rules is an object-based rulebook. [15]
  489Reaching inside rules have outcomes allow access (success) and deny access (failure).
  490Reaching outside rules is an object-based rulebook. [16]
  491Reaching outside rules have outcomes allow access (success) and deny access (failure).
  492Visibility rules is a rulebook. [17]
  493Visibility rules have outcomes there is sufficient light (failure) and there is
  494insufficient light (success).
  495S17. Two rulebooks govern the processing of asking other people to carry out actions:
  496Persuasion rules is a rulebook. [18]
  497Persuasion rules have outcomes persuasion succeeds (success) and persuasion fails (failure).
  498Unsuccessful attempt by is a rulebook. [19
  499
  500*/
  501:- include(prologmud(mud_footer)).  502:- all_source_file_predicates_are_transparent.