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

program BB8CORE3 (input, output);

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

type
  string17 = string[22];

const
  MAX_FILES  = 45;

var
  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..77] of string17;
  AVar           : array[0..77] of string;
  VarIndex       : integer;
  ProgramCounter : integer;
  TEKST          : string; Ch : char;

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
    C     : longint;
    FOUND : boolean;
    IsReal: boolean;
    Len   : byte;
  begin
    while (pos (' ', VarName) > 0) do delete (VarName, pos (' ', VarName), 1);
    UpString (VarName);
    for C:= 0 to VARINDEX do begin
      if VarName = _VARNAME[C] then begin
        FOUND:= true;
        AVAR[C]:= VALUE;
        exit;
      end;
    end;
    if VarIndex < 77 then begin
      inc (VarIndex, 1);
      _VarName [VarIndex]:= VarName;
      AVAR[VARINDEX]:= VALUE;
    end;
  end;

function LoadVariable (VarName : string) : string;
  var
    c        : longint;
    ISREAL   : boolean;
    LEN      : byte;
    FOUND    : boolean;
  begin
    IsReal:= not IsString(VARNAME);
    Found:= false;
    for C:= 0 to VARINDEX do begin
      if VARNAME = _VARNAME[C] then begin
        Found:= true;
        LOADVARIABLE:= AVAR[C];
        exit;
      end;
    end;
    if not FOUND then begin
      case ISREAL of
        true  : SAVEVARIABLE (VARNAME, '0');
        false : SAVEVARIABLE (VARNAME, '');
      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 77 do _VarName[c]:= '';
    for C:= 0 to 77 do AVAR[C]:= '';
    VarIndex:= -1;
    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
  SAVEDOSSCREEN;
  CLEAR;
  VGAINIT;

setbkcolor (PAPER);
cleardevice;
setcolor (INK);
directvideo:= false;
gotoxy (1, 1);
TEKST:= REPLACEVARIABLES('"VADER.RAW"');
TEKST:= ANYTHING(TEKST);
TRIM (TEKST);
while (pos('"', TEKST) > 0) do delete (TEKST, pos('"', TEKST), 1);
SHOWIMAGEVGA (TEKST);
TEKST:= _CALCSTRING (TEKST);
PRINTVGA ((wherex-1)*8, (wherey-1)*8, 'HELLO WORLD.');
gotoxy (1, wherey+1);
SAVEVARIABLE ('AAP$', '"EET NOOTJES EN BANANEN EN KUMKWATS"');
TEKST:= REPLACEVARIABLES('AAP$');
TEKST:= _CALCSTRING (TEKST);
PRINTVGA ((wherex-1)*8, (wherey-1)*8, TEKST );
gotoxy (1, wherey+1);
READLNVGA (TEKST);
delete (TEKST, length(TEKST), 1);
SAVEVARIABLE ('AAP$', TEKST);
gotoxy (1, wherey+1);
TEKST:= REPLACEVARIABLES('AAP$');
TEKST:= _CALCSTRING (TEKST);
PRINTVGA ((wherex-1)*8, (wherey-1)*8, TEKST );
gotoxy (1, wherey+1);
READLNVGA (TEKST);
delete (TEKST, length(TEKST), 1);
SAVEVARIABLE ('ABC', TEKST);
gotoxy (1, wherey+1);
TEKST:= REPLACEVARIABLES('ABC');
TEKST:= _CALCSTRING (TEKST);
PRINTVGA ((wherex-1)*8, (wherey-1)*8, TEKST );
gotoxy (1, wherey+1);
repeat until keypressed;
Ch:= readkey;
SAVEVARIABLE ('KEY$', Ch);
end.
