cs2_var.pas

Delphi script parser

end;

procedure VM_Clear(p: PVariableManager);
var
  i: Integer;
begin
  for i := 0 to p^.Ptr.count - 1 do
  begin
    DestroyCajVariant(p^.Ptr.GetItem(i));
  end;
  p^.names.Clear;
  p^.Ptr.Clear;
end;

procedure VM_Delete(p: PVariableManager; Idx: LongInt);
begin
  p^.Names.Delete(idx);
  DestroyCajVariant(p^.Ptr.GetItem(idx));
  p^.Ptr.Delete(Idx);
end;

function VM_Find(p: PVariableManager; const Name: string): LongInt;
var
  i: Integer;
begin
  for i := 0 to p^.Names.Count - 1 do
  begin
    if p^.names.GetItem(i) = Name then
    begin
      VM_Find := I;
      Exit;
    end;
  end;
  VM_Find := -1;
end;

function VM_Count(p: PVariableManager): LongInt;
begin
  VM_Count := P^.Ptr.Count;
end;

function VM_Get(p: PVariableManager; Idx: LongInt): PCajVariant;
begin
  VM_Get := P^.Ptr.GetItem(idx);
end;

procedure VM_SetName(p: PVariableManager; Idx: LongInt; S: string);
begin
  P^.Names.SetItem(idx, s);
end;


function PM_Create: PProcedureManager;
{Creates an instance of a Procedure Manager}
var
  p: PProcedureManager;
begin
  New(p);
  p^.names.Create;
  p^.Ptr.Create;
  PM_Create := p;
end;

procedure PM_Clear(p: PProcedureManager);
begin
  p^.names.Clear;
  p^.Ptr.Clear;
end;

procedure PM_Destroy(p: PProcedureManager);
{Destroys an instance of a Procedure Manager}
begin
  p^.names.Destroy;
  p^.Ptr.Destroy;
  Dispose(p);
end;

procedure PM_Add(p: PProcedureManager; const Spec: string; Addr: Pointer);
var
  w: string;
begin
  w := spec;
  Delete(w, 1, Pos(' ', w));
  Rs(w);
  if Pos(' ', w) > 0 then
    w := Copy(w, 1, Pos(' ', w) - 1);
  if Pm_Find(p, w) = -1 then
  begin
    p^.Names.Add(Spec);
    p^.Ptr.Add(Addr);
  end;
end;

procedure PM_Delete(p: PProcedureManager; I: LongInt);
begin
  p^.Names.Delete(i);
  p^.Ptr.Delete(I);
end;

function PM_Find(p: PProcedureManager; const Name: string): Integer;
var
  i: Integer;
  s: string;
begin
  for i := 0 to p^.names.count - 1 do
  begin
    s := p^.names.GetItem(i);
    Delete(s, 1, Pos(' ', s));
    Rs(s);
    if Pos(' ', s) > 0 then
      s := Copy(s, 1, Pos(' ', s) - 1);
    if s = Name then
    begin
      PM_Find := i;
      Exit;
    end;
  end;
  PM_Find := -1;
end;

function PM_Get(p: PProcedureManager; i: LongInt): Pointer;
begin
  PM_Get := p^.Ptr.GetItem(i);
end;

function PM_GetSpec(p: PProcedureManager; i: LongInt): string;
begin
  PM_GetSpec := p^.Names.GetItem(i);
end;

function DoMinus(p: PCajVariant): Boolean;
begin
  p := GetVarLink(p);
  DoMinus := True;
  case P^.VType of
    CSV_UByte: p^.Cv_UByte := -p^.Cv_UByte;
    CSV_SByte: p^.Cv_SByte := -p^.Cv_SByte;
    CSV_UInt16: p^.Cv_UInt16 := -p^.Cv_UInt16;
    CSV_SInt16: p^.Cv_SInt16 := -p^.Cv_SInt16;
    CSV_UInt32: p^.Cv_UInt32 := -p^.Cv_UInt32;
    CSV_SInt32: p^.Cv_SInt32 := -p^.Cv_SInt32;
    CSV_Real: p^.Cv_Real := -p^.Cv_Real;
    CSV_Single: p^.Cv_Single := -p^.cv_Single;
    CSV_Double: p^.Cv_Double := -p^.Cv_Double;
    CSV_Extended: p^.Cv_Extended := -p^.Cv_Extended;
    CSV_Comp: p^.Cv_Comp := -p^.Cv_Comp;
  else
    DoMinus := False;
  end;
end;

function DoNot(p: PCajVariant): Boolean;
begin
  p := GetVarLink(p);
  DoNot := True;
  case P^.VType of
    CSV_UByte: p^.Cv_UByte := not p^.Cv_UByte;
    CSV_SByte: p^.Cv_SByte := not p^.Cv_SByte;
    CSV_UInt16: p^.Cv_UInt16 := not p^.Cv_UInt16;
    CSV_SInt16: p^.Cv_SInt16 := not p^.Cv_SInt16;
    CSV_UInt32: p^.Cv_UInt32 := not p^.Cv_UInt32;
    CSV_SInt32: p^.Cv_SInt32 := not p^.Cv_SInt32;
    CSV_Bool: p^.CV_Bool := not p^.CV_Bool;
  else
    DoNot := False;
  end;
end;

procedure SetInteger(p: PCajVariant; I: LongInt);
begin
  p := GetVarLink(p);
  case P^.VType of
    CSV_UByte: p^.Cv_UByte := i;
    CSV_SByte: p^.Cv_SByte := i;
    CSV_UInt16: p^.Cv_UInt16 := i;
    CSV_SInt16: p^.Cv_SInt16 := i;
    CSV_UInt32: p^.Cv_UInt32 := i;
    CSV_SInt32: p^.Cv_SInt32 := i;
  end;
end;

procedure SetReal(p: PCajVariant; i: Extended);
begin
  p := GetVarLink(p);
  case P^.VType of
    CSV_Real: P^.CV_Real := i;
    CSV_Single: P^.CV_Single := i;
    CSV_Double: P^.CV_Double := i;
    CSV_Extended: P^.CV_Extended := i;
    CSV_Comp: P^.CV_Comp := i;
  end;
end;

procedure SetString(p: PCajVariant; const I: string);
begin
  p := GetVarLink(p);
  case P^.VType of
    CSV_String: P^.Cv_Str := i;
  end;
end;

function IsRealType(v: PCajVariant): Boolean;
begin
  v := GetVarLink(v);
  IsRealType := (V^.VType = CSV_Real) or
    (v^.Vtype = CSV_Single) or
    (v^.Vtype = CSV_Double) or
    (v^.Vtype = CSV_Extended) or
    (v^.Vtype = CSV_Comp);
end;

function IsIntegerType(v: PCajVariant): Boolean;
begin
  v := GetVarLink(v);
  IsIntegerType := (v^.Vtype = CSV_UByte) or
    (v^.Vtype = CSV_SByte) or
    (v^.Vtype = CSV_UInt16) or
    (v^.Vtype = CSV_SInt16) or
    (v^.Vtype = CSV_UInt32) or
    (v^.Vtype = CSV_SInt32);
end;

function IsBooleanType(v: PCajVariant): Boolean;
begin
  v := GetVarLink(v);
  IsBooleanType := (v^.Vtype = CSV_Bool);
end;

function IsIntRealType(v: PCajVariant): Boolean;
begin
  v := GetVarLink(v);
  IsIntRealType := (v^.Vtype = CSV_UByte) or
    (v^.Vtype = CSV_SByte) or
    (v^.Vtype = CSV_UInt16) or
    (v^.Vtype = CSV_SInt16) or
    (v^.Vtype = CSV_UInt32) or
    (v^.Vtype = CSV_SInt32) or
    (V^.VType = CSV_Real) or
    (v^.Vtype = CSV_Single) or
    (v^.Vtype = CSV_Double) or
    (v^.Vtype = CSV_Extended) or
    (v^.Vtype = CSV_Comp);
end;

function IsStringType(v: PCajVariant): Boolean;
begin
  v := GetVarLink(v);
  IsStringType := (v^.Vtype = CSV_Char) or
    (v^.Vtype = CSV_String);
end;

function GetInt(v: PCajVariant): LongInt;
begin
  v := GetVarLink(v);
  case v^.Vtype of
    CSV_UByte: GetInt := V^.CV_UByte;
    CSV_SByte: GetInt := V^.CV_SByte;
    CSV_UInt16: GetInt := V^.CV_UInt16;
    CSV_SInt16: GetInt := V^.CV_SInt16;
    CSV_UInt32: GetInt := V^.CV_UInt32;
    CSV_SInt32: GetInt := V^.CV_SInt32;
  else GetInt := 0;
  end;
end;

function GetReal(v: PCajVariant): Extended;
begin
  v := GetVarLink(v);
  case v^.Vtype of
    CSV_Real: GetReal := V^.CV_Real;
    CSV_Single: GetReal := V^.CV_single;
    CSV_Double: GetReal := V^.CV_double;
    CSV_Extended: GetReal := V^.CV_Extended;
    CSV_Comp: GetReal := V^.CV_Comp;
    CSV_UByte: GetReal := V^.CV_UByte;
    CSV_SByte: GetReal := V^.CV_SByte;
    CSV_UInt16: GetReal := V^.CV_UInt16;
    CSV_SInt16: GetReal := V^.CV_SInt16;
    CSV_UInt32: GetReal := V^.CV_UInt32;
    CSV_SInt32: GetReal := V^.CV_SInt32;
  else GetReal := 0;
  end;
end;

function GetStr(v: PCajVariant): string;
begin
  v := GetVarLink(v);
  case v^.Vtype of
    CSV_String: GetStr := V^.CV_Str;
    CSV_Char: GetStr := V^.CV_Char;
  end;
end;

function GetBool(v: PCajVariant): Boolean;
begin
  v := GetVarLink(v);
  case v^.Vtype of
    CSV_Bool: GetBool := V^.CV_Bool;
  else
    GetBool := False;
  end;
end;

{$IFDEF DELPHI}{$WARNINGS OFF}{$ENDIF}

function Perform(V1: pCajVariant; v2: pCajVariant; T: TPerformType): Boolean;

var
  err: Boolean;
  i: Longint;

  procedure MakeItReal(v: Extended);
  begin
    V1^.VType := CSV_Extended;
    v1^.Cv_Extended := v;
  end;

  procedure MakeItBool(v: Boolean);
  begin
    v1^.VType := CSV_Bool;
    v1^.Cv_Bool := v;
  end;

  procedure AddArrayVar(var v: TIfList; i: PcajVariant);
  var
    n: PCajVariant;
  begin
    new(n);
    n^.VType := CSV_Var;
    n^.CV_Var := nil;
    PerForm(n, i, ptSet);
  end;

begin
  v1 := GetVarLink(v1);
  v2 := GetVarLink(v2);
  if ((v1^.Vtype <> v2^.VType) and
    not (IsIntRealType(v1) and IsIntRealType(v2)) and
    not (IsStringType(v1) and IsStringType(v2)) and
    not (v1^.VType = CSV_Var)) or (v1^.VType = CSV_Array)
    then
    begin
    Perform := False;
    Exit;
  end;
  Err := False;
  case T of
    PtSet:
      begin
        if IsIntegerType(v1) and not IsIntegerType(v2) then
        begin
          Err := True;
        end else
          case V1^.VType of
            CSV_UByte: v1^.Cv_UByte := GetInt(v2);
            CSV_SByte: v1^.Cv_SByte := GetInt(v2);
            CSV_Char:
              begin
                v1^.Cv_Str := GetStr(v2);
                if Length(v1^.Cv_Str) > 1 then Err := True else
                  v1^.Cv_Char := v1^.Cv_Str[1];
              end;
            CSV_UInt16: v1^.Cv_UInt16 := GetInt(v2);
            CSV_SInt16: v1^.Cv_SInt16 := GetInt(v2);
            CSV_UInt32: v1^.Cv_UInt32 := GetInt(v2);
            CSV_SInt32: v1^.Cv_SInt32 := GetInt(v2);
            CSV_String: v1^.Cv_Str := GetStr(v2);
            CSV_Real: v1^.CV_Real := GetReal(v2);
            CSV_Single: v1^.CV_Single := GetReal(v2);
            CSV_Double: v1^.CV_Double := GetReal(v2);
            CSV_Extended: v1^.CV_Extended := GetReal(v2);
            CSV_Comp: v1^.CV_comp := GetReal(v2);
            CSV_Bool:
              begin
                if v2^.VType = CSV_Bool then
                  v1^.Cv_Bool := v2^.Cv_Bool
                else
                  err := True;
              end;
            CSV_Var: begin
                if v1^.Vtype = CSV_Array then
                begin
                  for i := 0 to v1^.CV_ArrItems.count - 1 do
                  begin
                    DestroyCajVariant(v1^.CV_ArrItems.GetItem(i));
                  end;
                  v1^.CV_ArrItems.Destroy;
                end;
                v1^.VType := v2^.VType;
                case v2^.vtype of
                  CSV_UByte: v1^.CV_UByte := v2^.CV_UByte;