{$i-,r-,s-,d+}
{$m $ff02,1,65311}

{
  writeln ('(c) Copyright: la ligne de la Belgique++');
  writeln;
}

program UltraBasic (input, output);

uses
  crt, dos, graph, CAL, STRINGS, TURBO3, ERRORS;

var
  STOP                   : boolean;

const
  MAX_FILES        = 47;
  MAX_PROGRAM_SIZE = 577;
  MAX_PROGRAMS     = 37;
  TotalCommands    = 20;
  MAX_FOR_LOOPS    = 11;

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

  type
    tForLoop = record
      ControlVariable : string17;
      Start           : integer;
    end;

var
  ForLoopIndex          : integer;
  ForLoopIndexStr       : string;
  ForLoop               : array[0..MAX_FOR_LOOPS] of tForLoop;

const
  Com : array[0..22] of string17 = (
    'OPEN', 'READ', 'WRITE', 'CLOSE', 'INPUT', 'PRINT', 'CLS',

    'IF', 'THEN', 'ELSE', 'FOR', 'NEXT', 'TO', 'STEP',

    'OUTPUT', 'CLS', 'SCREEN', 'LET',

    'GOSUB', 'RETURN', 'GOTO',

    'COPY', 'SHELL'

  );

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..1777] of string17;
  VarIndex       : integer;
  ProgramCounter : integer;

var
  Segment       : word;
  OPTION_BASE   : shortint;

type
  tScreen   = (IsVgaHi, IsText);
  string127 = string[115];

var
  Expression         : string;
  Index              : integer;
  CursorX, CursorY   : integer;

var
  Tekst     : string;
  Ch        : char;
  Screen    : tScreen;
  Paper     : integer;
  Ink       : integer;

procedure EGAVGADriver; external;
  {$L EGAVGA.OBJ}

procedure Set2VgaHi;
  var
    GraphicsDriver, GraphicsMode : integer;
  begin
    GraphicsDriver:= vga;
    GraphicsMode:= vgahi;
    initgraph (GraphicsDriver, GraphicsMode, '');
    setgraphbufsize (7777);
    settextstyle (DefaultFont, HorizDir, 1);
    setbkcolor (Paper);
    cleardevice;
    setcolor (Ink);
  end;

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);
    VarName:= UpString (VarName);
    if VarIndex < 1777 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:= Evaluate (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:= Evaluate (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:= Evaluate (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:= Evaluate (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
    VarName:= 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;

var
  c : integer;

procedure Clear;
  begin
    FoutMelding:= false;
    FoutTekst:= '';
    STOP:= false;
    Screen:= IsText;
    OPTION_BASE:= 1;
    for c:= 0 to MAX_FILES do FMODE[c]:= 'C';
    for c:= 0 to 1777 do _VarName[c]:= '';
    VarIndex:= -1;
    HighestVarPos:= 0;
    Paper:= BLACK;
    Ink:= LightGray;
    Screen:= IsText;
    CursorX:= 1;
    CursorY:= 1;
    ForLoopIndex:= -1;
    textmode (co80);
    textbackground (Paper);
    textcolor (Ink);
    clrscr;
    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');
  end;

procedure Cls;
  begin
    case Screen of
      IsText: begin
        textbackground (Paper);
        textcolor (Ink);
        clrscr;
      end;
      IsVgaHi: begin
        setbkcolor (Paper);
        cleardevice;
        setcolor (Ink);
      end;
    end;
  end;

function NextToken : string;
  var
      Temp    : string;
      Say     : boolean;
      Len     : integer;
  begin
     Temp:= '';
     Len:= length (Expression);
     if (Index <= Len) and (Expression[Index] in [',', ';', '=', '<',
      '>']) then begin
       inc (Index, 1);
       NextToken:= Expression [Index-1];
       exit;
     end;
     while (Index <= Len) and (Expression[Index] = ' ') do
         inc (Index, 1);
     if Expression [Index] = '[' then
       while (Index <= Len) and (Expression[Index] = ' ') do
           inc (Index, 1);
     if Expression [Index] = ']' then
       while (Index <= Len) and (Expression[Index] = ' ') do
           inc (Index, 1);
     Say:= Expression[Index] = '"';
     while (Index <= Len) and (Say or (Expression[Index]<>#32)) do begin
        Temp:= Temp + Expression[Index];
        inc (Index, 1);
        if Expression[Index] = '"' then Say:= not Say
     end;
     NextToken:= Temp
  end;

function Expect (Tekst : string) : boolean;
  var
    Token : string;
  begin
    Token:= NextToken;
    Token:= UpString (Token);
    Tekst:= UpString (Tekst);
    if Token <> Tekst then begin
      Foutmelding:= true;
      Fouttekst:= Tekst + ' expected.';
      Expect:= false;
      exit;
    end
      else
        Expect:= true;
  end;

  procedure Shell;
    var Token : string;
    begin
      Token:= nexttoken;
      Token:= UpString (Token);
      Token:= ReplaceVariables (Token);
      Token:= EvaluateTekst0 (Token);
      exec (Token, '');
    end;

  var
    Escape : boolean;

procedure Invoer (X, Y : longint; var Tekst : string; FieldWidth : longint);
  var
    Len, c : longint;
    Ch     : char;
  begin
    Len:= length (Tekst);
    for c:= Len + 1 to FieldWidth do begin
      Tekst:= Tekst + ' ';
    end;
    Escape:= false;
    repeat
      textbackground (Paper);
      textcolor (Ink);
      gotoxy (X, Y);
      write (copy (Tekst, 1, FieldWidth));
      repeat
        gotoxy (X + Len, Y);
        write (#177#32);
        gotoxy (X + Len, Y);
        delay (37);
        gotoxy (X, Y);
        write (copy (Tekst, 1, FieldWidth));
        gotoxy (X + Len, Y);
        delay (47);
      until keypressed;
      Ch:= readkey;
      case Ch of
        #27: Escape:= true;
        #13:;
        #0: begin
          Ch:= readkey;
          case Ch of
            'K': if (Len > 0) then Len:= Len - 1;
            'M': if (Len < FieldWidth-1) then Len:= Len + 1;
            'G': Len:= 0;
            'O': begin
              Len:= FieldWidth;
              while (Tekst[Len] = #32) and (Len > 0) do dec (Len, 1);
            end;
            'S': begin
              Tekst:= Tekst + ' ';
              delete (Tekst, Len + 1, 1);
            end;
            else begin
              gotoxy (1, 1); write (Ch);
            end;
          end;
        end;
        #8: begin
          delete (Tekst, Len, 1);
          Tekst:= Tekst + ' ';
          if Len > 0 then Len:= Len - 1;
        end
        else begin
          if Len < FieldWidth - 1 then Len:= Len + 1;
          insert (Ch, Tekst, Len);
        end;
      end;
    until (Ch = #13) or Escape;
    Len:= FieldWidth;
    while (Tekst [length(Tekst)] = #32) do delete (Tekst, length(Tekst), 1);
  end;

function Preprocess (Tekst : string) : string;
  var
    c, c0, d, e : integer;
    Temp        : string;
    I           : integer;
  begin
    c:= 1;
    Tekst:= UpString (Tekst);
(*    while (pos(' ', Tekst) > 0) do delete (Tekst, pos (' ', Tekst), 1);
    for c:= 1 to TotalCommands do begin
      if pos (Com[c], Tekst) > 0 then
        insert (' ', Tekst, pos (Com[c], Tekst));
    end;
*)
    repeat
      if Tekst[c] = '[' then begin
        d:= c-1;
        e:= 0;
        while (d >= 1) and (Tekst[d] = ' ') do begin
          dec (d, 1);
          inc (e, 1);
        end;
        inc (d, 1);
        delete (Tekst, d, e);
        c:= c + e + 1;
      end;
      if Tekst[c] in [':', ',', ';', '='] then begin
        insert (' ', Tekst, c);
        inc (c, 2);
        insert (' ', Tekst, c);
      end;
      c:= c + 1;
    until c > length (Tekst);
    Preprocess:= Tekst;
  end;

procedure ExecuteCommand (Tekst : string);
  var
    Token, VarName, Tekst2 : string;
    Tekst3, Tekst4         : string;
    Tekst5, Tekst6         : string;
    FileName               : string;
    FileModus              : string;
    R                      : real;
    I,j                    : longint;
    Code                   : integer;
    eq, neq, st,gt, steq,
    gteq                   : integer;
    a,b,c,d                : integer;
    OldIndex               : integer;
    q                      : integer;
    KP                     : boolean;
    KPVAL                  : shortint;
  procedure Print (Tekstje : string);
    begin
        case (IsString(Tekstje)) of
          true: begin
            Tekstje:= ReplaceVariables (Tekstje);
            Tekstje:= EvaluateTekst0 (Tekstje);
            directvideo:= false;
            if (Screen = IsText) then textcolor (Ink) else setcolor (Paper);
            CursorX:= wherex;
            CursorY:= wherey;
            gotoxy (CursorX, CursorY);
            write (Tekstje, ' ');
            CursorX:= wherex;
            CursorY:= wherey;
          end;
          false: begin
            Tekstje:= UpString (Tekstje);
            Tekstje:= ReplaceVariables (Tekstje);
            R:= Evaluate (Tekstje);
            directvideo:= false;
            if (Screen = IsText) then textcolor (Ink) else setcolor (Paper);
            gotoxy (CursorX, CursorY);
            if R = round (R) then
              write (R : 7 : 0) else
                write (R : 7 : 5);
            write (' ');
            CursorX:= wherex;
            CursorY:= wherey;
          end;
        end;
    end;
  begin
    Expression:= Preprocess (Tekst);
    Index:= 1;
    Token:= NextToken;
    while (Token <> '') do begin
      CursorX:= wherex;
      CursorY:= wherey;
      KP:= keypressed;
      if KP then begin
        KPVAL:= 1;
        CH:= readkey;
      end else KPVAL:= 0;
      SaveVariable ('INKEY$', CH);
      str (KPVAL, Tekst2);
      SaveVariable ('KEYPRESSED', Tekst2);
      if Token = ':' then begin end
      else
      if (Token = 'RANDOMISE') or (Token = 'RANDOMIZE') then
        randomize
      else
      if Token = 'OPEN' then begin
        FileName:= '';
        repeat
          Token:= NextToken;
          FileName:= FileName + Token;
        until (Token = 'FOR') or (Token = '');
        if Token = '' then begin
          FoutMelding:= true;
          FoutTekst:= 'FOR INPUT or FOR OUTPUT expected in file open statement';
          exit;
        end;
        FileName:= ReplaceVariables (FileName);
        FileName:= EvaluateTekst0 (FileName);
        FileModus:= NextToken;
        if not expect ('AS') then begin
          FoutMelding:= true;
          FoutTekst:= 'Error: open file as what number (  0 ---> 47  )?';
          exit;
        end;
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until Token = '';
        I:= round (Evaluate (Tekst2));
        if (I < 0) or (I > MAX_FILES) then begin
          FoutMelding:= true;
          FoutTekst:= 'File number for opening files must be in the range 0 ---> 47';
          exit;
        end;
        case FMODE[I] of
          'R': begin
            FoutTekst:= 'file '+FileName+' already open for reading';
            FoutMelding:= true;
            exit;
          end;
          'W': begin
            FoutTekst:= 'file '+FileName+' already open for writing';
            FoutMelding:= true;
            exit;
          end;
        end;
        assign (AFILE[I], FileName);
        if FileModus = 'INPUT' then begin
          reset (AFILE[I]);
          if ioresult <> 0 then begin
            writeln ('Error opening file');
            exit;
          end;
          FMODE [I]:= 'R';
        end else
          begin
            rewrite (AFILE[I]);
            if ioresult <> 0 then begin
              writeln ('Error opening file');
              exit;
            end;
            FMODE [I]:= 'W';
          end;
      end else
      if Token = 'CLOSE' then begin
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until Token = '';
        I:= round (Evaluate (Tekst2));
        if (I < 0) or (I > MAX_FILES) then begin
          FoutMelding:= true;
          FoutTekst:= 'File number for closing files must be in the range 0 ---> 47';
          exit;
        end;
        close (AFILE[I]);
        FMODE[I]:= 'C';
      end else
      if Token = 'READ' then begin
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = ',') or (Token = '');
        if Token = ',' then delete (Tekst2, length(Tekst2), 1);
        I:= round (Evaluate (Tekst2));
        if (I < 0) or (I > MAX_FILES) then begin
          FoutMelding:= true;
          FoutTekst:= 'File number for reading a file must be in the range 0 ---> 47';
          exit;
        end;
        if FMode [I] <> 'R' then begin
          FoutMelding:= true;
          str (I, Tekst3);
          FoutTekst:= 'File with number '+Tekst3+' not open for reading';
          exit;
        end;
        VarName:= NextToken;
        if pos ('$', VarName) > 0 then begin
          readln (AFILE[I], Tekst2);
          SaveVariable (VarName, Tekst2);
        end
          else begin
            readln (AFILE[I], R);
            str (R, Tekst2);
            SaveVariable (VarName, Tekst2);
          end;
      end else
      if Token = 'WRITE' then begin
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = ',') or (Token = '');
        if Token = ',' then delete (Tekst2, length(Tekst2), 1);
        I:= round (Evaluate (Tekst2));
        if (I < 0) or (I > MAX_FILES) then begin
          FoutMelding:= true;
          FoutTekst:= 'File number for writing to a file must be in the range 0 ---> 47';
          exit;
        end;
        if FMode [I] <> 'W' then begin
          FoutMelding:= true;
          str (I, Tekst3);
          FoutTekst:= 'File with number '+Tekst3+' not open for writing to';
          exit;
        end;
        VarName:= NextToken;
        if pos ('$', VarName) > 0 then begin
          Tekst2:= LoadVariable (VarName);
          writeln (AFILE[I], Tekst2);
        end
          else begin
            Tekst2:= LoadVariable (VarName);
            R:= Evaluate (Tekst2);
            writeln (AFILE[I], R);
          end;
      end else
      if Token = 'SHELL' then
        Shell else
      if Token = 'CLS' then
        Cls
      else
      if Token = 'INK' then begin
        Token:= NextToken;
        Token:= UpString (Token);
        Token:= ReplaceVariables (Token);
        I:= round (Evaluate (Token));
        Ink:= I mod 16;
        if Screen = IsText then textcolor (I) else setcolor (I);
      end else
      if Token = 'PAPER' then begin
        Token:= NextToken;
        Token:= UpString (Token);
        Token:= ReplaceVariables (Token);
        I:= round (Evaluate (Token));
        Paper:= I mod 16;
        if Screen = IsText then textbackground (I) else setbkcolor (I);
      end else
      if Token = 'DIM' then begin
        VarName:= NextToken;
        VarName:= UpString (VarName);
        if not expect ('[') then exit;
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = ']') or (Token = '');
        if Tekst2[length(Tekst2)] = ']' then
          delete (Tekst2, length (Tekst2), 1);
        Dim (VarName, Round (Evaluate (Tekst2)));
      end else
      if Token = 'PRINT' then begin
        Tekst2:= '';
        Tekst3:= '';
        Tekst4:= '';
        Tekst5:= '';
        Tekst6:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = '') or (Token = ';');
        if Token = ';' then begin
          delete (Tekst2, length (Tekst2), 1);
          repeat
            Token:= NextToken;
            Tekst3:= Tekst3 + Token;
          until (Token = '') or (Token = ';');
        end;
        if Token = ';' then begin
          delete (Tekst3, length (Tekst3), 1);
          repeat
            Token:= NextToken;
            Tekst4:= Tekst4 + Token;
          until (Token = '') or (Token = ';');
        end;
        if Token = ';' then begin
          delete (Tekst4, length (Tekst4), 1);
          repeat
            Token:= NextToken;
            Tekst5:= Tekst5 + Token;
          until (Token = '') or (Token = ';');
        end;
        if Token = ';' then begin
          delete (Tekst5, length (Tekst5), 1);
          repeat
            Token:= NextToken;
            Tekst6:= Tekst6 + Token;
          until (Token = '') or (Token = ';');
        end;
        if Token = ';' then
          delete (Tekst6, pos (';', Tekst4), 255);
        if Tekst2 = '' then begin
           directvideo:= false;
           CursorX:= wherex;
           CursorY:= wherey;
           gotoxy (CursorX, CursorY);
           writeln;
           CursorX:= wherex;
           CursorY:= wherey;
        end else begin
          Print (Tekst2);
          if Tekst3 <> '' then Print (Tekst3);
          if Tekst4 <> '' then Print (Tekst4);
          if Tekst5 <> '' then Print (Tekst5);
          if Tekst6 <> '' then Print (Tekst6);
          writeln;
          CursorX:= wherex;
          CursorY:= wherey;
        end;
(*        directvideo:= false;
        writeln;
*)
      end
      else
      if Token = 'LET' then begin
        VarName:= NextToken;
        if pos ('[', VarName) > 0 then
          VarName:= copy (VarName,1,pos('[', VarName)-1)+
            ReplaceVariables0 (copy (VarName, pos('[', VarName), 255));
        if not Expect ('=') then exit;
        VarName:= UpString (VarName);
        while (pos (' ', VarName) > 0) do
          delete (VarName, pos (' ', VarName), 1);
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until Token = '';
        if Tekst2 = 'INKEY$' then begin
          SaveVariable (VarName, readkey);
          exit;
        end else
        if Tekst2 = 'RANDOM' then begin
          Tekst3:= '';
          repeat
            Token:= NextToken;
            Tekst3:= Tekst3 + Token;
          until (Token = '');
          str (random (round(Evaluate (Tekst3))) + OPTION_BASE, Tekst4);
          SaveVariable (VarName, Tekst4);
        end else
        case pos('$', VarName) of
          0: begin
            Tekst2:= UpString (Tekst2);
            Tekst2:= ReplaceVariables (Tekst2);
            R:= Evaluate (Tekst2);
            str (R, Tekst2);
            SaveVariable (VarName, Tekst2);
          end;
          else begin
            Tekst2:= UpString (Tekst2);
            Tekst2:= ReplaceVariables (Tekst2);
            Tekst2:= EvaluateTekst0 (Tekst2);
            SaveVariable (VarName, Tekst2);
          end;
        end;
      end else
      if Token = 'INPUT' then begin
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until Token = '';
        Tekst3:= Tekst2;
        if pos ('"', Tekst2) > 0 then begin
          delete (Tekst2, 1, pos ('"', Tekst2));
          delete (Tekst2, pos ('"', Tekst2), 255);
          directvideo:= false;
          write (Tekst2, ' ');
        end;
        VarName:= copy (Tekst3, pos(',', Tekst3)+1, 255);
        trim (VarName);
        VarName:= UpString (VarName);
        Tekst2:= '';
        directvideo:= false;
        Invoer (wherex, wherey, Tekst2, 80-wherex);
        if pos ('$', VarName) = 0 then begin
          R:= Evaluate (Tekst2);
          str (R, Tekst2);
          SaveVariable (VarName, Tekst2);
        end else begin
          SaveVariable (VarName, EvaluateTekst0(Tekst2));
        end;
        gotoxy (1, wherey+1);
      end else
      if Token = 'IF' then begin
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = 'THEN') or (Token = '');
        if (Token <> 'THEN') then begin
          FoutMelding:= true;
          FoutTekst:= 'THEN expected in IF construction';
          exit;
        end;
        delete (Tekst2, pos ('THEN', Tekst2), 255);
        Tekst3:= '';
        repeat
          Token:= NextToken;
          Tekst3:= Tekst3 + Token + ' ';
        until (Token = 'ELSE') or (Token = '');
        Tekst4:= '';
        if Token = 'ELSE' then begin
          delete (Tekst3, pos ('ELSE', Tekst3), 255);
          repeat
            Token:= NextToken;
            Tekst4:= Tekst4 + Token + ' ';
          until (Token = '');
        end;
        Tekst2:= UpString (Tekst2);
        while (pos(' ', Tekst2) > 0) do
          delete (Tekst2, pos (' ', Tekst2), 1);
        Tekst2:= ReplaceVariables (Tekst2);
        eq:= pos ('=', Tekst2);
        gt:= pos ('>', Tekst2);
        st:= pos ('<', Tekst2);
        gteq:= pos ('>=', Tekst2);
        steq:= pos ('<=', Tekst2);
        neq:= pos ('<>', Tekst2);
        if eq > 0 then begin
          Tekst5:= copy (Tekst2, 1, eq-1);
          Tekst6:= copy (Tekst2, eq+1, 255);
          case IsString (Tekst5) of
            true: begin
              if (EvaluateTekst0 (Tekst5) = EvaluateTekst0 (Tekst6)) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
            false: begin
              if Evaluate (Tekst5) = Evaluate (Tekst6) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
          end;
        end else
        if gt > 0 then begin
          Tekst5:= copy (Tekst2, 1, gt-1);
          Tekst6:= copy (Tekst2, gt+1, 255);
          case IsString (Tekst5) of
            true: begin
              if (EvaluateTekst0 (Tekst5) > EvaluateTekst0 (Tekst6)) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
            false: begin
              if Evaluate (Tekst5) > Evaluate (Tekst6) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
          end;

        end else
        if Token = 'ONKEY' then if keypressed then begin
          Tekst2:= '';
          repeat
            Token:= NextToken;
            Tekst2:= Tekst2 + Token;
          until (Token = '');
          ExecuteCommand (Tekst2);
        end else
        if st > 0 then begin
          Tekst5:= copy (Tekst2, 1, st-1);
          Tekst6:= copy (Tekst2, st+1, 255);
          case IsString (Tekst5) of
            true: begin
              if (EvaluateTekst0 (Tekst5) < EvaluateTekst0 (Tekst6)) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
            false: begin
              if Evaluate (Tekst5) < Evaluate (Tekst6) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
          end;

        end else
        if gteq > 0 then begin
          Tekst5:= copy (Tekst2, 1, gteq-1);
          Tekst6:= copy (Tekst2, gteq+2, 255);
          case IsString (Tekst5) of
            true: begin
              if (EvaluateTekst0 (Tekst5)>= EvaluateTekst0 (Tekst6)) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
            false: begin
              if Evaluate (Tekst5)>= Evaluate (Tekst6) then begin
                Executecommand (Tekst3);

              end else begin
                Executecommand (Tekst4);
              end;
            end;
          end;

        end else
        if steq > 0 then begin
          Tekst5:= copy (Tekst2, 1, steq-1);
          Tekst6:= copy (Tekst2, steq+2, 255);
          case IsString (Tekst5) of
            true: begin
              if (EvaluateTekst0 (Tekst5)<= EvaluateTekst0 (Tekst6)) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
            false: begin
              if Evaluate (Tekst5)<= Evaluate (Tekst6) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
          end;

        end else
        if neq > 0 then begin
          Tekst5:= copy (Tekst2, 1, neq-1);
          Tekst6:= copy (Tekst2, neq+2, 255);
          case IsString (Tekst5) of
            true: begin
              if (EvaluateTekst0 (Tekst5)<> EvaluateTekst0 (Tekst6)) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
            false: begin
              if Evaluate (Tekst5)<> Evaluate (Tekst6) then begin
                Executecommand (Tekst3);
              end else begin
                Executecommand (Tekst4);
              end;
            end;
          end;

        end;
      end else
      if Token = 'SCREEN' then begin
        Tekst2:= NextToken;
        Tekst2:= UpString (Tekst2);
        Tekst2:= ReplaceVariables (Tekst2);
        I:= round (Evaluate (Tekst2));
        case I of
          3: begin
            textmode (co80);
            textbackground (Paper);
            textcolor (Ink);
            clrscr;
            Screen:= IsText;
          end;
          11: begin
            Set2VgaHi;
            cleardevice;
            Screen:= IsVgaHi;
          end;
        end;
      end else
      if Token = 'BEEP' then begin
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = '') or (Token = ',');
        if Token = ',' then
          delete (Tekst2, length(Tekst2), 1);
        Tekst3:= '';
        repeat
          Token:= NextToken;
          Tekst3:= Tekst3 + Token;
        until (Token = '');
        Tekst2:= ReplaceVariables (Tekst2);
        I:= round (Evaluate (Tekst2));
        Tekst3:= ReplaceVariables (Tekst3);
        J:= round (Evaluate (Tekst3));
        sound (I);
        delay (J);
        nosound;

      end else
      if Token = 'FOR' then begin
{        VarName:= NextToken;
        if ForLoopIndex < MAX_FOR_LOOPS then begin

        end;
}
      end else
      if Token = 'NEXT' then begin

      end else
      if Token = 'GOSUB' then begin

      end else
      if Token = 'RETURN' then begin

      end else
      if Token = 'LINE' then begin
        Tekst2:= '';
        Tekst3:= '';
        Tekst4:= '';
        Tekst5:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = '') or (Token = ',');
        if Token = ',' then begin
          delete (Tekst2, length (Tekst2), 1);
          repeat
            Token:= NextToken;
            Tekst3:= Tekst3 + Token;
          until (Token = '') or (Token = ',');
        end;
        if Token = ',' then begin
          delete (Tekst3, length (Tekst3), 1);
          repeat
            Token:= NextToken;
            Tekst4:= Tekst4 + Token;
          until (Token = '') or (Token = ',');
        end;
        if Token = ',' then begin
          delete (Tekst4, length (Tekst4), 1);
          repeat
            Token:= NextToken;
            Tekst5:= Tekst5 + Token;
          until (Token = '') or (Token = ',');
        end;
        Tekst2:= ReplaceVariables (Tekst2);
        Tekst3:= ReplaceVariables (Tekst3);
        Tekst4:= ReplaceVariables (Tekst4);
        Tekst5:= ReplaceVariables (Tekst5);
        a:= round (Evaluate (Tekst2));
        b:= round (Evaluate (Tekst3));
        c:= round (Evaluate (Tekst4));
        d:= round (Evaluate (Tekst5));
        if Screen = IsVgaHi then begin
          setcolor (Ink);
          Line (a,b, c,d);
        end;
      end;
      if Token = 'RECTANGLE' then begin
        Tekst2:= '';
        Tekst3:= '';
        Tekst4:= '';
        Tekst5:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = '') or (Token = ',');
        if Token = ',' then begin
          delete (Tekst2, length (Tekst2), 1);
          repeat
            Token:= NextToken;
            Tekst3:= Tekst3 + Token;
          until (Token = '') or (Token = ',');
        end;
        if Token = ',' then begin
          delete (Tekst3, length (Tekst3), 1);
          repeat
            Token:= NextToken;
            Tekst4:= Tekst4 + Token;
          until (Token = '') or (Token = ',');
        end;
        if Token = ',' then begin
          delete (Tekst4, length (Tekst4), 1);
          repeat
            Token:= NextToken;
            Tekst5:= Tekst5 + Token;
          until (Token = '') or (Token = ',');
        end;
        Tekst2:= ReplaceVariables (Tekst2);
        Tekst3:= ReplaceVariables (Tekst3);
        Tekst4:= ReplaceVariables (Tekst4);
        Tekst5:= ReplaceVariables (Tekst5);
        a:= round (Evaluate (Tekst2));
        b:= round (Evaluate (Tekst3));
        c:= round (Evaluate (Tekst4));
        d:= round (Evaluate (Tekst5));
        if Screen = IsVgaHi then begin
          setcolor (Ink);
          Rectangle (a,b, c,d);
        end;
      end;
      if Token = 'CIRCLE' then begin
        Tekst2:= '';
        Tekst3:= '';
        Tekst4:= '';
        Tekst5:= '';
        Tekst6:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = '') or (Token = ',');
        if Token = ',' then begin
          delete (Tekst2, length (Tekst2), 1);
          repeat
            Token:= NextToken;
            Tekst3:= Tekst3 + Token;
          until (Token = '') or (Token = ',');
        end;
        if Token = ',' then begin
          delete (Tekst3, length (Tekst3), 1);
          repeat
            Token:= NextToken;
            Tekst4:= Tekst4 + Token;
          until (Token = '') or (Token = ',');
        end;
        Tekst2:= ReplaceVariables (Tekst2);
        Tekst3:= ReplaceVariables (Tekst3);
        Tekst4:= ReplaceVariables (Tekst4);

        a:= round (Evaluate(Tekst2));
        b:= round (Evaluate(Tekst3));
        c:= round (Evaluate(Tekst4));
        If Screen = IsVGAHi then begin
          setcolor (Ink);
          Circle (a, b, c);
        end;
      end;
      if (Token = 'POINT') or (Token = 'PIXEL') then begin
        Tekst2:= '';
        Tekst3:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = '') or (Token = ',');
        if Token = ',' then begin
          delete (Tekst2, length (Tekst2), 1);
          repeat
            Token:= NextToken;
            Tekst3:= Tekst3 + Token;
          until (Token = '') or (Token = ',');
        end;
        if Token = ',' then begin
          delete (Tekst3, length (Tekst3), 1);
        end;
        Tekst2:= ReplaceVariables (Tekst2);
        Tekst3:= ReplaceVariables (Tekst3);
        a:= round (Evaluate(Tekst2));
        b:= round (Evaluate(Tekst3));
        If Screen = IsVGAHi then begin
          setcolor (Ink);
          Line (a, b, a, b);
        end;
      end;
      if (Token = 'GOTOXY') then begin
        Tekst2:= '';
        Tekst3:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until (Token = '') or (Token = ',');
        if Token = ',' then begin
          delete (Tekst2, length (Tekst2), 1);
          repeat
            Token:= NextToken;
            Tekst3:= Tekst3 + Token;
          until (Token = '') or (Token = ',');
        end;
        if Token = ',' then begin
          delete (Tekst3, length (Tekst3), 1);
        end;
        Tekst2:= ReplaceVariables (Tekst2);
        Tekst3:= ReplaceVariables (Tekst3);
        a:= round (Evaluate(Tekst2));
        b:= round (Evaluate(Tekst3));
        directvideo:= false;
        CursorX:= a;
        CursorY:= b;
        gotoxy (a, b);
      end;
      if (Token = 'STOP') or (Token = 'END') then begin
        STOP:= true;
        RestoreDosScreen;
        halt (0);
      end
      else
{      if Token = 'GOTO' then begin
        Tekst2:= '';
        repeat
          Token:= NextToken;
          Tekst2:= Tekst2 + Token;
        until Token = '';
        Tekst2:= UpString (Tekst2);
        Tekst2:= ReplaceVariables (Tekst2);
        I:= round (Evaluate (Tekst2));
        ProgramCounter:= ((I-1) div 10) - 100;
      end;
}
(*      if FoutMelding then begin
        RestoreDosScreen;
        textcolor (red);
        writeln (FoutTekst);
        halt (0);
      end;
*)
      Token:= NextToken;
    end;
  end;

{
procedure ExecuteProgram;
  begin
    Clear;
    ProgramCounter:= 0;
    repeat
      ExecuteCommand (TheProgram[ProgramCounter]^);
      inc (ProgramCounter, 1);
    until STOP or (ProgramCounter > MAX_PROGRAM_SIZE) or
      (ProgramCounter < 0) or FoutMelding;
  end;
}

begin
  textcolor (LightCyan);
  write ('M');
  textcolor (brown);
  write ('ade with ');
  textcolor (lightgreen);
  write ('U');
  textcolor (yellow);
  write ('ltra ');
  textcolor (magenta);
  write ('B');
  textcolor (yellow);
  write ('asic ');
  textcolor (white);
  write ('Version ');
  textcolor (lightgray);
  writeln ('1.0');
  writeln;
  writeln ('(c) Copyright: la ligne de la Belgique++');
  writeln ('(c) Copyright: de Belgen: ('#1'''ennen '#0, '.');
  writeln ('(c) Benelux gefabricierte Gemachtigung');
  writeln;
  SaveDosScreen;
  textmode (co80);
  textbackground (black);
  textcolor (lightgray);
  clrscr;
  nosound;
(*  registerbgidriver (@EGAVGADriver);*)
  new (AVar);
  Clear;

  EXECUTECOMMAND ('SCREEN VGAHI');
  EXECUTECOMMAND ('');
  EXECUTECOMMAND ('');
  EXECUTECOMMAND ('LINE 0 , 433 , 311 , 407');
  EXECUTECOMMAND ('LINE 311 , 407 , 639 , 411');
  EXECUTECOMMAND ('LET OUDEI = 6');
FOR ForLoopIndex:= 7 TO 57 DO BEGIN
  str (ForLoopIndex, ForLoopIndexStr);
  SaveVariable ('INDEX', ForLoopIndexStr);
    EXECUTECOMMAND ('INK 0');
    EXECUTECOMMAND ('CIRCLE 0 , 0 , OUDEI');
    EXECUTECOMMAND ('INK 7');
    EXECUTECOMMAND ('CIRCLE 0 , 0 , INDEX');
    EXECUTECOMMAND ('BEEP 0 , 37');
    EXECUTECOMMAND ('LET OUDEI = INDEX-1');
  inc (ForLoopIndex, 0);
END;
  EXECUTECOMMAND ('LET KEY$ = INKEY$');
  EXECUTECOMMAND ('SCREEN TEXT');
  EXECUTECOMMAND ('');
  EXECUTECOMMAND ('');
  EXECUTECOMMAND ('');
  EXECUTECOMMAND ('');
  EXECUTECOMMAND ('');

END.
