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

{
> 2: Writing ansi screens to directly to a file.

  2.  What exactly do you mean by writing ANSI screens to a file?
      Do you mean a text mode screen to the ANSI file format,
      or interpreting an ANSI file to a text mode screen?

    I have code that will save a textmode screen to an ANSI format
  text file by reading the text mode screen directly.  The code came
  from another discussion on saving text screens to ANSI files;
  the code is not mine.
}

PROGRAM Ansi_Save_Screen;
{*
 *  Save a color-screen in Ansi-format. Simple way, char by char: blanks
 *  not skipped.
 *}
Uses
  Dos;

PROCEDURE SaveANSI(Filename : PathStr);
CONST
  Esc      = #27;
  MaxCol   = 70;
  AnsiCols : array [0..7] of char = '04261537';

TYPE
  TCell = RECORD
    C : Char;
    A : byte;
  END;
  TScreen = array [1..25, 1..80] of TCell;

  ANSIATTR = record
    Bright : boolean;
    Blink  : boolean;
    FG     : byte;
    BG     : byte;
  end;

VAR
  Screen   : TSCreen ABSOLUTE $B800:$0000;
  F        : text;
  X, Y     : byte;
  s, s1    : String;
  AnsiLast,
  AnsiTmp  : ANSIATTR;

function WriteAttr(var Old, New : ANSIATTR) : string;
{ Write Attributes (ESC[..m) into a string }
var
  s : string;
begin
  WriteAttr := '';
  s := ESC + '[';
  if (not(New.Bright = Old.Bright)) or (not(New.Blink = Old.Blink)) then
  begin
    if (Not (New.Bright and New.Blink)) then
      s := s + '0;'
    else
    if (not New.Bright) and (New.Blink) then
    begin
      if Old.Bright then
        s := s + '0;5;'
      else
        s := s + '5;';
    end
    else
    if (New.Bright) and (not New.Blink) then
    begin
      if Old.Blink then
        s := s + '0;1;'
      else
        s := s + '1;';
    end
    else
    begin
      if not Old.Bright then
        s := s + '1;';
      if not Old.Blink then
        s := s + '5;';
    end;
  end;

  if (Old.FG <> New.FG) or ((not New.Bright) and Old.Bright) or
                           ((not New.Blink) and Old.Blink) then
  begin
    {*  I don't have no info why, but obviously backswitching to dark
     *  colorset, what has to be done via ^[0m, must turn fg/bg colors to
     *  37/40. However, we can optimize still then a bit !-. *}
    if not ( (New.FG=7) and ((not New.Bright) and Old.Bright) )
       then s:=s+'3'+AnsiCols[New.FG]+';';
  end;

  if (Old.BG<>New.BG) or ((not New.Bright) and Old.Bright) or
                         ((not New.Blink) and Old.Blink) then
  begin
    if not ( (New.BG=0) and ((not New.Bright) and Old.Bright) )
       then s:=s+'4'+AnsiCols[New.BG]+';';
  end;

  if s[length(s)]=';' then s[length(s)]:='m' else s:=s+'m';

  if length(s)>length(ESC+'[m') then WriteAttr:=s;
end;

BEGIN
  Assign(F, filename);
  Rewrite(F);

  AnsiTmp.FG := Screen[1, 1].A and 15;
  AnsiTmp.BG := Screen[1, 1].A SHR 4;
  AnsiTmp.Blink := (AnsiTmp.BG AND 8) = 8;
  AnsiTmp.Bright := (AnsiTmp.FG AND 8) = 8;
  AnsiTmp.FG:=AnsiTmp.FG and 7;
  AnsiTmp.BG:=AnsiTmp.BG and 7;

  s:=Esc+'[2J'+Esc+'[0m'+ESC+'[';
  if AnsiTmp.Bright then s:=s+'1;';
  if AnsiTmp.Blink then s:=s+'5;';
  s:=s+'3'+ansicols[AnsiTmp.FG]+';';
  s:=s+'4'+ansicols[AnsiTmp.BG]+'m';

  FOR Y := 1 TO 25 DO
    BEGIN
     FOR X := 1 TO 80 DO
       BEGIN
         AnsiLast:=AnsiTmp;

         AnsiTmp.FG := Screen[Y, X].A AND 15;
         AnsiTmp.BG := Screen[Y, X].A SHR 4;
         AnsiTmp.Bright := (AnsiTmp.FG AND 8)<>0;
         AnsiTmp.Blink := (AnsiTmp.BG AND 8)<>0;
         AnsiTmp.FG:=AnsiTmp.FG and 7;
         AnsiTmp.BG:=AnsiTmp.BG and 7;

         s1:=WriteAttr(AnsiLast, AnsiTmp);
         s1:=s1+Screen[Y, X].C;

         IF (length(s+s1+ESC+'[s')) <= MaxCol then s:=s+s1 else
         begin
           Write(F,s+ESC+'[s'+#13#10);
           s:=ESC+'[u'+s1;
         end;

       END;
    END;
    Write(F, Esc+'[0;37;40m');
    Close(F);
END;
BEGIN
  SaveANSI('test3.ans');
END.

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