gh/src/trace_m.pas

unit trace_m;

interface

uses creature_m, math_m;

const
    PreviousTraceIdx = 3;
    TraceSymbol = '+';

type
    tracePtr = ^trace;

    trace = record
        x, y: integer;
        prev: tracePtr
    end;

function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer;
function GetLength(var t: tracePtr): integer;
function IsOnTrace(var cr: creature; t: tracePtr): boolean;
function IsOnTrace(x, y: integer; t: tracePtr): boolean;
function
TraceCrossed(prevX, prevY: integer; var cr: creature; t: tracePtr): boolean;
procedure ChangeHamsterTrace(var h: creature; var t: tracePtr);
procedure DecreaseTrace(var hamster: creature; var t: tracePtr);
procedure DeleteTrace(var t: tracePtr);
procedure GetStart(var traceStart: tracePtr; t: tracePtr);
procedure IncreaseTrace(var hamster: creature; var t: tracePtr);
procedure Pop(var t: tracePtr);

implementation

uses arena_graphics_m;

function GetLength(var t: tracePtr): integer;
begin
    if t = nil then
        GetLength := 0
    else
        GetLength := 1 + GetLength(t^.prev)
end;

procedure GetStart(var traceStart: tracePtr; t: tracePtr);
begin
    while t <> nil do
    begin
        if t^.prev = nil then
            traceStart := t;
        t := t^.prev
    end
end;

procedure DeleteTrace(var t: tracePtr);
var
    tmpT: tracePtr;
begin
    while t <> nil do
    begin
        tmpT := t^.prev;
        dispose(t);
        t := tmpT
    end
end;

function FindIndex(var t: tracePtr; x, y, curIdx: integer): integer;
begin
    if t = nil then
        FindIndex := -1
    else
    if (t^.x = x) and (t^.y = y) then
        FindIndex := curIdx
    else
        FindIndex := FindIndex(t^.prev, x, y, curIdx + 1)
end;

function IsOnTrace(x, y: integer; t: tracePtr): boolean;
begin
    if t = nil then
        IsOnTrace := false
    else
    if (t^.x = x) and (t^.y = y) then
        IsOnTrace := true
    else
        IsOnTrace := IsOnTrace(x, y, t^.prev)
end;

procedure Add(var t: tracePtr; x, y: integer);
var
    nextTrace: tracePtr;
begin
    new(nextTrace);
    nextTrace^.x := x;
    nextTrace^.y := y;
    nextTrace^.prev := t;
    t := nextTrace
end;

procedure Pop(var t: tracePtr);
var
    tmpPrev: tracePtr;
begin
    tmpPrev := t^.prev;
    dispose(t);
    t := tmpPrev
end;

function IsOnTrace(var cr: creature; t: tracePtr): boolean;
begin
    IsOnTrace := IsOnTrace(cr.curX, cr.curY, t)
end;

procedure AddStepTrace(var h: creature; var t: tracePtr);
var
    nextX, nextY, dX, dY: integer;
begin
    dX := Signum(h.curX, t^.x);
    dY := Signum(h.curY, t^.y);
    nextX := t^.x + dX;
    nextY := t^.y + dY;
    Add(t, nextX, nextY)
end;

procedure AddFirstTrace(var hamster: creature; var t: tracePtr);
var
    traceX, traceY, dX, dY: integer;
begin
    dX := Signum(hamster.curX - hamster.dX, hamster.curX) * hamster.movespeed;
    dY := Signum(hamster.curY - hamster.dY, hamster.curY) * hamster.movespeed;
    traceX := hamster.curX + dX;
    traceY := hamster.curY + dY;
    Add(t, traceX, traceY)
end;

procedure IncreaseTrace(var hamster: creature; var t: tracePtr);
var
    i: integer;
begin
    if t = nil then
        AddFirstTrace(hamster, t);
    for i := 1 to hamster.movespeed do
        AddStepTrace(hamster, t)
end;

procedure DecreaseTrace(var hamster: creature; var t: tracePtr);
var
    i: integer;
begin
    for i := 1 to hamster.movespeed do
        Pop(t);
    if GetLength(t) = 1 then
        Pop(t)
end;

procedure ChangeHamsterTrace(var h: creature; var t: tracePtr);
begin
    if IsOnTrace(h, t) then
    begin
        EraseStepTrace(h, t);
        DecreaseTrace(h, t)
    end
    else
    begin
        IncreaseTrace(h, t)
    end
end;

function
TraceCrossed(prevX, prevY: integer; var cr: creature; t: tracePtr): boolean;
var
    dX, dY: integer;
begin
    dX := Signum(cr.curX, prevX);
    dY := Signum(cr.curY, prevY);
    while (prevX <> cr.curX) and (prevY <> cr.curY) do
    begin
        if IsOnTrace(prevX, prevY, t) then
        begin
            TraceCrossed := true;
            exit
        end;
        prevX := prevX + dX;
        prevY := prevY + dY
    end;
    TraceCrossed := false
end;

end.