__  _                        __ _                           _  __
  ______\ \_\\_______________________\///__________________________//_/ /______
  \___\                                                                   /___/
   | .__                                 __                                  |
   | |                   ___  __________/  |________                         |
   |                     \  \/  / ____/\   __\_  __ \                        |
   ;                      >    < <_|  | |  |  |  | \/                        ;
   :                     /__/\_ \__   | |__|  |__|                           :
   .                           \/  |__|                                      .
   .                                                                         .
   :           H/Q Another Droid BBS - andr01d.zapto.org:9999                :
   ;                                                                         ;
   + --- --  -   .     -        ---    ---    ---        -     .    - -- --- +
   :                                                                         :
   |                         FreePascal ANSI Viewer                          |
   :                                                                         :
   ` --- --  -   .     -        ---    ---    ---        -     .    - -- --- '
   
   One of the "musts" back then, was for a program to display ansi files,
   graphics. From then, many of us have forgotten how to do so and 
   others, because they use external tools, they think its easy. So lets 
   take a dive into programming and check the logic/algorithm on how to 
   manipulate ansi files.
   
   ANSI codes start with an ESCape char (d27) and end with a letter. So 
   in our code we have to check if we found an Escape char and read until 
   we find a valid ansi code letter/code. You can find many ansi codes in 
   this link: https://conemu.github.io/en/AnsiEscapeCodes.html
   We will use this document to "translate" ansi codes.
   
   So we begin by opening the file and reading it byte to byte. If we 
   encounter an escape char then we fill a string buffer, until we reach 
   a valid ansi code. If we don't find an escape, then we just display 
   the character.
   
   while (not eof(f)) and (done=false) do begin
     blockread(f,b,1);   // read file one byte at a time
     case b of
       #27: doesc;       // found ESC? process code
       #13: delay(d);    // Found end of line? add some delay to make the 
                         // ansi more easy to view
     else 
       write(b);         // plain char? then show it on screen
       lastch:=b;        // save the last char we display (for ansi code)
     end;
   end;
   
   All the work is done in the DOESC procedure. In here we will process 
   any ansi code and accordingly will show a character, move the cursor 
   etc. So lets see how this works.
   
    procedure doesc;
    var
      buf:string[255];
      j:byte;
    begin
      buf:='';
      blockread(f,b,1);                   // read the file and fill our 
      while length(buf)<255 do begin      // buffer until we reach a 
        blockread(f,b,1);                 // valid ansi code
        buf:=buf+b;                       
        if b in 
        
  // All these are valid ansi codes         
  ['m','J','H','f','A','B','C','D','u','s','K','@','F','E','G','X','b','d'] 
  
        then break;
      end;
      if length(buf)<1 then exit;
      cnt:=strwordcount(buf,';');       // Some ANSI codes have parameters
      c:=buf[length(buf)];              // We count how many we have,
      delete(buf,length(buf),1);        // store the code in C and clean
      case c of                         // the buffer from any code.
        'd': gotoline(buf);
        'b': repeatlastchar(buf);       // Read the link above to see what
        'X': erasechars(buf);           // commands do. The most important
        'm': ansicoloring(buf);         // is "m" which alters the colors
        'K': clearline(buf);
        'A': cursorup(buf);
        'B': cursordown(buf);
        'C': cursorright(buf);
        'D': cursorleft(buf);
        'E': linesdown(buf);
        'F': linesup(buf);
        'G': gotocol(buf);
    'f','H': cursormove(buf);
        's': begin
              savex:=wherex;
              savey:=wherey;
             end;
        'u' : gotoxy(savex,savey);
        '@' : insertspaces(buf);
        'J' : begin
                if str2int(strwordget(1,buf,';')) = 2 then ClrScr;
              End;
      end;
    end;   
   
   We use a CASE statement to check what command we have to parse and 
   execute its code. The parameters for some codes are in a format like:
   1;30;44. To get each parameter i use the StrWordGet command which is 	
   not the perfect way to do, but its more easy to understand. This 
   command will give as string between the semicolon ; that we ask for. 
   For example if we give strwordget(2,buffer,';') it will give us the 
   string 30, from the example above, which is a color code. This way we 
   have an easy way to get the parameters.
   
   From now on, its just "translating" what the ANSI command does, into 
   code. If for example we encounter a command that moves the cursor x 
   lines below, we parse this code and move the cursor with the GOTOXY 
   command. 
   
   The most "bizarre" command is "m" which changes the color to be 
   displayed and has many parameters and features. I am not going to 
   explain it here, cause it needs a whole article by its self.
   
   Grab the program below, compile it with FreePascal and you have an 
   easy ANSI viewer for your system. Don't forget to change the terminal 
   encoding to CP437 or a similar... it will not show correct in UTF8 
   terminals... which is also a subject for another article... enjoy!
   
   
   + --- --  -   .     -        ---    ---    ---        -     .    - -- --- '
           COMPLETE PROGRAM - COPY/PASTE and COMPILE with FREEPASCAL
   + --- --  -   .     -        ---    ---    ---        -     .    - -- --- '

program dispansi;
{$mode objfpc}{$H-}
uses crt,dos;

Function Str2Int (Str: String): LongInt;
Var
  N : LongInt;
  T : LongInt;
Begin
  Val(Str, T, N);
  Str2Int := T;
End;

Function Int2Str (N: LongInt): String;
Var
  T : String;
Begin
  Str(N, T);
  Int2Str := T;
End;

Function strWordCount (Str: String; Ch: Char) : Byte;
Var
  Start : Byte;
  Res   : Byte;
Begin
  Res := 0;

  If Ch = ' ' Then
    While Str[1] = Ch Do
      Delete (Str, 1, 1);

  If Str = '' Then Exit;

  Res := 1;

  While Pos(Ch, Str) > 0 Do Begin
    Inc (Res);

    Start := Pos(Ch, Str);

    If Ch = ' ' Then Begin
      While Str[Start] = Ch Do
        Delete (Str, Start, 1);
    End Else
      Delete (Str, Start, 1);
  End;
  strWordCount := Res;
End;

Function strWordGet (Num: Byte; Str: String; Ch: Char) : String;
Var
  Count : Byte;
  Temp  : String;
  Start : Byte;
Begin
  strWordGet := '';
  Count  := 1;
  Temp   := Str;
  
  If Pos(Ch,Str)<=0 Then Begin
    strWordGet:=str;
    Exit;
  End;

  If Ch = ' ' Then
    While Temp[1] = Ch Do
      Delete (Temp, 1, 1);

  While Count < Num Do Begin
    Start := Pos(Ch, Temp);

    If Start = 0 Then Exit;

    If Ch = ' ' Then Begin
      While Temp[Start] = Ch Do
        Inc (Start);

      Dec(Start);
    End;

    Delete (Temp, 1, Start);
    Inc    (Count);
  End;

  If Pos(Ch, Temp) > 0 Then
    strWordGet := Copy(Temp, 1, Pos(Ch, Temp) - 1)
  Else
    strWordGet := Temp;
End;

procedure dansi(fn:string;d:integer);
const
  AnsiColors: Array[0..7] of Integer = (0, 4, 2, 6, 1, 5, 3, 7);
var
  done:boolean;
  key:char;
  f:file;
  b:char;
  c:char;
  cnt:byte;
  savex:byte;
  savey:byte;
  lastch:char;
  
  procedure ansicoloring(s:string);
  var
    i:byte;
    cl:byte;
    w:byte;
    Colour:byte;
  begin
    for i:= 1 to cnt do begin
      w:=str2int(strwordget(i,s,';'));
      case w of
            0: TextAttr:=7;
            1: begin	
                 cl:=textattr mod 16;
                 if cl < 8 then cl:=cl+8;
                 textcolor(cl);
               end;
            7: TextAttr:= ((TextAttr and $70) shr 4) + ((TextAttr and $07) 
                          shl 4);
            8: TextAttr:= 0; { Video Off }
       30..37: Begin
                    Colour := AnsiColors[w - 30];
                    if (TextAttr mod 16 > 7) then
                       Inc(Colour, 8);
                    TextColor(Colour);
               End;
       40..47: TextBackground(AnsiColors[w - 40]);
       End;
    end;
  end;
  
  procedure linesdown(s:string);
  var
    y:byte;
  begin
    try
      y:=str2int(s);
    except
      y:=1;
    end;
    gotoxy(1,wherey+y);
  end;
  
  procedure linesup(s:string);
  var
    y:byte;
  begin
    try
      y:=str2int(s);
    except
      y:=1;
    end;
    gotoxy(1,wherey-y);
  end;
  
  procedure cursorup(s:string);
  var
    y:byte;
  begin
    try
      y:=str2int(s);
    except
      y:=1;
    end;
    gotoxy(wherex,wherey-y);
  end;
  
  procedure cursordown(s:string);
  var
    y:byte;
  begin
    try
      y:=str2int(s);
    except
      y:=1;
    end;
    gotoxy(wherex,wherey+y);
  end;
  
  procedure cursorleft(s:string);
  var
    x:byte;
  begin
    try
      x:=str2int(s);
    except
      x:=1;
    end;
    gotoxy(wherex-x,wherey);
  end;
  
  procedure cursorright(s:string);
  var
    x:byte;
  begin
    try
      x:=str2int(s);
    except
      x:=1;
    end;
    gotoxy(wherex+x,wherey);
  end;
  
  procedure gotocol(s:string);
  var
    x:byte;
  begin
    try
      x:=str2int(s);
    except
      x:=wherex;
    end;
    gotoxy(x,wherey);
  end;
  
  procedure cursormove(s:string);
  Begin
    gotoxy(str2int(strwordget(2,s,';')),str2int(strwordget(1,s,';')));
  End;
  
  procedure insertspaces(s:string);
  var
    j,a:byte;
  begin
    try
      a:=str2int(strwordget(1,s,';'));
    except
      a:=1;
    end;
    for j:=1 to a do write(' ');
  end;
  
  procedure clearline(s:string);
  var j,a:byte;
  begin
    try
      a:=str2int(strwordget(1,s,';'));
    except
      a:=0;
    end;
    case a of
      0: for j:=wherex to 80 do write(' ');
      1: for j:=1 to wherex do write(' ');	
      2: begin ClrEOL;Gotoxy(1,wherey);End;
    end;
  end;
  
  procedure erasechars(s:string);
  var
    j,a:byte;
  begin
    try
      a:=str2int(strwordget(1,s,';'));
    except
      a:=1;
    end;
    for j:=1 to a do write(' ');
  end;
  
  procedure repeatlastchar(s:string);
  var
    j,a:byte;
  begin
    try
      a:=str2int(strwordget(1,s,';'));
    except
      a:=1;
    end;
    for j:=1 to a do write(lastch);
  end;
  
  procedure gotoline(s:string);
  var
    j,a:byte;
  begin
    try
      a:=str2int(strwordget(1,s,';'));
    except
      a:=1;
    end;
    gotoxy(wherex,a);
  end;
  
  
  procedure doesc;
  var
    buf:string[255];
    j:byte;
  begin
    buf:='';
    blockread(f,b,1);
    while length(buf)<255 do begin
      blockread(f,b,1);
      buf:=buf+b;
      if b in 
      ['m','J','H','f','A','B','C','D','u','s','K','@','F','E','G','X','b','d'] 
      then break;
    end;
    if length(buf)<1 then exit;
    cnt:=strwordcount(buf,';');
    c:=buf[length(buf)];
    //writeln('C:> '+buf +'C: '+c);
    delete(buf,length(buf),1);
    //writeln(buf+'=='+int2str(cnt));
    case c of 
      'd': gotoline(buf);
      'b': repeatlastchar(buf);
      'X': erasechars(buf);
      'm': ansicoloring(buf);
      'K': clearline(buf);
      'A': cursorup(buf);
      'B': cursordown(buf);
      'C': cursorright(buf);
      'D': cursorleft(buf);
      'E': linesdown(buf);
      'F': linesup(buf);
      'G': gotocol(buf);
  'f','H': cursormove(buf);
      's': begin
            savex:=wherex;
            savey:=wherey;
           end;
      'u' : gotoxy(savex,savey);
      '@' : insertspaces(buf);
      'J' : begin
              if str2int(strwordget(1,buf,';')) = 2 then ClrScr;
            End;
    end;
  end;
  
  
begin
  savex:=1;
  savey:=1;
  assign(f,fn);
  reset(f,1);
  while (not eof(f)) and (done=false) do begin
    blockread(f,b,1);
    if keypressed then begin
      key:=readkey;
      Case key of
        '+' : d := d + 3;
        '-' : begin
                d := d - 3;
                if d<0 then d:=0;
              end;
        '*' : d := 20;
        '/' : d := 5;
        #27 : Done:=true;
      End;
    end;
    case b of
    #27: doesc;
    #13: delay(d);
    else 
        write(b);
        lastch:=b;
    end;
  end;
  close(f);
end;

begin
  dansi(paramstr(1),10);

end.

   + --- --  -   .     -        ---    ---    ---        -     .    - -- --- '
         _____         _   _              ____          _   _ 
        |  _  |___ ___| |_| |_ ___ ___   |    \ ___ ___|_|_| |        8888
        |     |   | . |  _|   | -_|  _|  |  |  |  _| . | | . |     8 888888 8
        |__|__|_|_|___|_| |_|_|___|_|    |____/|_| |___|_|___|     8888888888
                                                                   8888888888
                DoNt Be aNoTHeR DrOiD fOR tHe SySteM               88 8888 88
                                                                   8888888888
 /: HaM RaDiO   /: ANSi ARt!     /: MySTiC MoDS   /: DooRS         '88||||88'
 /: NeWS        /: WeATheR       /: FiLEs         /: SPooKNet       ''8888"'
 /: GaMeS       /: TeXtFiLeS     /: PrEPardNeSS   /: FsxNet            88
 /: TuTors      /: bOOkS/PdFs    /: SuRVaViLiSM   /: ArakNet    8 8 88888888888
                                                              888 8888][][][888
   TeLNeT : andr01d.zapto.org:9999 [UTC 11:00 - 20:00]          8 888888##88888
   SySoP  : xqtr                   eMAiL: xqtr@gmx.com          8 8888.####.888
   DoNaTe : https://paypal.me/xqtr                              8 8888##88##888

.