{$i-,s-,r-}
{$m $ff02,0,65535}

program BB8CORE2 (input, output);

uses
  crt, dos, CORE,CORE2,CORE3,CORE5, CYPHER,TANK, ERRORS,graph;

type
  VariablesBuffer = array[0..53001] of byte;
  string17        = string[22];

const
  MAX_FILES  = 45;

var
  AVar           : ^VariablesBuffer;
  HighestVarPos  : longint;
  KP             : boolean;
  EOFILE         : array[0..MAX_FILES] of boolean;
  AFILE          : array[0..MAX_FILES] of text;
  FMODE          : array[0..MAX_FILES] of char;
  buffer         : array[0..4001] of shortint;
  dosx, dosy     : integer;
  _VarName       : array[0..777] of string17;
  VarIndex       : integer;
  ProgramCounter : integer;
  TEKST          : string;

var
  Segment       : word;
  OPTION_BASE   : shortint;

var
  EXPRESSION  : string;
  INDEX       : integer;
  STOP        : boolean;
  FORLOOPINDEX: longint;
  STDOUT      : text;

const
  PAPER : byte = BLACK;
  INK   : byte = LIGHTGRAY;

function IsString (Tekst : string) : boolean;
  begin
    IsString:= ((pos ('"', Tekst) > 0) or (pos ('$', Tekst) > 0)) and
      ((pos ('LEN', Tekst) = 0) and (pos ('ASC', Tekst) = 0))
  end;

procedure trim (var Tekst : string);
  begin
    while (Tekst[1] = ' ') do
      delete (Tekst, 1, 1);
    while (Tekst[length (Tekst)] = ' ') do
      delete (Tekst, length (Tekst), 1);
  end;

  function IsAlphaBet (Tekst : char) : boolean;
    begin
      IsAlphaBet:= (Tekst in ['A'..'Z', 'a'..'z', '$']);
    end;

procedure SaveVariable (VarName : string; Value : string);
  var
(*    TheVar   : TheConstruct;*)
    Len      : byte;
    Temp     : string;
    IsString : boolean;
    IsReal   : boolean;
    R        : real;
    Found    : boolean;
    c        : longint;
  begin
    while (pos (' ', VarName) > 0) do delete (VarName, pos (' ', VarName), 1);
    UpString (VarName);
    if VarIndex < 777 then begin
      inc (VarIndex, 1);
      _VarName [VarIndex]:= VarName;
    end
      else
        exit;
    IsString:= pos ('$', VarName) > 0;
    IsReal:= not IsString;
    Len:= length (VarName);
    Found:= false;
    for c:= 0 to HighestVarPos+1 do begin
      move (AVar^[c], Temp[0], Len+1);
      if Temp = VarName then begin
        case IsReal of
          true:   begin
            R:= INFIX (Value);
            move (R, AVar^[c + Len + 1], sizeof (real));
          end;
          false: begin
            move (Value[0], AVar^[c+Len + 1], 256);
          end;
        end;
        Found:= true;
        c:= HighestVarPos+1;
      end;
    end;
    if (not Found) and (HighestVarPos < 53001-256*2) then begin
        move (VarName[0], AVar^[HighestVarPos], Len+1);
        inc (HighestVarPos, Len + 1);
        case IsReal of
          true:   begin
            R:= INFIX (Value);
            move (R, AVar^[HighestVarPos], sizeof (real));
            inc (HighestVarPos, sizeof (real));
          end;
          false: begin
            move (Value[0], AVar^[HighestVarPos], 256);
            inc (HighestVarPos, 256);
          end;

        end;
    end;
  end;

function LoadVariable (VarName : string) : string;
  var
(*    TheVar   : TheConstruct;*)
    Len      : byte;
    Temp     : string;
    IsString : boolean;
    IsReal   : boolean;
    R        : real;
    Return   : string;
    c        : longint;
    Found    : boolean;
  begin
    IsString:= pos ('$', VarName) > 0;
    IsReal:= not IsString;
    Len:= length (VarName);
    Found:= false;
    for c:= 0 to HighestVarPos+1 do begin
      move (AVar^[c], Temp[0], Len+1);
      if Temp = VarName then begin
        case IsReal of
          true:   begin
            move (AVar^[c + Len + 1], R, sizeof (real));
            str (R, Return);
          end;
          false: move (AVar^[c+Len + 1], Return[0], 256);
        end;
        Found:= true;
        c:= HighestVarPos + 1;
      end;
    end;
    if Found then
       LoadVariable:= Return
    else begin
      if IsString then begin
        LoadVariable:= ''
      end
          else begin
            LoadVariable:= '0';
          end;
    end;
  end;

function ReplaceVariables (Tekst : string) : string;
  var
(*    TheVar   : TheConstruct;*)
    Len      : byte;
    Return   : string;
    c, p     : integer;
    a, b     : integer;
    Tekst2   : string;
    r        : real;
    i        : integer;
  begin
    if pos ('[', Tekst) > 0 then begin
      a:= pos ('[', Tekst);
      b:= pos (']', Tekst);
      Tekst2:= Tekst;
      delete (Tekst2, b, 255);
      delete (Tekst2, 1, a);
      delete (Tekst, a, length (Tekst2) + 2);
      Tekst2:= ReplaceVariables (Tekst2);
      R:= INFIX (Tekst2);
      I:= round (R);
      str (I, Tekst2);
      insert (Tekst2, Tekst, a);
      insert ('[', Tekst, a);
      insert (']', Tekst, a+length (Tekst2)+1);
    end;
    Len:= length (Tekst);
    for c:= 0 to VarIndex do begin
       p:= pos (_VarName[c], Tekst);
       while p > 0 do begin

        delete (Tekst, p, length (_VarName[c]));
        Tekst2:= LoadVariable (_VarName[c]);
        if pos ('$', _VarName[c]) > 0 then
          Tekst2:= '"'+Tekst2+'"';
        insert (Tekst2, Tekst, p);
        p:= pos (_VarName[c], Tekst);
      end;
    end;
    ReplaceVariables:= Tekst;
  end;

function ReplaceVariables0 (Tekst : string) : string;
  var
(*    TheVar   : TheConstruct;*)
    Len      : byte;
    Return   : string;
    c, p     : integer;
    a, b     : integer;
    Tekst2   : string;
    r        : real;
    i        : integer;
  begin
    if pos ('[', Tekst) > 0 then begin
      a:= pos ('[', Tekst);
      b:= pos (']', Tekst);
      Tekst2:= Tekst;
      delete (Tekst2, b, 255);
      delete (Tekst2, 1, a);
      delete (Tekst, a, length (Tekst2) + 2);
      Tekst2:= ReplaceVariables (Tekst2);
      R:= INFIX(Tekst2);
      I:= round (R);
      str (I, Tekst2);
      insert (Tekst2, Tekst, a);
      insert ('[', Tekst, a);
      insert (']', Tekst, a+length (Tekst2)+1);
    end;
    ReplaceVariables0:= Tekst;
  end;

procedure Dim (VarName : string; Getal : integer);
  var
    Tekst : string;
    Temp  : string;
    c     : integer;
  begin
    UpString (VarName);
    if pos ('$', VarName) = 0 then
      Tekst:= '0'
        else
          Tekst:= '';
    for c:= OPTION_BASE to Getal do begin
      str (c, Temp);
      SaveVariable (VarName+'['+Temp+']', Tekst);
    end;
  end;

procedure CopyFile (Tekst, Tekst2 : string);
  var
    Buffer2: array[0..1025] of shortint;
    Size   : longint;
    F,F2   : file;
    c      : longint;
  begin
    {$I-}
    assign (F, Tekst);
    reset (F, 1);
    assign (F2, Tekst2);
    rewrite (F2, 1);
    Size:= filesize (F);
    for c:= 1 to Size div 1024 do begin
      blockread (F, Buffer2, 1024);
      blockwrite (F2, Buffer2, 1024);
    end;
    Size:= Size mod 1024;
    blockread (F, Buffer2, SIze);
    blockwrite (F2, Buffer2, Size);
    close (F);
    close (F2)
  end;

procedure SaveDosScreen;
  begin
     move (mem[$b800:0], buffer, 4000);
     dosx:= wherex;
     dosy:= wherey;
  end;

procedure RestoreDosScreen;
  begin
      textmode (co80);
      move (buffer, mem[$b800:0], 4000);
      gotoxy (dosx, dosy);
  end;

procedure Clear;
  var
    C  : integer;
  begin
    FoutMelding:= false;
    FoutTekst:= '';
    STOP:= false;
    OPTION_BASE:= 1;
    for c:= 0 to MAX_FILES do FMODE[c]:= 'C';
    for c:= 0 to 777 do _VarName[c]:= '';
    VarIndex:= -1;
    HighestVarPos:= 0;
    Paper:= BLUE;
    Ink:= LightGray;
    ForLoopIndex:= -1;
    textbackground (Paper);
    textcolor (Ink);
    gotoxy (1, 1);
    SaveVariable ('VGAHI', '11');
    SaveVariable ('TEXT', '3');
    SaveVariable ('FLASHING', '128');
    SaveVariable ('BLACK', '0');
    SaveVariable ('BLUE', '1');
    SaveVariable ('GREEN', '2');
    SaveVariable ('CYAN', '3');
    SaveVariable ('RED', '4');
    SaveVariable ('MAGENTA', '5');
    SaveVariable ('BROWN', '6');
    SaveVariable ('LIGHTGRAY', '7');

    SaveVariable ('DARKGRAY', '8');
    SaveVariable ('LIGHTBLUE', '9');
    SaveVariable ('LIGHTGREEN', '10');
    SaveVariable ('LIGHTCYAN', '11');
    SaveVariable ('LIGHTRED', '12');
    SaveVariable ('LIGHTMAGENTA', '13');
    SaveVariable ('YELLOW', '14');
    SaveVariable ('WHITE', '15');
    SEGMENT:= $A000;
  end;

  var
    Escape : boolean;

begin
  new (AVAR);
  SAVEDOSSCREEN;
  VGAINIT;
  CLEAR;
