1% move.pl
    2% May 18, 1996
    3% John Eikenberry
    4%
    5% Dec 13, 2035
    6% Douglas Miles
    7%
    8/* * module * 
    9% This file defines the predicates for the agent to move
   10%
   11*/
   12
   13% :-swi_module(user). 
   14:-swi_module(modMove, []).   15
   16:- include(prologmud(mud_header)).   17
   18% :- register_module_type (mtCommand).
   19
   20% :- expects_dialect(mudcode).
   21
   22
   23baseKB:agent_text_command(Agent,[DirSS],Agent,OUT):-nonvar(DirSS), to_case_breaks(DirSS,[xti(DirS,_),
   24   xti(Dist,digit)]),show_call(coerce(DirS,vtDirection,Dir)),OUT=actMove(Dist,Dir).
   25baseKB:agent_text_command(Agent,[DirSS],Agent,OUT):-nonvar(DirSS), show_call(coerce(DirSS,vtDirection,Dir)),OUT=actMove(Dir).
   26
   27baseKB:agent_call_command(Agnt,Cmd):- compound(Cmd),functor(Cmd,actMove,_),!,must(move_command(Agnt,Cmd)).
   28
   29baseKB:action_info(actMove(isOptional(ftNumber,1),vtDirection),"Move [1] south % distance in direction").
   30
   31baseKB:text_actverb("go",actMove).
   32
   33/*
   34% dir###
   35move_command(Agent,actMove(DirSS)) :- catch((string_to_atom(DirSS,DirS),
   36	    atom_concat(Dir,N,DirS),atom_number(N,Dist)),_,fail),!,
   37            move_command(Agent,Dir,Dist).
   38% dir
   39move_command(Agent,actMove(Dir)) :-
   40	    get_move_dist(Agent,Dist),
   41            move_command(Agent,Dir,Dist).
   42*/
   43move_command(Agent,actMove(Dir)):-!,move_command(Agent,actMove(1,Dir)).
   44% dir
   45move_command(Agent,actMove(Dist,Dir)) :-
   46            move_command(Agent,Dir,Dist).
   47
   48get_move_dist(Agent,Dist):-req1(mudMoveDist(Agent,Dist)),!.
   49get_move_dist(_Gent,1).
   50
   51% Move thy agent
   52move_command(Agent,DirS,DistS) :- 
   53   string_to_atom(DirS,Dir),
   54   any_to_number(DistS,Dist),
   55   catch(doall((between(1,Dist,_),move_command_1(Agent,Dir))),giveup(_),true).
   56
   57
   58
   59% cant get anywhere since the map fails it
   60move_command_1(Agent,Dir) :-
   61	mudAtLoc(Agent,LOC),
   62         \+ (from_dir_target(LOC,Dir,_)),!,
   63		(add_cmdfailure(Agent,actMove)),
   64      throw(giveup(nopath(Agent,actMove))).
   65
   66% Run into something big, Ouch...
   67% damage and charge... plus it doesn't get anywhere
   68move_command_1(Agent,Dir) :-
   69	mudAtLoc(Agent,LOC),
   70        from_dir_target(LOC,Dir,XXYY),
   71        % trace,
   72        is_3d(XXYY),
   73         mudAtLoc(Obj,LOC),        
   74         prop_or(Obj,mudHeight,ObjHt,1),
   75         mudAtLoc(Obj2,XXYY),
   76         prop_or(Obj2,mudHeight,ObjHt2,1),
   77         ObjHt2 > ObjHt,
   78         ObjHt2 > 1,
   79	!,
   80	call_update_stats(Agent,collide),
   81	call_update_charge(Agent,actMove),
   82        raise_location_event(XXYY,collide(Agent,Obj2)),
   83   throw(giveup(collide(Agent,Obj2))).
   84
   85
   86% Another Agent is in the way
   87move_command_1(Agent,Dir):- 
   88	mudAtLoc(Agent,LOC),
   89	from_dir_target(LOC,Dir,XXYY),       
   90	is_3d(XXYY),
   91        mudAtLoc(Agent2,XXYY),
   92	isa(Agent2,tAgent),!,
   93	call_update_stats(Agent,collide),
   94	call_update_charge(Agent,actMove),
   95        raise_location_event(XXYY,collide(Agent,Agent2)),
   96   throw(giveup(collide(Agent,Agent2))).
   97
   98
   99%Move successfully
  100move_command_1(Agent,Dir) :-
  101	in_world_move(_,Agent,Dir),
  102	call_update_charge(Agent,actMove).
  103
  104%Record keeping
  105
  106update_charge(Agent,actMove) :- padd(Agent,mudEnergy,+ -4).
  107
  108update_stats(Agent,collide) :- padd(Agent,mudHealth,+ -5),(add_cmdfailure(Agent,collide)).
  109
  110update_stats(Agent,fall) :- padd(Agent,mudHealth,+ -10).
  111
  112% cheating but to test
  113
  114vtActionTemplate(actGo(vtDirection)).
  115baseKB:agent_call_command(Agent,actGo(Dir)) :-
  116	mudAtLoc(Agent,LOC),
  117        in_world_move(LOC,Agent,Dir),
  118	call_update_charge(Agent,actMove).
  119
  120
  121:- include(prologmud(mud_footer)).