program Modemu1;
{$M 16384,0,655360}
uses Crt;

const
  FileName = 'kb-modemu1.ans';
  Rows     = 25;
  { ANSI colour numbers 0..7 mapped to VGA text attributes }
  AnsiToVga : array[0..7] of Byte = (0, 4, 2, 6, 1, 5, 3, 7);

var
  F      : file;
  Buf    : array[0..4095] of Char;
  Got    : Word;
  i      : Word;
  Ch     : Char;
  InEsc  : Boolean;
  Param  : array[0..7] of Word;
  NParam : Byte;
  Bold   : Boolean;
  Fg, Bg : Byte;
  Line   : Word;

procedure SetAttr;
var A : Byte;
begin
  A := AnsiToVga[Fg];
  if Bold then A := A + 8;
  TextAttr := A + (AnsiToVga[Bg] shl 4);
end;

procedure ApplySgr;
var k : Byte;
begin
  if NParam = 0 then begin Param[0] := 0; NParam := 1; end;
  for k := 0 to NParam - 1 do
    case Param[k] of
      0      : begin Bold := False; Fg := 7; Bg := 0; end;
      1      : Bold := True;
      30..37 : Fg := Param[k] - 30;
      40..47 : Bg := Param[k] - 40;
      90..97 : begin Fg := Param[k] - 90; Bold := True; end;
    end;
  SetAttr;
end;

procedure PageBreak;
begin
  Inc(Line);
  if Line mod (Rows - 1) = 0 then
  begin
    TextAttr := $70;
    Write('-- more --');
    if ReadKey = #27 then Halt;
    GotoXY(1, WhereY); ClrEol;
    SetAttr;
  end;
end;

begin
  TextMode(CO80);
  DirectVideo := True;
  ClrScr;
  Bold := False; Fg := 7; Bg := 0; SetAttr;
  Line := 0; InEsc := False; NParam := 0; Param[0] := 0;

  Assign(F, FileName);
  {$I-} Reset(F, 1); {$I+}
  if IOResult <> 0 then
  begin
    Writeln('Cannot open ', FileName);
    Halt(1);
  end;

  repeat
    BlockRead(F, Buf, SizeOf(Buf), Got);
    for i := 0 to Got - 1 do
    begin
      Ch := Buf[i];
      if Ch = #26 then Break;                      { SAUCE record follows }
      if InEsc then
      begin
        case Ch of
          '[' : ;
          '0'..'9' : Param[NParam] := Param[NParam] * 10 + Ord(Ch) - 48;
          ';' : begin Inc(NParam); Param[NParam] := 0; end;
          'm' : begin Inc(NParam); ApplySgr; InEsc := False; NParam := 0; Param[0] := 0; end;
        else
          begin InEsc := False; NParam := 0; Param[0] := 0; end;
        end;
      end
      else
        case Ch of
          #27 : InEsc := True;
          #13 : ;
          #10 : begin Writeln; PageBreak; end;
        else
          Write(Ch);
        end;
    end;
  until (Got = 0) or (Ch = #26);
  Close(F);

  TextAttr := $07;
  Writeln;
  Write('NetLock BBS  2:236/444  -  press any key');
  ReadKey;
  ClrScr;
end.
