1:-include(library('ec_planner/ec_test_incl')).    2:-expects_dialect(pfc).    3 %  loading(always,'examples/Cassimatis2002/TwoScreens.e').
    4%;
    5%; Copyright (c) 2005 IBM Corporation and others.
    6%; All rights reserved. This program and the accompanying materials
    7%; are made available under the terms of the Common Public License v1.0
    8%; which accompanies this distribution, and is available at
    9%; http://www.eclipse.org/legal/cpl-v10.html
   10%;
   11%; Contributors:
   12%; IBM - Initial implementation
   13%;
   14%; @phdthesis{Cassimatis:2002,
   15%;   author = "Nicholas L. Cassimatis",
   16%;   year = "2002",
   17%;   title = "Polyscheme: A Cognitive Architecture for Integrating Multiple Representation and Inference Schemes",
   18%;   address = "Cambridge, MA",
   19%;   school = "Program in Media Arts and Sciences, School of Architecture and Planning, Massachusetts Institute of Technology",
   20%; }
   21%;
   22
   23% load foundations/Root.e
   24
   25% load foundations/EC.e
   26
   27% load examples/Cassimatis2002/PolySpace.e
   28
   29% grid G1
   30==> t(grid,g1).
   31
   32% object X,Y,Screen1,Screen2
   33==> t(object,x).
   34==> t(object,y).
   35==> t(object,screen1).
   36==> t(object,screen2).
   37%; perceptions:
   38
   39
   40% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:27
   41% Shape(X,Round).
   42shape(x,round).
   43
   44
   45% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:28
   46% Color(X,Red).
   47color(x,red).
   48
   49
   50% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:29
   51% Shape(Y,Round).
   52shape(y,round).
   53
   54
   55% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:30
   56% Color(Y,Red).
   57color(y,red).
   58
   59
   60% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:31
   61% Shape(Screen1,Square).
   62shape(screen1,square).
   63
   64
   65% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:32
   66% Color(Screen1,Green).
   67color(screen1,green).
   68
   69
   70% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:33
   71% Shape(Screen2,Square).
   72shape(screen2,square).
   73
   74
   75% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:34
   76% Color(Screen2,Green).
   77color(screen2,green).
   78
   79
   80% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:35
   81% [time]
   82 % HoldsAt(Location(G1,Screen1,2,0),time).
   83holds_at(location(g1,screen1,2,0),Time).
   84
   85
   86% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:36
   87% [time]
   88 % HoldsAt(Location(G1,Screen2,4,0),time).
   89holds_at(location(g1,screen2,4,0),Time).
   90
   91
   92% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:37
   93% HoldsAt(Location(G1,X,1,1),0).
   94axiom(initially(location(g1, x, 1, 1)),
   95    []).
   96
   97
   98% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:38
   99% HoldsAt(Location(G1,Y,5,1),4).
  100holds_at(location(g1,y,5,1),4).
  101
  102
  103% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:40
  104% [xcoord,ycoord,time]
  105% xcoord!=% 2 & xcoord!=4 & !(xcoord=1 & ycoord=1 & time=0) ->
  106% !HoldsAt(Location(G1,X,xcoord,ycoord),time) |
  107% xcoord=5 & ycoord=1 & time=4 & Equal(X,Y).
  108
  109 /*   if(({dif(Xcoord, 2)}, {dif(Xcoord, 4)}, (not(equals(Xcoord, 1));not(equals(Ycoord, 1));not(equals(Time, 0)))),
  110          (not(holds_at(location(g1, x, Xcoord, Ycoord), Time));Xcoord=5, Ycoord=1, Time=4, equal(x, y))).
  111 */
  112
  113 /*  not({dif(X, 2)}) :-
  114       ( { dif(X, 4)
  115         },
  116         (   not(equals(X, 1))
  117         ;   not(equals(Equals_Param, 1))
  118         ;   not(equals(Time4, 0))
  119         )
  120       ),
  121       holds_at(location(g1, x, X, Equals_Param), Time4),
  122       (   not(equals(X, 5))
  123       ;   not(equals(Equals_Param, 1))
  124       ;   not(equals(Time4, 4))
  125       ;   not(equal(x, y))
  126       ).
  127 */
  128% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:43
  129axiom(not({dif(X, 2)}),
  130   
  131    [ not(equals(X, 5)),
  132      not(equals(X, 1)),
  133      { dif(X, 4)
  134      },
  135      holds_at(location(g1, x, X, Equals_Param), Time4)
  136    ]).
  137axiom(not({dif(X, 2)}),
  138   
  139    [ not(equals(Equals_Param, 1)),
  140      not(equals(X, 1)),
  141      { dif(X, 4)
  142      },
  143      holds_at(location(g1, x, X, Equals_Param), Time4)
  144    ]).
  145axiom(not({dif(X, 2)}),
  146   
  147    [ not(equals(Time4, 4)),
  148      not(equals(X, 1)),
  149      { dif(X, 4)
  150      },
  151      holds_at(location(g1, x, X, Equals_Param), Time4)
  152    ]).
  153axiom(not({dif(X, 2)}),
  154   
  155    [ not(equal(x, y)),
  156      not(equals(X, 1)),
  157      { dif(X, 4)
  158      },
  159      holds_at(location(g1, x, X, Equals_Param), Time4)
  160    ]).
  161axiom(not({dif(X, 2)}),
  162   
  163    [ not(equals(X, 5)),
  164      not(equals(Equals_Param, 1)),
  165      { dif(X, 4)
  166      },
  167      holds_at(location(g1, x, X, Equals_Param), Time4)
  168    ]).
  169axiom(not({dif(X, 2)}),
  170   
  171    [ not(equals(Equals_Param, 1)),
  172      not(equals(Equals_Param, 1)),
  173      { dif(X, 4)
  174      },
  175      holds_at(location(g1, x, X, Equals_Param), Time4)
  176    ]).
  177axiom(not({dif(X, 2)}),
  178   
  179    [ not(equals(Time4, 4)),
  180      not(equals(Equals_Param, 1)),
  181      { dif(X, 4)
  182      },
  183      holds_at(location(g1, x, X, Equals_Param), Time4)
  184    ]).
  185axiom(not({dif(X, 2)}),
  186   
  187    [ not(equal(x, y)),
  188      not(equals(Equals_Param, 1)),
  189      { dif(X, 4)
  190      },
  191      holds_at(location(g1, x, X, Equals_Param), Time4)
  192    ]).
  193axiom(not({dif(X, 2)}),
  194   
  195    [ not(equals(X, 5)),
  196      not(equals(Time4, 0)),
  197      { dif(X, 4)
  198      },
  199      holds_at(location(g1, x, X, Equals_Param), Time4)
  200    ]).
  201axiom(not({dif(X, 2)}),
  202   
  203    [ not(equals(Equals_Param, 1)),
  204      not(equals(Time4, 0)),
  205      { dif(X, 4)
  206      },
  207      holds_at(location(g1, x, X, Equals_Param), Time4)
  208    ]).
  209axiom(not({dif(X, 2)}),
  210   
  211    [ not(equals(Time4, 4)),
  212      not(equals(Time4, 0)),
  213      { dif(X, 4)
  214      },
  215      holds_at(location(g1, x, X, Equals_Param), Time4)
  216    ]).
  217axiom(not({dif(X, 2)}),
  218   
  219    [ not(equal(x, y)),
  220      not(equals(Time4, 0)),
  221      { dif(X, 4)
  222      },
  223      holds_at(location(g1, x, X, Equals_Param), Time4)
  224    ]).
  225
  226 /*  not({dif(X6, 4)}) :-
  227       (   not(equals(X6, 1))
  228       ;   not(equals(Equals_Param8, 1))
  229       ;   not(equals(Time7, 0))
  230       ),
  231       { dif(X6, 2)
  232       },
  233       holds_at(location(g1, x, X6, Equals_Param8), Time7),
  234       (   not(equals(X6, 5))
  235       ;   not(equals(Equals_Param8, 1))
  236       ;   not(equals(Time7, 4))
  237       ;   not(equal(x, y))
  238       ).
  239 */
  240axiom(not({dif(X6, 4)}),
  241   
  242    [ not(equals(X6, 5)),
  243      not(equals(X6, 1)),
  244      { dif(X6, 2)
  245      },
  246      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  247    ]).
  248axiom(not({dif(X6, 4)}),
  249   
  250    [ not(equals(Equals_Param8, 1)),
  251      not(equals(X6, 1)),
  252      { dif(X6, 2)
  253      },
  254      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  255    ]).
  256axiom(not({dif(X6, 4)}),
  257   
  258    [ not(equals(Time7, 4)),
  259      not(equals(X6, 1)),
  260      { dif(X6, 2)
  261      },
  262      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  263    ]).
  264axiom(not({dif(X6, 4)}),
  265   
  266    [ not(equal(x, y)),
  267      not(equals(X6, 1)),
  268      { dif(X6, 2)
  269      },
  270      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  271    ]).
  272axiom(not({dif(X6, 4)}),
  273   
  274    [ not(equals(X6, 5)),
  275      not(equals(Equals_Param8, 1)),
  276      { dif(X6, 2)
  277      },
  278      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  279    ]).
  280axiom(not({dif(X6, 4)}),
  281   
  282    [ not(equals(Equals_Param8, 1)),
  283      not(equals(Equals_Param8, 1)),
  284      { dif(X6, 2)
  285      },
  286      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  287    ]).
  288axiom(not({dif(X6, 4)}),
  289   
  290    [ not(equals(Time7, 4)),
  291      not(equals(Equals_Param8, 1)),
  292      { dif(X6, 2)
  293      },
  294      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  295    ]).
  296axiom(not({dif(X6, 4)}),
  297   
  298    [ not(equal(x, y)),
  299      not(equals(Equals_Param8, 1)),
  300      { dif(X6, 2)
  301      },
  302      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  303    ]).
  304axiom(not({dif(X6, 4)}),
  305   
  306    [ not(equals(X6, 5)),
  307      not(equals(Time7, 0)),
  308      { dif(X6, 2)
  309      },
  310      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  311    ]).
  312axiom(not({dif(X6, 4)}),
  313   
  314    [ not(equals(Equals_Param8, 1)),
  315      not(equals(Time7, 0)),
  316      { dif(X6, 2)
  317      },
  318      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  319    ]).
  320axiom(not({dif(X6, 4)}),
  321   
  322    [ not(equals(Time7, 4)),
  323      not(equals(Time7, 0)),
  324      { dif(X6, 2)
  325      },
  326      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  327    ]).
  328axiom(not({dif(X6, 4)}),
  329   
  330    [ not(equal(x, y)),
  331      not(equals(Time7, 0)),
  332      { dif(X6, 2)
  333      },
  334      holds_at(location(g1, x, X6, Equals_Param8), Time7)
  335    ]).
  336
  337 /*  equals(X9, 1) :-
  338       { dif(X9, 4)
  339       },
  340       { dif(X9, 2)
  341       },
  342       holds_at(location(g1, x, X9, Equals_Param11), Time10),
  343       (   not(equals(X9, 5))
  344       ;   not(equals(Equals_Param11, 1))
  345       ;   not(equals(Time10, 4))
  346       ;   not(equal(x, y))
  347       ).
  348 */
  349axiom(equals(X9, 1),
  350   
  351    [ not(equals(X9, 5)),
  352      dif(X9, 4),
  353      dif(X9, 2),
  354      holds_at(location(g1, x, X9, Equals_Param11), Time10)
  355    ]).
  356axiom(equals(X9, 1),
  357   
  358    [ not(equals(Equals_Param11, 1)),
  359      dif(X9, 4),
  360      dif(X9, 2),
  361      holds_at(location(g1, x, X9, Equals_Param11), Time10)
  362    ]).
  363axiom(equals(X9, 1),
  364   
  365    [ not(equals(Time10, 4)),
  366      dif(X9, 4),
  367      dif(X9, 2),
  368      holds_at(location(g1, x, X9, Equals_Param11), Time10)
  369    ]).
  370axiom(equals(X9, 1),
  371   
  372    [ not(equal(x, y)),
  373      dif(X9, 4),
  374      dif(X9, 2),
  375      holds_at(location(g1, x, X9, Equals_Param11), Time10)
  376    ]).
  377
  378 /*  equals(Equals_Param14, 1) :-
  379       { dif(X12, 4)
  380       },
  381       { dif(X12, 2)
  382       },
  383       holds_at(location(g1, x, X12, Equals_Param14), Time13),
  384       (   not(equals(X12, 5))
  385       ;   not(equals(Equals_Param14, 1))
  386       ;   not(equals(Time13, 4))
  387       ;   not(equal(x, y))
  388       ).
  389 */
  390axiom(equals(Equals_Param14, 1),
  391   
  392    [ not(equals(X12, 5)),
  393      dif(X12, 4),
  394      dif(X12, 2),
  395      holds_at(location(g1, x, X12, Equals_Param14), Time13)
  396    ]).
  397axiom(equals(Equals_Param14, 1),
  398   
  399    [ not(equals(Equals_Param14, 1)),
  400      dif(X12, 4),
  401      dif(X12, 2),
  402      holds_at(location(g1, x, X12, Equals_Param14), Time13)
  403    ]).
  404axiom(equals(Equals_Param14, 1),
  405   
  406    [ not(equals(Time13, 4)),
  407      dif(X12, 4),
  408      dif(X12, 2),
  409      holds_at(location(g1, x, X12, Equals_Param14), Time13)
  410    ]).
  411axiom(equals(Equals_Param14, 1),
  412   
  413    [ not(equal(x, y)),
  414      dif(X12, 4),
  415      dif(X12, 2),
  416      holds_at(location(g1, x, X12, Equals_Param14), Time13)
  417    ]).
  418
  419 /*  equals(Time16, 0) :-
  420       { dif(X15, 4)
  421       },
  422       { dif(X15, 2)
  423       },
  424       holds_at(location(g1, x, X15, Equals_Param17), Time16),
  425       (   not(equals(X15, 5))
  426       ;   not(equals(Equals_Param17, 1))
  427       ;   not(equals(Time16, 4))
  428       ;   not(equal(x, y))
  429       ).
  430 */
  431axiom(equals(Time16, 0),
  432   
  433    [ not(equals(X15, 5)),
  434      dif(X15, 4),
  435      dif(X15, 2),
  436      holds_at(location(g1, x, X15, Equals_Param17), Time16)
  437    ]).
  438axiom(equals(Time16, 0),
  439   
  440    [ not(equals(Equals_Param17, 1)),
  441      dif(X15, 4),
  442      dif(X15, 2),
  443      holds_at(location(g1, x, X15, Equals_Param17), Time16)
  444    ]).
  445axiom(equals(Time16, 0),
  446   
  447    [ not(equals(Time16, 4)),
  448      dif(X15, 4),
  449      dif(X15, 2),
  450      holds_at(location(g1, x, X15, Equals_Param17), Time16)
  451    ]).
  452axiom(equals(Time16, 0),
  453   
  454    [ not(equal(x, y)),
  455      dif(X15, 4),
  456      dif(X15, 2),
  457      holds_at(location(g1, x, X15, Equals_Param17), Time16)
  458    ]).
  459
  460 /*  not(holds_at(location(g1, x, X18, Equals_Param20), Time19)) :-
  461       (   not(equals(X18, 5))
  462       ;   not(equals(Equals_Param20, 1))
  463       ;   not(equals(Time19, 4))
  464       ;   not(equal(x, y))
  465       ),
  466       { dif(X18, 2)
  467       },
  468       { dif(X18, 4)
  469       },
  470       (   not(equals(X18, 1))
  471       ;   not(equals(Equals_Param20, 1))
  472       ;   not(equals(Time19, 0))
  473       ).
  474 */
  475axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  476   
  477    [ not(equals(X18, 1)),
  478      not(equals(X18, 5)),
  479      dif(X18, 2),
  480      dif(X18, 4)
  481    ]).
  482axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  483   
  484    [ not(equals(Equals_Param20, 1)),
  485      not(equals(X18, 5)),
  486      dif(X18, 2),
  487      dif(X18, 4)
  488    ]).
  489axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  490   
  491    [ not(equals(Time19, 0)),
  492      not(equals(X18, 5)),
  493      dif(X18, 2),
  494      dif(X18, 4)
  495    ]).
  496axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  497   
  498    [ not(equals(X18, 1)),
  499      not(equals(Equals_Param20, 1)),
  500      dif(X18, 2),
  501      dif(X18, 4)
  502    ]).
  503axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  504   
  505    [ not(equals(Equals_Param20, 1)),
  506      not(equals(Equals_Param20, 1)),
  507      dif(X18, 2),
  508      dif(X18, 4)
  509    ]).
  510axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  511   
  512    [ not(equals(Time19, 0)),
  513      not(equals(Equals_Param20, 1)),
  514      dif(X18, 2),
  515      dif(X18, 4)
  516    ]).
  517axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  518   
  519    [ not(equals(X18, 1)),
  520      not(equals(Time19, 4)),
  521      dif(X18, 2),
  522      dif(X18, 4)
  523    ]).
  524axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  525   
  526    [ not(equals(Equals_Param20, 1)),
  527      not(equals(Time19, 4)),
  528      dif(X18, 2),
  529      dif(X18, 4)
  530    ]).
  531axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  532   
  533    [ not(equals(Time19, 0)),
  534      not(equals(Time19, 4)),
  535      dif(X18, 2),
  536      dif(X18, 4)
  537    ]).
  538axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  539   
  540    [ not(equals(X18, 1)),
  541      not(equal(x, y)),
  542      dif(X18, 2),
  543      dif(X18, 4)
  544    ]).
  545axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  546   
  547    [ not(equals(Equals_Param20, 1)),
  548      not(equal(x, y)),
  549      dif(X18, 2),
  550      dif(X18, 4)
  551    ]).
  552axiom(not(holds_at(location(g1, x, X18, Equals_Param20), Time19)),
  553   
  554    [ not(equals(Time19, 0)),
  555      not(equal(x, y)),
  556      dif(X18, 2),
  557      dif(X18, 4)
  558    ]).
  559
  560 /*  equals(X21, 5) :-
  561       holds_at(location(g1, x, X21, Equals_Param23), Time22),
  562       { dif(X21, 2)
  563       },
  564       { dif(X21, 4)
  565       },
  566       (   not(equals(X21, 1))
  567       ;   not(equals(Equals_Param23, 1))
  568       ;   not(equals(Time22, 0))
  569       ).
  570 */
  571axiom(equals(X21, 5),
  572   
  573    [ not(equals(X21, 1)),
  574      holds_at(location(g1, x, X21, Equals_Param23), Time22),
  575      dif(X21, 2),
  576      dif(X21, 4)
  577    ]).
  578axiom(equals(X21, 5),
  579   
  580    [ not(equals(Equals_Param23, 1)),
  581      holds_at(location(g1, x, X21, Equals_Param23), Time22),
  582      dif(X21, 2),
  583      dif(X21, 4)
  584    ]).
  585axiom(equals(X21, 5),
  586   
  587    [ not(equals(Time22, 0)),
  588      holds_at(location(g1, x, X21, Equals_Param23), Time22),
  589      dif(X21, 2),
  590      dif(X21, 4)
  591    ]).
  592
  593 /*  equals(Equals_Param26, 1) :-
  594       holds_at(location(g1, x, X24, Equals_Param26), Time25),
  595       { dif(X24, 2)
  596       },
  597       { dif(X24, 4)
  598       },
  599       (   not(equals(X24, 1))
  600       ;   not(equals(Equals_Param26, 1))
  601       ;   not(equals(Time25, 0))
  602       ).
  603 */
  604axiom(equals(Equals_Param26, 1),
  605   
  606    [ not(equals(X24, 1)),
  607      holds_at(location(g1, x, X24, Equals_Param26), Time25),
  608      dif(X24, 2),
  609      dif(X24, 4)
  610    ]).
  611axiom(equals(Equals_Param26, 1),
  612   
  613    [ not(equals(Equals_Param26, 1)),
  614      holds_at(location(g1, x, X24, Equals_Param26), Time25),
  615      dif(X24, 2),
  616      dif(X24, 4)
  617    ]).
  618axiom(equals(Equals_Param26, 1),
  619   
  620    [ not(equals(Time25, 0)),
  621      holds_at(location(g1, x, X24, Equals_Param26), Time25),
  622      dif(X24, 2),
  623      dif(X24, 4)
  624    ]).
  625
  626 /*  equals(Time28, 4) :-
  627       holds_at(location(g1, x, X27, Equals_Param29), Time28),
  628       { dif(X27, 2)
  629       },
  630       { dif(X27, 4)
  631       },
  632       (   not(equals(X27, 1))
  633       ;   not(equals(Equals_Param29, 1))
  634       ;   not(equals(Time28, 0))
  635       ).
  636 */
  637axiom(equals(Time28, 4),
  638   
  639    [ not(equals(X27, 1)),
  640      holds_at(location(g1, x, X27, Equals_Param29), Time28),
  641      dif(X27, 2),
  642      dif(X27, 4)
  643    ]).
  644axiom(equals(Time28, 4),
  645   
  646    [ not(equals(Equals_Param29, 1)),
  647      holds_at(location(g1, x, X27, Equals_Param29), Time28),
  648      dif(X27, 2),
  649      dif(X27, 4)
  650    ]).
  651axiom(equals(Time28, 4),
  652   
  653    [ not(equals(Time28, 0)),
  654      holds_at(location(g1, x, X27, Equals_Param29), Time28),
  655      dif(X27, 2),
  656      dif(X27, 4)
  657    ]).
  658
  659 /*  equal(x, y) :-
  660       holds_at(location(g1, x, X30, Equals_Param32), Time31),
  661       { dif(X30, 2)
  662       },
  663       { dif(X30, 4)
  664       },
  665       (   not(equals(X30, 1))
  666       ;   not(equals(Equals_Param32, 1))
  667       ;   not(equals(Time31, 0))
  668       ).
  669 */
  670axiom(equal(x, y),
  671   
  672    [ not(equals(X30, 1)),
  673      holds_at(location(g1, x, X30, Equals_Param32), Time31),
  674      dif(X30, 2),
  675      dif(X30, 4)
  676    ]).
  677axiom(equal(x, y),
  678   
  679    [ not(equals(Equals_Param32, 1)),
  680      holds_at(location(g1, x, X30, Equals_Param32), Time31),
  681      dif(X30, 2),
  682      dif(X30, 4)
  683    ]).
  684axiom(equal(x, y),
  685   
  686    [ not(equals(Time31, 0)),
  687      holds_at(location(g1, x, X30, Equals_Param32), Time31),
  688      dif(X30, 2),
  689      dif(X30, 4)
  690    ]).
  691
  692
  693% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:45
  694% [xcoord,ycoord,time]
  695% xcoord!=% 2 & xcoord!=4 & !(xcoord=5 & ycoord=1 & time=4) ->
  696% !HoldsAt(Location(G1,Y,xcoord,ycoord),time) |
  697% xcoord=1 & ycoord=1 & time=0 & Equal(X,Y).
  698
  699 /*   if(({dif(Xcoord, 2)}, {dif(Xcoord, 4)}, (not(equals(Xcoord, 5));not(equals(Ycoord, 1));not(equals(Time, 4)))),
  700          (not(holds_at(location(g1, y, Xcoord, Ycoord), Time));Xcoord=1, Ycoord=1, Time=0, equal(x, y))).
  701 */
  702
  703 /*  not({dif(Y, 2)}) :-
  704       ( { dif(Y, 4)
  705         },
  706         (   not(equals(Y, 5))
  707         ;   not(equals(Equals_Param, 1))
  708         ;   not(equals(Time4, 4))
  709         )
  710       ),
  711       holds_at(location(g1, y, Y, Equals_Param), Time4),
  712       (   not(equals(Y, 1))
  713       ;   not(equals(Equals_Param, 1))
  714       ;   not(equals(Time4, 0))
  715       ;   not(equal(x, y))
  716       ).
  717 */
  718% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:48
  719axiom(not({dif(Y, 2)}),
  720   
  721    [ not(equals(Y, 1)),
  722      not(equals(Y, 5)),
  723      { dif(Y, 4)
  724      },
  725      holds_at(location(g1, y, Y, Equals_Param), Time4)
  726    ]).
  727axiom(not({dif(Y, 2)}),
  728   
  729    [ not(equals(Equals_Param, 1)),
  730      not(equals(Y, 5)),
  731      { dif(Y, 4)
  732      },
  733      holds_at(location(g1, y, Y, Equals_Param), Time4)
  734    ]).
  735axiom(not({dif(Y, 2)}),
  736   
  737    [ not(equals(Time4, 0)),
  738      not(equals(Y, 5)),
  739      { dif(Y, 4)
  740      },
  741      holds_at(location(g1, y, Y, Equals_Param), Time4)
  742    ]).
  743axiom(not({dif(Y, 2)}),
  744   
  745    [ not(equal(x, y)),
  746      not(equals(Y, 5)),
  747      { dif(Y, 4)
  748      },
  749      holds_at(location(g1, y, Y, Equals_Param), Time4)
  750    ]).
  751axiom(not({dif(Y, 2)}),
  752   
  753    [ not(equals(Y, 1)),
  754      not(equals(Equals_Param, 1)),
  755      { dif(Y, 4)
  756      },
  757      holds_at(location(g1, y, Y, Equals_Param), Time4)
  758    ]).
  759axiom(not({dif(Y, 2)}),
  760   
  761    [ not(equals(Equals_Param, 1)),
  762      not(equals(Equals_Param, 1)),
  763      { dif(Y, 4)
  764      },
  765      holds_at(location(g1, y, Y, Equals_Param), Time4)
  766    ]).
  767axiom(not({dif(Y, 2)}),
  768   
  769    [ not(equals(Time4, 0)),
  770      not(equals(Equals_Param, 1)),
  771      { dif(Y, 4)
  772      },
  773      holds_at(location(g1, y, Y, Equals_Param), Time4)
  774    ]).
  775axiom(not({dif(Y, 2)}),
  776   
  777    [ not(equal(x, y)),
  778      not(equals(Equals_Param, 1)),
  779      { dif(Y, 4)
  780      },
  781      holds_at(location(g1, y, Y, Equals_Param), Time4)
  782    ]).
  783axiom(not({dif(Y, 2)}),
  784   
  785    [ not(equals(Y, 1)),
  786      not(equals(Time4, 4)),
  787      { dif(Y, 4)
  788      },
  789      holds_at(location(g1, y, Y, Equals_Param), Time4)
  790    ]).
  791axiom(not({dif(Y, 2)}),
  792   
  793    [ not(equals(Equals_Param, 1)),
  794      not(equals(Time4, 4)),
  795      { dif(Y, 4)
  796      },
  797      holds_at(location(g1, y, Y, Equals_Param), Time4)
  798    ]).
  799axiom(not({dif(Y, 2)}),
  800   
  801    [ not(equals(Time4, 0)),
  802      not(equals(Time4, 4)),
  803      { dif(Y, 4)
  804      },
  805      holds_at(location(g1, y, Y, Equals_Param), Time4)
  806    ]).
  807axiom(not({dif(Y, 2)}),
  808   
  809    [ not(equal(x, y)),
  810      not(equals(Time4, 4)),
  811      { dif(Y, 4)
  812      },
  813      holds_at(location(g1, y, Y, Equals_Param), Time4)
  814    ]).
  815
  816 /*  not({dif(Y6, 4)}) :-
  817       (   not(equals(Y6, 5))
  818       ;   not(equals(Equals_Param8, 1))
  819       ;   not(equals(Time7, 4))
  820       ),
  821       { dif(Y6, 2)
  822       },
  823       holds_at(location(g1, y, Y6, Equals_Param8), Time7),
  824       (   not(equals(Y6, 1))
  825       ;   not(equals(Equals_Param8, 1))
  826       ;   not(equals(Time7, 0))
  827       ;   not(equal(x, y))
  828       ).
  829 */
  830axiom(not({dif(Y6, 4)}),
  831   
  832    [ not(equals(Y6, 1)),
  833      not(equals(Y6, 5)),
  834      { dif(Y6, 2)
  835      },
  836      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  837    ]).
  838axiom(not({dif(Y6, 4)}),
  839   
  840    [ not(equals(Equals_Param8, 1)),
  841      not(equals(Y6, 5)),
  842      { dif(Y6, 2)
  843      },
  844      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  845    ]).
  846axiom(not({dif(Y6, 4)}),
  847   
  848    [ not(equals(Time7, 0)),
  849      not(equals(Y6, 5)),
  850      { dif(Y6, 2)
  851      },
  852      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  853    ]).
  854axiom(not({dif(Y6, 4)}),
  855   
  856    [ not(equal(x, y)),
  857      not(equals(Y6, 5)),
  858      { dif(Y6, 2)
  859      },
  860      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  861    ]).
  862axiom(not({dif(Y6, 4)}),
  863   
  864    [ not(equals(Y6, 1)),
  865      not(equals(Equals_Param8, 1)),
  866      { dif(Y6, 2)
  867      },
  868      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  869    ]).
  870axiom(not({dif(Y6, 4)}),
  871   
  872    [ not(equals(Equals_Param8, 1)),
  873      not(equals(Equals_Param8, 1)),
  874      { dif(Y6, 2)
  875      },
  876      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  877    ]).
  878axiom(not({dif(Y6, 4)}),
  879   
  880    [ not(equals(Time7, 0)),
  881      not(equals(Equals_Param8, 1)),
  882      { dif(Y6, 2)
  883      },
  884      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  885    ]).
  886axiom(not({dif(Y6, 4)}),
  887   
  888    [ not(equal(x, y)),
  889      not(equals(Equals_Param8, 1)),
  890      { dif(Y6, 2)
  891      },
  892      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  893    ]).
  894axiom(not({dif(Y6, 4)}),
  895   
  896    [ not(equals(Y6, 1)),
  897      not(equals(Time7, 4)),
  898      { dif(Y6, 2)
  899      },
  900      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  901    ]).
  902axiom(not({dif(Y6, 4)}),
  903   
  904    [ not(equals(Equals_Param8, 1)),
  905      not(equals(Time7, 4)),
  906      { dif(Y6, 2)
  907      },
  908      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  909    ]).
  910axiom(not({dif(Y6, 4)}),
  911   
  912    [ not(equals(Time7, 0)),
  913      not(equals(Time7, 4)),
  914      { dif(Y6, 2)
  915      },
  916      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  917    ]).
  918axiom(not({dif(Y6, 4)}),
  919   
  920    [ not(equal(x, y)),
  921      not(equals(Time7, 4)),
  922      { dif(Y6, 2)
  923      },
  924      holds_at(location(g1, y, Y6, Equals_Param8), Time7)
  925    ]).
  926
  927 /*  equals(Y9, 5) :-
  928       { dif(Y9, 4)
  929       },
  930       { dif(Y9, 2)
  931       },
  932       holds_at(location(g1, y, Y9, Equals_Param11), Time10),
  933       (   not(equals(Y9, 1))
  934       ;   not(equals(Equals_Param11, 1))
  935       ;   not(equals(Time10, 0))
  936       ;   not(equal(x, y))
  937       ).
  938 */
  939axiom(equals(Y9, 5),
  940   
  941    [ not(equals(Y9, 1)),
  942      dif(Y9, 4),
  943      dif(Y9, 2),
  944      holds_at(location(g1, y, Y9, Equals_Param11), Time10)
  945    ]).
  946axiom(equals(Y9, 5),
  947   
  948    [ not(equals(Equals_Param11, 1)),
  949      dif(Y9, 4),
  950      dif(Y9, 2),
  951      holds_at(location(g1, y, Y9, Equals_Param11), Time10)
  952    ]).
  953axiom(equals(Y9, 5),
  954   
  955    [ not(equals(Time10, 0)),
  956      dif(Y9, 4),
  957      dif(Y9, 2),
  958      holds_at(location(g1, y, Y9, Equals_Param11), Time10)
  959    ]).
  960axiom(equals(Y9, 5),
  961   
  962    [ not(equal(x, y)),
  963      dif(Y9, 4),
  964      dif(Y9, 2),
  965      holds_at(location(g1, y, Y9, Equals_Param11), Time10)
  966    ]).
  967
  968 /*  equals(Equals_Param14, 1) :-
  969       { dif(Y12, 4)
  970       },
  971       { dif(Y12, 2)
  972       },
  973       holds_at(location(g1, y, Y12, Equals_Param14), Time13),
  974       (   not(equals(Y12, 1))
  975       ;   not(equals(Equals_Param14, 1))
  976       ;   not(equals(Time13, 0))
  977       ;   not(equal(x, y))
  978       ).
  979 */
  980axiom(equals(Equals_Param14, 1),
  981   
  982    [ not(equals(Y12, 1)),
  983      dif(Y12, 4),
  984      dif(Y12, 2),
  985      holds_at(location(g1, y, Y12, Equals_Param14), Time13)
  986    ]).
  987axiom(equals(Equals_Param14, 1),
  988   
  989    [ not(equals(Equals_Param14, 1)),
  990      dif(Y12, 4),
  991      dif(Y12, 2),
  992      holds_at(location(g1, y, Y12, Equals_Param14), Time13)
  993    ]).
  994axiom(equals(Equals_Param14, 1),
  995   
  996    [ not(equals(Time13, 0)),
  997      dif(Y12, 4),
  998      dif(Y12, 2),
  999      holds_at(location(g1, y, Y12, Equals_Param14), Time13)
 1000    ]).
 1001axiom(equals(Equals_Param14, 1),
 1002   
 1003    [ not(equal(x, y)),
 1004      dif(Y12, 4),
 1005      dif(Y12, 2),
 1006      holds_at(location(g1, y, Y12, Equals_Param14), Time13)
 1007    ]).
 1008
 1009 /*  equals(Time16, 4) :-
 1010       { dif(Y15, 4)
 1011       },
 1012       { dif(Y15, 2)
 1013       },
 1014       holds_at(location(g1, y, Y15, Equals_Param17), Time16),
 1015       (   not(equals(Y15, 1))
 1016       ;   not(equals(Equals_Param17, 1))
 1017       ;   not(equals(Time16, 0))
 1018       ;   not(equal(x, y))
 1019       ).
 1020 */
 1021axiom(equals(Time16, 4),
 1022   
 1023    [ not(equals(Y15, 1)),
 1024      dif(Y15, 4),
 1025      dif(Y15, 2),
 1026      holds_at(location(g1, y, Y15, Equals_Param17), Time16)
 1027    ]).
 1028axiom(equals(Time16, 4),
 1029   
 1030    [ not(equals(Equals_Param17, 1)),
 1031      dif(Y15, 4),
 1032      dif(Y15, 2),
 1033      holds_at(location(g1, y, Y15, Equals_Param17), Time16)
 1034    ]).
 1035axiom(equals(Time16, 4),
 1036   
 1037    [ not(equals(Time16, 0)),
 1038      dif(Y15, 4),
 1039      dif(Y15, 2),
 1040      holds_at(location(g1, y, Y15, Equals_Param17), Time16)
 1041    ]).
 1042axiom(equals(Time16, 4),
 1043   
 1044    [ not(equal(x, y)),
 1045      dif(Y15, 4),
 1046      dif(Y15, 2),
 1047      holds_at(location(g1, y, Y15, Equals_Param17), Time16)
 1048    ]).
 1049
 1050 /*  not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)) :-
 1051       (   not(equals(Y18, 1))
 1052       ;   not(equals(Equals_Param20, 1))
 1053       ;   not(equals(Time19, 0))
 1054       ;   not(equal(x, y))
 1055       ),
 1056       { dif(Y18, 2)
 1057       },
 1058       { dif(Y18, 4)
 1059       },
 1060       (   not(equals(Y18, 5))
 1061       ;   not(equals(Equals_Param20, 1))
 1062       ;   not(equals(Time19, 4))
 1063       ).
 1064 */
 1065axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1066   
 1067    [ not(equals(Y18, 5)),
 1068      not(equals(Y18, 1)),
 1069      dif(Y18, 2),
 1070      dif(Y18, 4)
 1071    ]).
 1072axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1073   
 1074    [ not(equals(Equals_Param20, 1)),
 1075      not(equals(Y18, 1)),
 1076      dif(Y18, 2),
 1077      dif(Y18, 4)
 1078    ]).
 1079axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1080   
 1081    [ not(equals(Time19, 4)),
 1082      not(equals(Y18, 1)),
 1083      dif(Y18, 2),
 1084      dif(Y18, 4)
 1085    ]).
 1086axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1087   
 1088    [ not(equals(Y18, 5)),
 1089      not(equals(Equals_Param20, 1)),
 1090      dif(Y18, 2),
 1091      dif(Y18, 4)
 1092    ]).
 1093axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1094   
 1095    [ not(equals(Equals_Param20, 1)),
 1096      not(equals(Equals_Param20, 1)),
 1097      dif(Y18, 2),
 1098      dif(Y18, 4)
 1099    ]).
 1100axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1101   
 1102    [ not(equals(Time19, 4)),
 1103      not(equals(Equals_Param20, 1)),
 1104      dif(Y18, 2),
 1105      dif(Y18, 4)
 1106    ]).
 1107axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1108   
 1109    [ not(equals(Y18, 5)),
 1110      not(equals(Time19, 0)),
 1111      dif(Y18, 2),
 1112      dif(Y18, 4)
 1113    ]).
 1114axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1115   
 1116    [ not(equals(Equals_Param20, 1)),
 1117      not(equals(Time19, 0)),
 1118      dif(Y18, 2),
 1119      dif(Y18, 4)
 1120    ]).
 1121axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1122   
 1123    [ not(equals(Time19, 4)),
 1124      not(equals(Time19, 0)),
 1125      dif(Y18, 2),
 1126      dif(Y18, 4)
 1127    ]).
 1128axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1129   
 1130    [ not(equals(Y18, 5)),
 1131      not(equal(x, y)),
 1132      dif(Y18, 2),
 1133      dif(Y18, 4)
 1134    ]).
 1135axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1136   
 1137    [ not(equals(Equals_Param20, 1)),
 1138      not(equal(x, y)),
 1139      dif(Y18, 2),
 1140      dif(Y18, 4)
 1141    ]).
 1142axiom(not(holds_at(location(g1, y, Y18, Equals_Param20), Time19)),
 1143   
 1144    [ not(equals(Time19, 4)),
 1145      not(equal(x, y)),
 1146      dif(Y18, 2),
 1147      dif(Y18, 4)
 1148    ]).
 1149
 1150 /*  equals(Y21, 1) :-
 1151       holds_at(location(g1, y, Y21, Equals_Param23), Time22),
 1152       { dif(Y21, 2)
 1153       },
 1154       { dif(Y21, 4)
 1155       },
 1156       (   not(equals(Y21, 5))
 1157       ;   not(equals(Equals_Param23, 1))
 1158       ;   not(equals(Time22, 4))
 1159       ).
 1160 */
 1161axiom(equals(Y21, 1),
 1162   
 1163    [ not(equals(Y21, 5)),
 1164      holds_at(location(g1, y, Y21, Equals_Param23), Time22),
 1165      dif(Y21, 2),
 1166      dif(Y21, 4)
 1167    ]).
 1168axiom(equals(Y21, 1),
 1169   
 1170    [ not(equals(Equals_Param23, 1)),
 1171      holds_at(location(g1, y, Y21, Equals_Param23), Time22),
 1172      dif(Y21, 2),
 1173      dif(Y21, 4)
 1174    ]).
 1175axiom(equals(Y21, 1),
 1176   
 1177    [ not(equals(Time22, 4)),
 1178      holds_at(location(g1, y, Y21, Equals_Param23), Time22),
 1179      dif(Y21, 2),
 1180      dif(Y21, 4)
 1181    ]).
 1182
 1183 /*  equals(Equals_Param26, 1) :-
 1184       holds_at(location(g1, y, Y24, Equals_Param26), Time25),
 1185       { dif(Y24, 2)
 1186       },
 1187       { dif(Y24, 4)
 1188       },
 1189       (   not(equals(Y24, 5))
 1190       ;   not(equals(Equals_Param26, 1))
 1191       ;   not(equals(Time25, 4))
 1192       ).
 1193 */
 1194axiom(equals(Equals_Param26, 1),
 1195   
 1196    [ not(equals(Y24, 5)),
 1197      holds_at(location(g1, y, Y24, Equals_Param26), Time25),
 1198      dif(Y24, 2),
 1199      dif(Y24, 4)
 1200    ]).
 1201axiom(equals(Equals_Param26, 1),
 1202   
 1203    [ not(equals(Equals_Param26, 1)),
 1204      holds_at(location(g1, y, Y24, Equals_Param26), Time25),
 1205      dif(Y24, 2),
 1206      dif(Y24, 4)
 1207    ]).
 1208axiom(equals(Equals_Param26, 1),
 1209   
 1210    [ not(equals(Time25, 4)),
 1211      holds_at(location(g1, y, Y24, Equals_Param26), Time25),
 1212      dif(Y24, 2),
 1213      dif(Y24, 4)
 1214    ]).
 1215
 1216 /*  equals(Time28, 0) :-
 1217       holds_at(location(g1, y, Y27, Equals_Param29), Time28),
 1218       { dif(Y27, 2)
 1219       },
 1220       { dif(Y27, 4)
 1221       },
 1222       (   not(equals(Y27, 5))
 1223       ;   not(equals(Equals_Param29, 1))
 1224       ;   not(equals(Time28, 4))
 1225       ).
 1226 */
 1227axiom(equals(Time28, 0),
 1228   
 1229    [ not(equals(Y27, 5)),
 1230      holds_at(location(g1, y, Y27, Equals_Param29), Time28),
 1231      dif(Y27, 2),
 1232      dif(Y27, 4)
 1233    ]).
 1234axiom(equals(Time28, 0),
 1235   
 1236    [ not(equals(Equals_Param29, 1)),
 1237      holds_at(location(g1, y, Y27, Equals_Param29), Time28),
 1238      dif(Y27, 2),
 1239      dif(Y27, 4)
 1240    ]).
 1241axiom(equals(Time28, 0),
 1242   
 1243    [ not(equals(Time28, 4)),
 1244      holds_at(location(g1, y, Y27, Equals_Param29), Time28),
 1245      dif(Y27, 2),
 1246      dif(Y27, 4)
 1247    ]).
 1248
 1249 /*  equal(x, y) :-
 1250       holds_at(location(g1, y, Y30, Equals_Param32), Time31),
 1251       { dif(Y30, 2)
 1252       },
 1253       { dif(Y30, 4)
 1254       },
 1255       (   not(equals(Y30, 5))
 1256       ;   not(equals(Equals_Param32, 1))
 1257       ;   not(equals(Time31, 4))
 1258       ).
 1259 */
 1260axiom(equal(x, y),
 1261   
 1262    [ not(equals(Y30, 5)),
 1263      holds_at(location(g1, y, Y30, Equals_Param32), Time31),
 1264      dif(Y30, 2),
 1265      dif(Y30, 4)
 1266    ]).
 1267axiom(equal(x, y),
 1268   
 1269    [ not(equals(Equals_Param32, 1)),
 1270      holds_at(location(g1, y, Y30, Equals_Param32), Time31),
 1271      dif(Y30, 2),
 1272      dif(Y30, 4)
 1273    ]).
 1274axiom(equal(x, y),
 1275   
 1276    [ not(equals(Time31, 4)),
 1277      holds_at(location(g1, y, Y30, Equals_Param32), Time31),
 1278      dif(Y30, 2),
 1279      dif(Y30, 4)
 1280    ]).
 1281
 1282% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:50
 1283% range time 0 4
 1284% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:51
 1285==> range(time,0,4).
 1286
 1287% range xcoord 0 5
 1288% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:52
 1289==> range(xcoord,0,5).
 1290
 1291% range ycoord 0 1
 1292% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:53
 1293==> range(ycoord,0,1).
 1294
 1295% range offset 0 0
 1296% From /opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/ec_planner/examples/Cassimatis2002/TwoScreens.e:54
 1297==> range(offset,0,0).
 1298%; End of file.