1/*
    2% NomicMUD: A MUD server written in Prolog
    3%
    4% Some parts used Inform7, Guncho, PrologMUD and Marty's Prolog Adventure Prototype
    5% 
    6% July 10,1996 - John Eikenberry 
    7% Copyright (C) 2004 Marty White under the GNU GPL
    8% 
    9% Dec 13, 2035 - Douglas Miles
   10%
   11%
   12% Logicmoo Project changes:
   13%
   14% Main file.
   15%
   16*/
   17
   18:- module(ec,[abdemo_special/3]).   19
   20testing_msg(X):- wdmsg(X).
   21
   22:- use_module(library((pfc_lib))).   23
   24%%executable(P):- mpred_props(
   25% :- use_module(ec_loader).
   26:- use_module(ec_common).   27
   28first_d(0).
   29/*
   30%next_d(0). next_d(2).
   31%next_d(2). next_d(4).
   32next_d(32).  next_d(64). next_d(98).
   33next_d(D1, D2):- D1<5,!,D2 is D1+1.
   34next_d(D1, D2):- next_d(D2),D2>D1,!.
   35
   36*/
   37last_d(D):- notrace(((nb_current(last_d,D),number(D))->true; D = 3000)).
   38
   39next_d(D1, _):- last_d(D), D1>D, !, fail.
   40next_d(D1, D2):- D1<9,!,D2 is D1+3.
   41next_d(D1, D2):- D1<90,!,D2 is D1+60.
   42next_d(D1, D2):- D2 is D1+300.
   43
   44:- style_check(-singleton).   45
   46% abdemo_special(long,Gs,R):-abdemo_timed(Gs,R).
   47abdemo_special(W,Gs,R):- \+ is_list(Gs),!, functor(Gs,F,_),!, 
   48  abdemo_special(W+F,[Gs],R).
   49abdemo_special(loops,Gs,R):- write(cant_abdemo(loops,Gs,R)),!,nl.
   50abdemo_special(_,Gs,R):- abdemo_timed(Gs,[R,N]), write_plan_len(R,N), nl, write_plan(R,[]).
   51
   52abdemo_special(depth(Low,High),Gs,R):- 
   53   b_setval(last_d,High),!,
   54   abdemo_top(Gs,[[[],[]],[[],[]]],[[HA,HC],[BA,BC]],[],N,Low),
   55   R = [[HA,BA],[HC,-]].
   56
   57abdemo_special(_,Gs,R):- 
   58 init_gensym(t), first_d(D), !,
   59     abdemo_top(Gs,[[[],[]],[[],[]]],[[HA,HC],[BA,BC]],[],N,D),
   60     write_plan_len(HA,BA),
   61   R = [[HA,BA],[HC,-]].
   62
   63
   64abdemo_top_xfrm(Gs,Gss):- 
   65  When = t,
   66  must(fix_goal(When,Gs,Gs0)), !,
   67  must(fix_time_args(When,Gs0,Gss)),!.
   68
   69abdemo_top(Gs,R1,R3,N1,N3,D) :-
   70  must(nonvar(Gs)),
   71  notrace((abdemo_top_xfrm(Gs,Gss))), Gs\=@=Gss,!,
   72  abdemo_top(Gss,R1,R3,N1,N3,D).
   73
   74abdemo_top(Gss,R1,R3,N1,N3,D):- 
   75  MaxDepth = 10,
   76  HighLevel = 0,
   77  must(nonvar(Gss)),
   78  dbginfo(all, [nl,realGoal=Gss,nl]),
   79  setup_call_cleanup(
   80     nb_setval(last_call_abdemo,[]),
   81     abdemo_top(Gss,R1,R3,N1,N3,D, MaxDepth, HighLevel),
   82     nb_setval(last_call_abdemo,[])).
   83
   84iv_list_to_set(List,Set):-
   85    lists:number_list(List, 1, Numbered),
   86    sort(1, @=<, Numbered, ONum),
   87    iv_remove_dup_keys(ONum, NumSet),
   88    sort(2, @=<, NumSet, ONumSet),
   89    pairs_keys(ONumSet, Set).
   90iv_remove_dup_keys([], []).
   91iv_remove_dup_keys([H|T0], [H|T]) :-
   92    H=V-_,
   93    iv_remove_same_key(T0, V, T1),
   94    iv_remove_dup_keys(T1, T).
   95iv_remove_same_key([V1-_|T0], V, T) :-
   96    V1=@=V,
   97    %must(V\==b(start,start)),
   98    !,
   99    iv_remove_same_key(T0, V, T).
  100iv_remove_same_key(L, _, L).
  101
  102ec_trace(O,0):- O=on.
  103ec_trace(O,1):- O=on.
  104
  105%borked %:- include('eventCalculusPlannerDMiles_OLD.pl').        
  106
  107% :- include('eventCalculusPlannerDMiles.pl').        
  108
  109/*
  110:- include('planner115.pl').        
  111abdemo_top(Gs,R1,R3,N1,N3,D, _MaxDepth, _HighLevel) :-
  112  must(nonvar(Gs)),
  113  abdemo_id(Gs,R1,R2,N1,N2,D), !, 
  114  abdemo_cont(R2,R3,N2,N3).
  115*/
  116/*
  117:- include('planner42.pl').        
  118abdemo_top(Gs,R1,R3,N1,N3,D, _MaxDepth, _HighLevel) :-
  119  must(nonvar(Gs)),
  120  abdemo(Gs,R1,R2,N1,N2), !, 
  121  abdemo_cont(R2,R3,N2,N3).
  122*/
  123:- include('planner19a.pl').        
  124abdemo_top(Gs,R1,R3,N1,N3,D, _MaxDepth, _HighLevel) :-
  125  must(nonvar(Gs)),
  126  abdemo(Gs,R1,R2,N1,N2), !, 
  127  abdemo_cont(R2,R3,N2,N3).
  128
  129:- fixup_exports.