[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]

    program FastANSI;

    {$R-,S-,B-,A-,F-,Q-,V-}

    {FAST!  Buffered ANSI viewer--almost good enough for someone who wants to
     view ANSI files without ever loading ANSI.SYS.

     Plusses:
       - Don't hafta load ANSI.SYS
       - SAFE:  Beeps if there's a key-redefine, and won't change the screen
                mode
       - Almost as fast as the real thing--the difference is probably not even
         noticed on a fast computer, except for with HUGE files.

     Minuses:
       - Takes up more disk space (but doesn't everything?  :-)
       - Still not as fast as the real thing.
       - Currently the code is a bit sloppy and probably hard to read
         (I can read it, but then I helped write it. . . .)
         * I've since given cleaner formatting to the code, but it's still
           a bit tough to read, and isn't fully commented.  The style is
           pretty dirty, and optimization could help it a lot.

     Yes, one of my *next* plans for this thing is to optimize, organize, and
     comment the source

     Coauthored by:  Ben Kimball (Kzinti@Platte.UNK.edu)
                     Scott Earnest (scott@whiplash.pc.cc.cmu.edu)
    }

    uses CRT, DOS;

    const
      IBMColor : array [0 .. 7] of byte =
        (0,4,2,6,1,5,3,7);
      Tone = 2500;
      Duration = 250;
      buflen = 2047;

    var  {EEEEK!--it's possible not all of these are used. . . .}
      ch, lastch, inqchar : char;
      f : file;
      Fileinfo : searchrec;
      bytesread : word;
      bufloc : word;
      ANSIbuf : array [0 .. buflen] of byte;
      FName : string[80];
      commandfetch, numsread : boolean;
      ANSIParam : array[1 .. 16] of string;
      index, ANSIPcount, loop, semicount : byte;
      blink, reverse, bold : boolean;
      tmpx, tmpy,
      savecurx, savecury,
      fgcolor, bgcolor : byte;
      vidpage : byte absolute $0000:0462;
      ncols : byte absolute $0000:$044a;
      nrows : byte;
      numbytes : longint;

    function value(st : string) : integer;

    Var
      dummy,v : integer;

    begin
      val (st,v,dummy);
      value := v;
    end;

    procedure outchar (ch : char);

    var
      xp, yp : byte;
      mp : word;

    begin
      xp := WhereX;
      yp := WhereY;
      case ch of
        #13 : exit;
        #10 : xp := ncols;
      else
        begin
          mp := ((yp-1)*ncols+xp-1)*2;
          mem[SegB800:mp] := ord(ch);
          mem[SegB800:mp+1] := textattr;
        end
      end;
      inc(xp);
      if xp > ncols then
        begin
          xp := 1;
          inc(yp);
        end;
      GotoXY (xp,yp);
    end;

    procedure inchar (var ch : char);

    begin
      if bufloc = 0 then
        BlockRead (f,ANSIbuf,buflen+1,bytesread);
      ch := chr(ANSIbuf[bufloc]);
      inc (bufloc);
      inc (numbytes);
      if (bufloc >= bytesread) then
        bufloc := 0;
    end;

    procedure execcode;

    begin
      Case Ch of
        'H','f' : {Cursor Position}
                  begin
                    case semicount of
                      0 : case ANSIPcount of
                            0 : GotoXY(1,1);
                          else
                            GotoXY(1,Value(ANSIParam[1]));
                          end;
                      1 : if value(ANSIParam[1]) = 0 then
                            GotoXY(Value(ANSIParam[2]),1)
                          else
                            GotoXY(Value(ANSIParam[2]),Value(ANSIParam[1]));
                    end;
                  end;

            'A' : {Cursor Up}
                  if ANSIPcount < 1 then
                    begin
                      if WhereY > 1 then
                        GotoXY(WhereX, WhereY - 1)
                    end
                  else
                    if WhereY - Value(ANSIParam[1]) < 1 then
                      GotoXY(WhereX, 1)
                    else
                      GotoXY(WhereX, WhereY - Value(ANSIParam[1]));

            'B' : {Cursor Down}
                  if ANSIPcount < 1 then
                    begin
                      if WhereY < nrows then
                        GotoXY(WhereX, WhereY + 1)
                    end
                  else
                    if WhereY + Value(ANSIParam[1]) > nrows then
                      GotoXY(WhereX, nrows)
                    else
                      GotoXY(WhereX, WhereY + Value(ANSIParam[1]));

            'C' : {Cursor Forward}
                  if ANSIPCount < 1 then
                    begin
                      if WhereX < ncols then
                        GotoXY(WhereX + 1, WhereY)
                    end
                  else
                    if WhereX + Value(ANSIParam[1]) > ncols then
                      GotoXY(ncols, WhereY)
                    else
                      GotoXY(WhereX + Value(ANSIParam[1]), WhereY);

            'D' : {Cursor Backward}
                  if ANSIPcount < 1 then
                    begin
                      if WhereX > 1 then
                        GotoXY(WhereX - 1, WhereY)
                    end
                  else
                    if WhereX - Value(ANSIParam[1]) < 1 then
                      GotoXY(1, WhereY)
                    else
                      GotoXY(WhereX - Value(ANSIParam[1]), WhereY);

            'p' : {Key-redefine}
                  begin
                    Sound (Tone);
                    Delay (Duration);
                    NoSound;
                  end;

            's' : {Save Cursor Position}
                  begin
                    SaveCurX := WhereX;
                    SaveCurY := WhereY;
                  end;

            'u' : {Restore Cursor Position}
                  GotoXY(SaveCurX, SaveCurY);

            'J' : {Erase Display (if ESC[2J ) }
                  ClrScr;

            'K' : {Erase Line}
                  ClrEol;

            'm' : {Set Graphics Mode}
                  for Loop := 1 to AnsiPCount do
                    case value(ANSIParam[Loop]) of
                             0 : {All Attributes Off}
                                 begin
                                   Blink   := false;
                                   Reverse := false;
                                   Bold    := false;
                                   TextAttr := $07;
                                   FGColor := 7;
                                   BGColor := 0;
                                 end;
                             1 : {Bold On}
                                 begin
                                   Bold := true;
                                   TextAttr := (TextAttr or $08);
                                 end;
                             4 : {Underscore - ignored};
                             5 : {Blink On}
                                 begin
                                   TextAttr := (TextAttr or $80);
                                   Blink := true;
                                 end;
                             7 : {Reverse Video}
                                 begin
                                   Reverse := true;
                                   if FGColor > 7 then
                                     FGColor := 8
                                   else FGColor := 0;
                                   BGColor := 7;
                                   TextColor(FGColor);
                                   TextBackGround(BGColor);
                                 end;

                      30 .. 37 : {Foreground}
                                 begin
                                   FGColor := IBMColor[Value(ANSIParam[Loop]) - 30];
                                   TextAttr := BGColor * 16 + FGColor;
                                   if blink then TextAttr := TextAttr or $80;
                                   if bold then TextAttr := TextAttr or $08;
                                 end;

                      40 .. 47 : {Background}
                                 begin
                                   BGColor := IBMColor[Value(ANSIParam[Loop]) - 40];
                                   TextAttr := BGColor * 16 + FGColor;
                                   if blink then TextAttr := TextAttr or $80;
                                   if bold then TextAttr := TextAttr or $08;
                                 end;
                    end; {Case}

      end; {Case}
    end;

    procedure readANSIdata;

    begin
      inchar (ch);
      case ch of
        '0' .. '9' : begin
                       ANSIParam[ANSIPcount] := ANSIParam[ANSIPcount] + ch;
                       numsread := true;
                     end;
               '"' : repeat
                       inchar (inqchar);
                     until inqchar = '"';
               ';' : begin
                       inc(ANSIPcount);
                       inc(semicount);
                     end;
      else
        begin
          if not numsread then ANSIPCount := 0;
          execcode;
          commandfetch := false;
        end;
      end;
      lastch := ch;
    end;

    procedure parseANSI;

    begin
      fillchar (ANSIParam, sizeof(ANSIParam), 0);
      ANSIPcount := 1;
      semicount := 0;
      commandfetch := true;
      numsread := false;
      repeat
        readANSIdata;
      until not commandfetch;
    end;

    begin
      nrows := mem[$0000:$0484] + 1;
      TextAttr := $0f;
      semicount := 0;
      SaveCurX   := 1;
      SaveCurY   := 1;
      Bold       := false;
      Blink      := false;
      Reverse    := false;
      ANSIPcount := 0; {No Params}
      FGColor    := 7; {Light Grey}
      BGColor    := 0; {Black}
      numsread := false;
      commandfetch := false;
      bufloc := 0;
      numbytes := 0;
      bytesread := 0;
      fillchar (ANSIbuf, sizeof(ANSIbuf), 0);
      if ParamStr(1) = '' then
        begin
          write ('Enter Filename: ');
          readln (FName);
        end
      else
        FName := ParamStr(1);
      findfirst (FName, AnyFile, fileinfo);
      if fileinfo.name = '' then
        begin
          writeln ('File not found.');
          halt;
        end;
      assign (F, FName);
      reset (F,1);
      clrscr;
      while (numbytes < fileinfo.size) do
        begin
          inchar (ch);
          if ch = #27 then
            begin
              lastch := ch;
              inchar (ch);
              if ch <> '[' then
                begin
                  outchar (lastch);
                  outchar (ch);
                end
              else {parse}
                parseANSI;
            end
          else
            outchar (ch);
        end;
      readln;
      close (f);
    end.

[Back to ANSI SWAG index] [Back to Main SWAG index] [Original]