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

{
ML>p.p.s  I also need a routine (preferably in Turbo Pascal 7 ASM) that saves t
ML>       content of the current screen in an ANSI file on the disk.  I saw one
ML>       a while ago in SWAG, but I can't seem to find it now (I'm a dist site
ML>       but still can't find it).

Also, since I didn't have anything better to do, I sat down and did a
version of your screen->ANSI.  It's rather primitive... it does a 80x24
dump with auto-EOLn seensing, does no CRLF if the line is 80 chars long
(relies on screen wrap) and no macroing. If you want to, you can add
macroing, which replaces a number of spaces with a single ANSI 'set
cursor' command. Well, here goes...

=================================================================== }

  Procedure Xlate(var OutFile : text); {by Erik Anderson}
  {The screen is basically an array of elements, each element containing one
   a one-byte character and a one-byte color attribute}
  const
    NUMROWS = 25;
    NUMCOLS = 80;
  type
    ElementType = record
                    ch   : char;
                    Attr : byte;
                  end;
    ScreenType = array[1..NUMROWS,1..NUMCOLS] of ElementType;

  {The Attribute is structured as follows:
    bit 0: foreground blue element
    bit 1:     "      green element
    bit 2:     "      red element
    bit 3: high intensity flag
    bit 4: background blue element
    bit 5:     "      green element
    bit 6:     "      red element
    bit 7: flash flag

  The following constant masks help the program acess different parts
  of the attribute}
  const
    TextMask = $07; {0000 0111}
    BoldMask = $08; {0000 1000}
    BackMask = $70; {0111 0000}
    FlshMask = $80; {1000 0000}
    BackShft = 4;

    ESC = #$1B;

  {ANSI colors are not the same as IBM colors... this table fixes the
   discrepancy:}
    ANSIcolors : array[0..7] of byte = (0, 4, 2, 6, 1, 5, 3, 7);

    {This procedure sends the new attribute to the ANSI dump file}
    Procedure ChangeAttr(var Outfile : text; var OldAtr : byte; NewAtr : byte);
    var
      Connect : string[1]; {Is a seperator needed?}
    begin
      Connect := '';
      write(Outfile, ESC, '['); {Begin sequence}
      If (OldAtr AND (BoldMask+FlshMask)) <>     {Output flash & blink}
         (NewAtr AND (BoldMask+FlshMask)) then begin
        write(Outfile, '0');
        If NewAtr AND BoldMask <> 0 then write(Outfile, ';1');
        If NewAtr AND FlshMask <> 0 then write(Outfile, ';5');
        OldAtr := $FF; Connect := ';';   {Force other attr's to print}
      end;

      If OldAtr AND BackMask <> NewAtr AND BackMask then begin
        write(OutFile, Connect,
              ANSIcolors[(NewAtr AND BackMask) shr BackShft] + 40);
        Connect := ';';
      end;

      If OldAtr AND TextMask <> NewAtr AND TextMask then begin
        write(OutFile, Connect,
              ANSIcolors[NewAtr AND TextMask] + 30);
      end;

      write(outfile, 'm'); {Terminate sequence}
      OldAtr := NewAtr;
    end;

    {Does this character need a changing of the attribute?  If it is a space,
     then only the background color matters}

    Function AttrChanged(Attr : byte; ThisEl : ElementType) : boolean;
    var
      Result : boolean;
    begin
      Result := FALSE;
      If ThisEl.ch = ' ' then begin
        If ThisEl.Attr AND BackMask <> Attr AND BackMask then
          Result := TRUE;
      end else begin
        If ThisEl.Attr <> Attr then Result := TRUE;
      end;
      AttrChanged := Result;
    end;

  var
    Screen   : ScreenType absolute $b800:0000;
    ThisAttr, TestAttr : byte;
    LoopRow, LoopCol, LineLen : integer;
  begin {Xlate}
    ThisAttr := $FF; {Force attribute to be set}
    For LoopRow := 1 to NUMROWS do begin

      LineLen := NUMCOLS;   {Find length of line}
      While (LineLen > 0) and (Screen[LoopRow, LineLen].ch = ' ')
            and not AttrChanged($00, Screen[LoopRow, LineLen])
        do Dec(LineLen);

      For LoopCol := 1 to LineLen do begin {Send stream to file}
        If AttrChanged(ThisAttr, Screen[LoopRow, LoopCol])
          then ChangeAttr(Outfile, ThisAttr, Screen[LoopRow, LoopCol].Attr);
        write(Outfile, Screen[LoopRow, LoopCol].ch);
      end;
    If LineLen < 80 then writeln(OutFile); {else wraparound occurs}
    end;
  end; {Xlate}

var
  OutFile : text;
begin
  Assign(OutFile, 'dump.scn');
  Rewrite(OutFile);
  Xlate(OUtFile);
  Close(OUtFile);
end.

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