{
  ai.planet
  http://aiplanet.sourceforge.net
  Created by Dave Kerr (kerrd@hotmail.com)

    trying to prevent infinite actions by one object.
    If an creature can act infinitely, it never loses.
}
unit cAIActions;

interface

uses Classes, cAIBaseObject, Geometry;

const
  // possible actions
  cActionNil = -1;      // NIL: Not a valid action
  cActionForce = 0;     // FORCE: Accelerate an object
  cActionGrab = 1;      // GRAB: Creature grabs an object
  cActionAttack = 2;    // ATTACK: Change health of another livingthing
  cActionBite = 3;      // BITE: Transfer health from one thing to another
  cActionUse = 4;       // USE: Calls AIThing.Perform(Action.Modifier)
  cActionGive = 5;      // GIVE: Transfers an object to another creature
  cActionDrop = 6;      // DROP: Creature drops whatever object it is holding
  cActionBonk = 7;      // BONK: Knock item from another creature's grabber

  // energy costs for each action
  cCostTurn = 1;
  cCostMove = 2;
  cCostBite = 5;
  cCostGrab = 5;
  cCostEat = 2;
  cCostAttack = 6;
  cCostDefend = 4;
  cCostForce = 4;
  cCostDrop = 1;
  cCostThrow = 5;
  cCostKick = 5;
  cCostUse = 2;
  // energy costs for using senses
  cCostLook = 1;
  cCostSmell = 1;
  cCostHear = 1;


type

// ============================================================================
AIAction = record
  Kind: integer;
  Value: integer;
  Origin: pointer;
  Target: pointer;
  Amount: single;
  Vector: TAffineVector;
end;

AIActionArray = array of AIAction;

// ----------------------------------------------------------------------------
AIActionScheduler = Class(AIBaseObject)
private
  fFull: boolean;
  fActiveIndex: integer;
  fSize: integer;
  fActions: AIActionArray;
protected
  procedure IncreaseArraySize(aAmount: integer);
public
  Constructor Create(aParent: pointer; aSize: integer);
  Destructor Destroy; override;

  property Full: boolean read fFull;
  property Size: integer read fSize;
  property ActiveIndex: integer read fActiveIndex write fActiveIndex;
  property Actions: AIActionArray read fActions;

  procedure Clear;
  function Empty: boolean;
  function Count: integer;
  procedure NotifyOfDeath(aThing: pointer);

  function AddAction(aKind: integer; aOrigin, aTarget: pointer): boolean; overload;

  procedure Advance;

  procedure DisplayMatchingActions(aThing: pointer; aList: TStrings);
  procedure SaveToFile(var aFile: TextFile); override;
  procedure LoadFromFile(var aFile: TextFile); override;
  procedure FullDisplay(aLines: TStrings); override;
end;

function ActionOneLineDisplay(aAction: AIAction): string;
function ActionKindToString(aKind: integer): string;

implementation

uses
  cUtilities, SysUtils, cGlobals, cAICreature, cAILife, cAIVibes, cAIThings;

// ----------------------------------------------------------------------------
Constructor AIActionScheduler.Create(aParent: pointer; aSize: integer);
begin
  inherited Create(aParent);

  fSize := aSize;
  fActiveIndex := 0;
  SetLength(fActions, fSize);
end;

// ----------------------------------------------------------------------------
Destructor AIActionScheduler.Destroy;
begin
  inherited Destroy;
end;

// ----------------------------------------------------------------------------
function AIActionScheduler.AddAction(
    aKind: integer;
    aOrigin, aTarget: pointer): boolean;
begin
  // if too many events, then increase the event size list
  if fActiveIndex >= fSize then
    IncreaseArraySize(16);

  fActions[fActiveIndex].Kind := aKind;
  fActions[fActiveIndex].Origin := aOrigin;
  fActions[fActiveIndex].Target := aTarget;

  fActiveIndex := fActiveIndex + 1;
  fFull := true;
  result := true;
end;

// ----------------------------------------------------------------------------
// enact all Actions
// clear all Actions
procedure AIActionScheduler.Advance;
var
  i: integer;
  myAction: AIAction;
  myTarget, myOrigin: AIThing;
begin
  for i := 0 to Count -1 do
  begin
    myAction := fActions[i];
    Assert(Assigned(myAction.Target));
    Assert(Assigned(myAction.Origin));
    myTarget := AIThing(myAction.Target);
    myOrigin := AIThing(myAction.Origin);
    case myAction.Kind of
      // Force
      cActionForce: myTarget.Position.Acceleration.ApplyForce(myAction.Vector);
      // Grab
      cActionGrab: gEnvironment.EnactGrab(AICreature(myOrigin), myTarget);
      // Bonk
      cActionBonk: gEnvironment.EnactBonk(AICreature(myOrigin), myTarget);
      // Attack
      cActionAttack:
        AICreature(myAction.Target).HealthIncrease(-1*myAction.Value);
      // Bite
      cActionBite:
      begin
        AICreature(myAction.Origin).HealthIncrease(myAction.Value);
        AILivingThing(myAction.Target).HealthIncrease(-1*myAction.Value);
      end;
      cActionUse:
        myTarget.Perform(myAction.Value);
    end;
  end;
  Clear;
end;

// ----------------------------------------------------------------------------
procedure AIActionScheduler.Clear;
begin
  fActiveIndex := 0;
  fFull := false;
end;

// ----------------------------------------------------------------------------
function AIActionScheduler.Empty: boolean;
begin
  result := not (fFull);
end;

// ----------------------------------------------------------------------------
function AIActionScheduler.Count: integer;
begin
  result := fActiveIndex;
end;

// ----------------------------------------------------------------------------
procedure AIActionScheduler.IncreaseArraySize(aAmount: integer);
begin
  fSize := Count + aAmount;
  SetLength(fActions, Size);
end;

// ----------------------------------------------------------------------------
procedure AIActionScheduler.FullDisplay(aLines: TStrings);
var
  i: integer;
  RigidCount: integer;
  myAction: AIAction;
begin
  aLines.Add('Action Scheduler');
  aLines.Add('--------------');
  inherited FullDisplay(aLines);
  aLines.Add('Full: ' + BoolToYesNoStr(fFull));
  aLines.Add('Size: ' + IntToStr(fSize));
  aLines.Add('ActiveIndex: ' + IntToStr(fActiveIndex));
  aLines.Add('--------------');
  RigidCount := ActiveIndex - 1;
  for i := 0 to RigidCount do
  begin
    myAction := fActions[i];
    aLines.Add(IntToStr(i) + ': ' + ActionOneLineDisplay(myAction));
  end;
end;

// ----------------------------------------------------------------------------
// disable all events that contain this thing
// - when a unit dies, its actions get disabled
procedure AIActionScheduler.NotifyOfDeath(aThing: pointer);
var
  i: integer;
  myAction: AIAction;
begin
  for i := 0 to Count -1 do
  begin
    myAction := fActions[i];
    if myAction.Target = aThing then
      myAction.Kind := cActionNil;
    if myAction.Origin = aThing then
      myAction.Kind := cActionNil;
  end;
end;

// ----------------------------------------------------------------------------
procedure AIActionScheduler.DisplayMatchingActions(aThing: pointer; aList: TStrings);
var
  i: integer;
  myAction: AIAction;
begin
  for i := 0 to Count -1 do
  begin
    myAction := fActions[i];
    if (myAction.Target = aThing) or (myAction.Origin = aThing) then
      aList.Add(ActionOneLineDisplay(myAction));
  end;
end;

// ----------------------------------------------------------------------------
function ActionKindToString(aKind: integer): string;
begin
  case aKind of
    cActionNil: result:='nil';
    cActionForce: result:='force';
    cActionGrab: result:='grab';
    cActionAttack: result:='attack';
    cActionBite: result:='bite';
    cActionUse: result:='use';
    cActionGive: result:='give';
    cActionDrop: result:='drop';
    cActionBonk: result:='bonk';
  else
    result := IntToStr(aKind) + '-undefined ';
  end;
end;

// ----------------------------------------------------------------------------
function ActionOneLineDisplay(aAction: AIAction): string;
begin
  case aAction.Kind of
    cActionGrab:
      result := Format('Kind=%s, Target=%s, Origin=%s',
      [ActionKindToString(aAction.Kind),
      AIThing(aAction.Target).OneLineDisplay,
      AIThing(aAction.Origin).OneLineDisplay]);
    cActionBonk:
      result := Format('Kind=%s, Target=%s, Origin=%s',
      [ActionKindToString(aAction.Kind),
      AIThing(aAction.Target).OneLineDisplay,
      AIThing(aAction.Origin).OneLineDisplay]);
  else
    result := Format('Kind=%s, Target=%s, Origin=%s',
     [ActionKindToString(aAction.Kind), PtrToStr(aAction.Target), PtrToStr(aAction.Origin)]);
  end;
end;

// ----------------------------------------------------------------------------
procedure AIActionScheduler.LoadFromFile(var aFile: TextFile);
var
  i: integer;
  handle: integer;
begin
  inherited LoadFromFile(aFile);

  readln(aFile, fActiveIndex);
  readln(aFile, fSize);
  fFull := readFileBoolean(aFile);
  // recalculate size to make it smaller memory
  fSize := fActiveIndex + 16;
  SetLength(fActions, fSize);

  for i := 0 to fActiveIndex - 1 do
  begin
    readln(aFile, fActions[i].Kind);
    readln(aFile, fActions[i].Value);
    readln(aFile, fActions[i].Amount);
    readVector(aFile, fActions[i].Vector);
    readln(aFile, Handle);
    fActions[i].Target := gSpace.FindWithHandle(Handle);
    readln(aFile, Handle);
    fActions[i].Origin := gSpace.FindWithHandle(Handle);
  end;
end;

// ----------------------------------------------------------------------------
procedure AIActionScheduler.SaveToFile(var aFile: TextFile);
var
  i: integer;
begin
  inherited SaveToFile(aFile);

  writeln(aFile, fActiveIndex);
  writeln(aFile, fSize);
  writeFileBoolean(aFile, fFull);

  for i := 0 to fActiveIndex - 1 do
  begin
    writeln(aFile, fActions[i].Kind);
    writeln(aFile, fActions[i].Value);
    writeln(aFile, fActions[i].Amount);
    writeVector(aFile, fActions[i].Vector);
    writeln(aFile, AIBaseObject(fActions[i].Target).Handle);
    writeln(aFile, AIBaseObject(fActions[i].Origin).Handle);
  end;
end;

end.
