{$i-}

program TurboForthCompiler (input, output);

uses
  crt;

var
  T               : text;
  Tekst, Tekst2   : string;
  Line            : string;
  F,F2            : file;
  B               : byte;
  c               : longint;
  x, y            : longint;
  q               : longint;
  Lijntje         : string;
  Buffer          : array[-1..2777 + 7] of shortint;
  Size            : longint;
  MyPath          : string;
  UsageEXE        : string;

begin
  nosound;
  if paramcount < 1 then begin
    writeln;
    textcolor (lightred);
    writeln ('Turbo Forth "Lazy Nop Technologies t/m" Command Line Compiler');
    writeln ('This program makes an exe-file from your Turbo Forth source code');
    writeln;
    textcolor (lightgreen);
    writeln ('This program uses "RUNFORTH.TFL", turbo forth runtime library');
    textcolor (green);
    writeln (', but your EXE-files won''t require the "RUNFORTH.TFL" library');
    writeln;
    textcolor (white);
    UsageEXE:= paramstr(0);
    getdir (0, MyPath);
    if copy (UsageExe, 1, length (MyPath)+1) = MyPath + '\' then begin
      delete (UsageExe, 1, length(MyPath)+1);
    end;
    writeln ('Usage: ', UsageEXE, ' <Turbo_Forth_text_source_code_file>[.4TH]');
    writeln;
    textcolor (green);
    writeln ('A special thanks goes out to the unknown soldier for yesterday''s papers');
    textcolor (lightgray);
    halt (23)
  end;
  textcolor (yellow);
  Tekst:= paramstr (1);
  if pos ('.', Tekst) = 0 then Tekst:= concat (Tekst, '.4TH');
  Tekst2:= copy (Tekst, 1, pos ('.', Tekst)-1) + '.EXE';
  writeln ('Compiling: ', Tekst, ' ... .... ...');
  assign (T, Tekst);
  reset (T);
  if ioresult <> 0 then begin
    writeln;
    textcolor (red);
    writeln ('Error: ', Tekst, ' not found.');
    writeln;
    textcolor (lightgray);
    halt (25);
  end;
  assign (F, 'RUNFORTH.TFL');
  reset (F, 1);
  Size:= filesize (F);
  if ioresult <> 0 then begin
    writeln;
    textcolor (red);
    writeln ('Error: ', ' "RUNFORTH.TFL" - library not found.');
    writeln;
    textcolor (lightgray);
    halt (27);
  end;
  assign (F2, Tekst2);
  rewrite (F2, 1);
  for c:= 1 to Size div 2777 do begin
    blockread (F, Buffer[0], 2777);
    blockwrite (F2, Buffer[0], 2777);
  end;
  Size:= Size mod 2777;
  blockread (F, Buffer[0], Size);
  blockwrite (F2, Buffer[0], Size);
  close (F);
  fillchar (Lijntje[1], 255, 32);
  Lijntje[0]:= char (255);
  x:= wherex;
  y:= wherey;
  readln (T, Line);
  c:= 1;
  while not eof (T) do begin
    gotoxy (x, y);
    write ('Compiling line: ', c : 7);
{    for q:= length(Line)+1 to 255 do Line:= Line + ' ';}
    Line:= Line + Lijntje;
    blockwrite (F2, Line[0], 256);
    readln (T, Line);
    inc (c, 1);
  end;
  gotoxy (x, y);
  write ('Compiling line: ', c : 7);
  for q:= length(Line)+1 to 255 do Line:= Line + ' ';
  blockwrite (F2, Line[0], 256);
  writeln;
  close (T);
  close (F2);
  textcolor (lightgray);
  writeln ('All done!');
  halt (0)
end.
+
+
+
+
