// $Id: progs.pas,v 1.7 2001/04/16 17:32:41 xenon Exp $

unit progs;

interface

uses
    chars,
    fsys,
    dtypes,
    area;

const MAX_IFCHECKS=20;
      IN_IF=0;
      IN_ELSE=1;
      DO_IF=2;
      DO_ELSE=3;

const COMMANDOK=0;
      IFTRUE=1;
      IFFALSE=2;
      ORTRUE=3;
      ORFALSE=4;
      FOUNDELSE=5;
      FOUNDENDIF=6;
      IFIGNORED=7;
      ORIGNORED=8;
      BERR=9;

type
    GProgram = class
      prog_type, perc : integer;
      code : string;
      args : string;
      return : boolean;

      procedure load(var fp : GFileReader; trigger : string; npc : GNPCIndex);
      function seval(lhs, opr, rhs : string; npc : GCharacter) : boolean;
      function veval(lhs : integer; opr : string; rhs : integer; npc : GCharacter) : boolean;
      function ifcheck(ifcheck : string; npc, actor : GCharacter; obj : GObject; vo : pointer; rand : GCharacter) : integer;
      function command(cmd : string; npc,actor : GCharacter; obj : GObject; ignore, ignore_ors : boolean) : integer;
      procedure driver(npc, actor : GCharacter; obj : GObject);
    end;

procedure percentCheck(npc, actor : GCharacter; obj : GObject; prog_type : integer);
procedure greetTrigger(ch : GCharacter);
procedure fightTrigger(ch, victim : GCharacter);
procedure randTrigger(ch : GCharacter);
procedure deathTrigger(ch, victim : GCharacter);
procedure resetTrigger(ch : GCharacter);
procedure actTrigger(npc, actor : GCharacter; s : string);
function blockTrigger(ch, victim : GCharacter; vnum : integer) : boolean;
procedure giveTrigger(npc, actor : GCharacter; obj : GObject);

implementation

uses
    SysUtils,
    strip,
    util,
    mudsystem,
    mudthread,
    constants;


procedure GProgram.load(var fp : GFileReader; trigger : string; npc : GNPCIndex);
var
   g : string;
begin
  g := right(uppercase(trigger),' ');
  args := right(g,' ');

  g := left(g,' ');
  perc := strtointdef(args, 0);

  if (g = 'ON_ACT') then
    begin
    prog_type := MPROG_ACT;
    SET_BIT(npc.mpflags, MPROG_ACT);
    end
  else
  if (g = 'ON_GREET') then
    begin
    prog_type := MPROG_GREET;
    SET_BIT(npc.mpflags, MPROG_GREET);
    end
  else
  if (g = 'ON_ALLGREET') then
    begin
    prog_type := MPROG_ALLGREET;
    SET_BIT(npc.mpflags, MPROG_ALLGREET);
    end
  else
  if g='ON_ENTER' then
    begin
    prog_type := MPROG_ENTER;
    SET_BIT(npc.mpflags, MPROG_ENTER);
    end
  else
  if g='ON_DEATH' then
    begin
    prog_type:=MPROG_DEATH;
    SET_BIT(npc.mpflags,MPROG_DEATH);
    end
  else
  if g='ON_BRIBE' then
    begin
    prog_type:=MPROG_BRIBE;
    SET_BIT(npc.mpflags,MPROG_BRIBE);
    end
  else
  if g='ON_FIGHT' then
    begin
    prog_type:=MPROG_FIGHT;
    SET_BIT(npc.mpflags,MPROG_FIGHT);
    end
  else
  if g='ON_RAND' then
    begin
    prog_type:=MPROG_RAND;
    SET_BIT(npc.mpflags,MPROG_RAND);
    end
  else
  if g='ON_BLOCK' then
    begin
    prog_type:=MPROG_BLOCK;
    SET_BIT(npc.mpflags,MPROG_BLOCK);
    end
  else
  if g='ON_RESET' then
    begin
    prog_type:=MPROG_RESET;
    SET_BIT(npc.mpflags,MPROG_RESET);
    end
  else
  if g='ON_GIVE' then
    begin
    prog_type:=MPROG_GIVE;
    SET_BIT(npc.mpflags,MPROG_GIVE);
    end
  else
    bugreport('GProgram.load', 'progs.pas', 'illegal trigger type', '');

  code := '';

  repeat
    g := fp.readLine;

    if (g <> '~') then
      code := code + g + #13#10;
  until (g = '~');

  npc.programs.insertLast(Self);
end;

function parseCode(prog : string; npc, actor : GCharacter; obj : GObject) : string;
var c : char;
    prog_c : integer;
    dest : string;
begin
  prog_c := 1;
  dest := '';
  Result := '';

  while (prog_c <= length(prog)) do
    begin
    c := prog[prog_c];

    if (c = '$') then
      begin
      inc(prog_c);

      case prog[prog_c] of
          'i' : dest := dest + npc.name^;
          'n' : dest := dest + actor.name^;
         else
           bugreport('parseCode', 'progs.pas', 'unknown format ' + prog[prog_c],
                     'Bad format code in this mobprog. Please check your settings.');
      end;
      end
    else
      dest := dest + c;

    inc(prog_c);
    end;

  Result := dest;
end;

{ much of the code has been taken from the mudprogs in Smaug 1.02 }
{ adapted quite a lot and removed even more, which I don't need or }
{ which is not for Grendel - Grimlord. }

function GProgram.seval(lhs, opr, rhs : string; npc : GCharacter) : boolean;
begin
  Result := false;

  if (opr = '==') then
    Result := (lhs = rhs)
  else
  if (opr='!=') then
    Result := (lhs <> rhs)
  else
    bugreport('GProgram.seval', 'progs.pas', 'invalid operator ' + opr,
              'An invalid operator was found in this mobprog. Please check your settings.');
  exit;
end;

function GProgram.veval(lhs : integer; opr : string; rhs : integer; npc : GCharacter) : boolean;
begin
  Result := false;

  if (opr='==') then
    Result := (lhs = rhs)
  else
  if (opr='!=') then
    Result := (lhs <> rhs)
  else
  if (opr='>') then
    Result := (lhs > rhs)
  else
  if (opr='<') then
    Result := (lhs < rhs)
  else
  if (opr='>=') then
    Result := (lhs >= rhs)
  else
  if (opr='<=') then
    Result := (lhs <= rhs)
  else
  if (opr='&') then
    Result := (lhs and rhs) = rhs
  else
  if (opr='|') then
    Result := (lhs or rhs) = rhs
  else
    bugreport('GProgram.veval', 'progs.pas', 'invalid operator ' + opr,
              'An invalid operator was found in this mobprog. Please check your settings.');
  exit;
end;

function GProgram.ifcheck(ifcheck : string; npc, actor : GCharacter; obj : GObject; vo : pointer; rand : GCharacter) : integer;
var cvar,chck,opr,rval : string;
    chkchar : GCharacter;
    chkobj : GObject;
begin
  ifcheck := trim(ifcheck);

  if (length(ifcheck) = 0) then
    begin
    bugreport('GProgram.ifcheck', 'mobprogs.pas', 'null ifcheck, ' + npc.name^,
              'This ifcheck does not have any parameters.');

    Result := BERR;
    exit;
    end;

  chkchar := nil;
  chkobj := nil;

  if (pos('(', ifcheck) > 0) then
    begin
    chck := left(ifcheck, '(');
    ifcheck := right(ifcheck, '(');
    end
  else
    begin
    bugreport('GProgram.ifcheck', 'mobprogs.pas', 'syntax error, ' + npc.name^,
              'Encountered a syntax error in this mobprog. Please check your settings.');
    Result := BERR;
    exit;
    end;


  if (pos(')', ifcheck) > 0) then
    begin
    cvar := left(ifcheck, ')');
    ifcheck := right(ifcheck, ')');
    end
  else
    begin
    bugreport('GProgram.ifcheck', 'mobprogs.pas', 'syntax error, ' + npc.name^,
              'Encountered a syntax error in this mobprog. Please check your settings.');

    Result := BERR;
    exit;
    end;

  ifcheck := trim(ifcheck);

  if (length(ifcheck) = 0) then
    begin
    opr := '';
    rval := '';
    end
  else
    begin
    if (pos(' ', ifcheck) > 0) then
      begin
      opr := left(ifcheck, ' ');
      ifcheck := right(ifcheck, ' ');
      end
    else
      begin
      bugreport('GProgram.ifcheck', 'mobprogs.pas', 'operator without value, ' + npc.name^,
                'Encountered a syntax error in this mobprog. Please check your settings.');
      Result := BERR;
      exit;
      end;

    rval := ifcheck;
    end;

  if (pos('$', cvar) > 0) then
    begin
    case cvar[2] of
      'i':chkchar:=npc;
      'n':chkchar:=actor;
      't':chkchar:=GCharacter(vo);
      'r':chkchar:=rand;
      'o':chkobj:=obj;
      'p':chkobj:=GObject(vo);
    else
      begin
        bugreport('GProgram.ifcheck', 'mobprogs.pas', 'bad argument, ' + npc.name^,
                  'Encountered a syntax error in this mobprog. Please check your settings.');
      Result := BERR;
      exit;
      end;
    end;
    if ((chkchar=nil) and (chkobj=nil)) then
      begin
      Result := BERR;
      exit;
      end;
  end;

  if (chck='rand') then
    begin
    Result := integer(number_percent <= strtoint(cvar));
    exit;
    end;

  if (chkchar<>nil) then
    begin
    if (chck='isimmort') then
      begin
      Result := integer(chkchar.IS_IMMORT);
      exit;
      end
    else
    if (chck='isevil') then
      begin
      Result := integer(chkchar.IS_EVIL);
      exit;
      end
    else
    if (chck='isgood') then
      begin
      Result := integer(chkchar.IS_GOOD);
      exit;
      end
    else
    if (chck='isinvis') then
      begin
      Result := integer(chkchar.IS_INVIS);
      exit;
      end
    else
    if (chck='isnpc') then
      begin
      Result := integer(chkchar.IS_NPC);
      exit;
      end
    else
    if (chck='ispc') then
      begin
      Result := integer(not chkchar.IS_NPC);
      exit;
      end
    else
    if (chck='race') then
      begin
      Result := integer(seval(chkchar.race.name,opr,rval,npc));
      exit;
      end;
    end;

  bugreport('GProgram.ifcheck', 'mobprogs.pas', 'illegal ifcheck, '+npc.name^,
            'An unknown ifcheck was found in this mobprog.');
  Result := BERR;
end;

function GProgram.command(cmd : string; npc,actor : GCharacter; obj : GObject;
                       ignore, ignore_ors : boolean) : integer;
var
    firstword, rest : string;
    validif : integer;
begin
  cmd := trim(cmd);

  firstword := left(cmd, ' ');
  rest := right(cmd, ' ');

  if (firstword = 'if') then
    begin
    if (ignore) then
      begin
      Result := IFIGNORED;
      exit;
      end
    else
      validif := ifcheck(rest, npc, actor, obj, nil, nil);

    if (validif = 1) then
      Result := IFTRUE
    else
    if (validif = 0) then
      Result := IFFALSE
    else
      Result := BERR;
    exit;
    end;

  if (firstword = 'or') then
    begin
    if (ignore_ors) then
      begin
      Result := ORIGNORED;
      exit;
      end;

    Result := BERR;
    exit;
    end;

  if (firstword = 'else') then
    begin
    Result := FOUNDELSE;
    exit;
    end;

  if (firstword ='endif') then
    begin
    Result := FOUNDENDIF;
    exit;
    end;

  if (ignore) then
    begin
    Result := COMMANDOK;
    exit;
    end;

  if (cmd = 'mpreturntrue') then
    return := true
  else
  if (cmd = 'mpreturnfalse') then
    return := false
  else
  if (cmd = 'aggrogood') then
    npc.hunting := npc.room.findRandomGood
  else
  if (cmd = 'aggroevil') then
    npc.hunting := npc.room.findRandomEvil
  else
    interpret(npc, parseCode(cmd, npc, actor, obj));

  Result := COMMANDOK;
end;

procedure GProgram.driver(npc, actor : GCharacter; obj : GObject);
var cmd, line : string;
    ifstate:array[0..MAX_IFCHECKS-1,IN_IF..DO_ELSE] of boolean;
    i, iflevel, presult, ignorelevel : integer;
    s : integer;
begin
  for iflevel:=0 to MAX_IFCHECKS-1 do
   for i:=IN_IF to DO_ELSE do
    ifstate[iflevel,i]:=false;

  return := false;
  iflevel := 0;
  ignorelevel := 0;
  cmd := code;

  repeat
    s := pos(#13#10, cmd);

    if (s > 0) then
      begin
      line := copy(cmd, 1, s - 1);
      cmd := copy(cmd, s + 2, length(cmd) - s - 2 + 1);

      presult := command(line, npc, actor, obj,
              (ifstate[iflevel,IN_IF] and (not ifstate[iflevel,DO_IF]))
              or (ifstate[iflevel,IN_ELSE] and (not ifstate[iflevel,DO_ELSE])),
              ignorelevel > 0);

      case presult of
        { command is okay, do nothing }
        COMMANDOK:;
        { encountered an ifcheck which returned true }
           IFTRUE:begin
                  inc(iflevel);
                  if iflevel>=MAX_IFCHECKS then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'max number of ifs, ' + npc.name^,
                              'The maximum number of ifchecks was reached.');
                    exit;
                    end;
                  ifstate[iflevel,IN_IF]:=true;
                  ifstate[iflevel,DO_IF]:=true;
                  end;
        { encountered an ifcheck which returned false }
          IFFALSE:begin
                  inc(iflevel);
                  if iflevel>=MAX_IFCHECKS then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'max number of ifs, ' + npc.name^,
                              'The maximum number of ifchecks was reached.');
                    exit;
                    end;
                  ifstate[iflevel,IN_IF]:=true;
                  ifstate[iflevel,DO_IF]:=false;
                  end;
        { encountered an or check which returned true }
           ORTRUE:begin
                  if not (ifstate[iflevel,IN_IF]) then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'unmatched or - ' + npc.name^,
                              'Syntax error in this mobprog.');
                    exit;
                    end;
                  ifstate[iflevel,DO_IF]:=true;
                  end;
        { encountered an or check which returned false }
          ORFALSE:begin
                  if not (ifstate[iflevel,IN_IF]) then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'unmatched or - ' + npc.name^,
                              'Syntax error in this mobprog.');
                    exit;
                    end;
                  end;
        { encountered an else block }
        FOUNDELSE:begin
                  if (ignorelevel>0) then
                    break;
                  if (ifstate[iflevel,IN_ELSE]) then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'else in else block - ' + npc.name^,
                              'Syntax error in this mobprog.');
                    exit;
                    end;
                  if not (ifstate[iflevel,IN_IF]) then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'unmatched else - ' + npc.name^,
                              'Syntax error in this mobprog.');
                    exit;
                    end;
                  ifstate[iflevel,IN_ELSE]:=true;
                  ifstate[iflevel,DO_ELSE]:=not ifstate[iflevel,DO_IF];
                  ifstate[iflevel,IN_IF]:=false;
                  ifstate[iflevel,DO_IF]:=false;
                  end;
        { encountered an endif block }
       FOUNDENDIF:begin
                  if not (ifstate[iflevel,IN_IF] or ifstate[iflevel,IN_ELSE]) then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'unmatched endif - ' + npc.name^,
                              'Syntax error in this mobprog.');
                    exit;
                    end;
                  if (ignorelevel>0) then
                    begin
                    dec(ignorelevel);
                    break;
                    end;
                  ifstate[iflevel,IN_IF]:=false;
                  ifstate[iflevel,DO_IF]:=false;
                  ifstate[iflevel,IN_ELSE]:=false;
                  ifstate[iflevel,DO_ELSE]:=false;
                  dec(iflevel);
                  end;
        { this if block should be ignored }
        IFIGNORED:begin
                  if not (ifstate[iflevel,IN_IF] or ifstate[iflevel,IN_ELSE]) then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'ignoring non-if non-else block - ' + npc.name^,
                              'Syntax error in this mobprog.');
                    exit;
                    end;
                  inc(ignorelevel);
                  end;
        { this or block should be ignored }
        ORIGNORED:begin
                  if not (ifstate[iflevel,IN_IF] or ifstate[iflevel,IN_ELSE]) then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'unmatched or - ' + npc.name^,
                              'Syntax error in this mobprog.');
                    exit;
                    end;
                  if (ignorelevel=0) then
                    begin
                    bugreport('mprog_driver', 'mobprogs.pas', 'ignoring or falsely - ' + npc.name^,
                              'Syntax error in this mobprog.');
                    exit;
                    end;
                  end;
        { other error while executing }
             BERR:begin
                  bugreport('mprog_driver', 'mobprogs.pas', 'unknown error - ' + npc.name^,
                              'Syntax error in this mobprog.');
                  exit;
                  end;
      end;
      end
    else
    if (ifstate[iflevel,IN_IF]) or (ifstate[iflevel,IN_ELSE]) then
      begin
      bugreport('mprog_driver', 'mobprogs.pas', 'missing endif ' + npc.name^,
                'The ifcheck was not ended properly.');
      exit;
      end;
  until (s = 0);
end;

procedure percentCheck(npc, actor : GCharacter; obj : GObject; prog_type : integer);
var
   prg : GProgram;
   node : GListNode;
begin
  node := npc.npc_index.programs.head;

  while (node <> nil) do
    begin
    prg := node.element;

    if (prg.prog_type = prog_type) then
      begin
      if (number_percent <= prg.perc) then
        begin
        prg.driver(npc, actor, obj);

        if (prog_type <> MPROG_GREET) then
          break;
        end;
      end;

    node := node.next;
    end;
end;

procedure greetTrigger(ch : GCharacter);
var
   vmob : GCharacter;
   node : GListNode;
begin
  if (ch.IS_NPC) then
    exit;

  ch.in_command := false;

  node := ch.room.chars.head;
  while (node <> nil) do
    begin
    vmob := node.element;

    vmob.emptyBuffer;

    node := node.next;
    end;

  node := ch.room.chars.head;
  while (node <> nil) do
    begin
    vmob := node.element;

    if (not vmob.IS_NPC) or (vmob.fighting <> nil) or
     (not vmob.IS_AWAKE) or (not vmob.CAN_SEE(ch)) then
       begin
       node := node.next;
       continue;
       end;

    if (IS_SET(vmob.npc_index.mpflags, MPROG_GREET)) then
      percentCheck(vmob, ch, nil, MPROG_GREET);

    if IS_SET(vmob.act_flags,ACT_AGGRESSIVE) then
      interpret(vmob, 'growl ' + ch.name^);

    node := node.next;
    end;
end;

procedure fightTrigger(ch, victim : GCharacter);
begin
  if (not ch.IS_NPC) then
    exit;

  if (IS_SET(ch.npc_index.mpflags, MPROG_FIGHT)) then
    percentCheck(ch, victim, nil, MPROG_FIGHT);
end;

procedure randTrigger(ch : GCharacter);
var
   vict : GCharacter;
begin
  if (not ch.IS_NPC) or (ch.fighting <> nil) then
    exit;

  if (IS_SET(ch.npc_index.mpflags, MPROG_RAND)) then
    begin
    vict := ch.room.findRandomChar;

    if (vict <> nil) then
      percentCheck(ch, vict, nil, MPROG_RAND);
    end;
end;

procedure actTrigger(npc, actor : GCharacter; s : string);
var
   prg : GProgram;
   node : GListNode;
begin
  if (not npc.IS_NPC) or (npc.fighting <> nil) then
    exit;

  s := uppercase(s);

  node := npc.npc_index.programs.head;

  while (node <> nil) do
    begin
    prg := node.element;

    if (prg.prog_type = MPROG_ACT) then
      begin
      if (pos(prg.args, s) > 0) then
        prg.driver(npc, actor, nil);
      end;

    node := node.next;
    end;
end;

function blockTrigger(ch, victim : GCharacter; vnum : integer) : boolean;
var
   prg : GProgram;
   node : GListNode;
begin
  Result := false;

  if (not ch.IS_NPC) then
    exit;

  node := ch.npc_index.programs.head;

  while (node <> nil) do
    begin
    prg := node.element;

    if (prg.prog_type = MPROG_BLOCK) then
      begin
      if (strtoint(prg.args) = vnum) then
        begin
        prg.driver(ch, victim, nil);

        Result := prg.return;
        end;
      end;

    node := node.next;
    end;
end;

procedure deathTrigger(ch, victim : GCharacter);
begin
  if (not ch.IS_NPC) then
    exit;

  if (IS_SET(ch.npc_index.mpflags, MPROG_DEATH)) then
    percentCheck(ch, victim, nil, MPROG_DEATH);
end;

procedure resetTrigger(ch : GCharacter);
begin
  if (not ch.IS_NPC) then
    exit;

  if (IS_SET(ch.npc_index.mpflags, MPROG_RESET)) then
    percentCheck(ch, nil, nil, MPROG_RESET);
end;

{ GiveTrigger - Nemesis }
procedure giveTrigger(npc, actor : GCharacter; obj : GObject);
var prg : GProgram;
    node : GListNode;
begin
  if (not npc.IS_NPC) then
    exit;

  node := npc.npc_index.programs.head;

  while (node <> nil) do
    begin
    prg := node.element;

    if (prg.prog_type = MPROG_GIVE) then
      begin
      if (prg.args = uppercase(obj.name^)) then
        begin
        obj.extract;
        prg.driver(npc, actor, nil);
        end;
      end;

    node := node.next;
    end;
end;

begin
end.