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

{
> Now that I need to make a .ANS bulletin Type File, I was wondering
> how to Write from a Pascal Program, ANSI control Characters to a
> File and produce nice color bulletin screen to be displayed by RA.

The following Unit will enable you to Write Ansi sequences to a Text
File Without having to look them up yourself. It enables you to do this
using the (easier) Crt Unit style of commands, and provides the optimum
Ansi sequence to do the job.
}

Unit AnsiOut;
{1. Contains reduced set of Procedures from AnsiCrt Unit by I.Hinson.}
{2. Modified to provide output to a Text File.}

Interface

Const Black = 0;     Blue = 1;          Green = 2;       Cyan = 3;
      Red =   4;     Magenta = 5;       Brown = 6;       LightGray = 7;
      DarkGray = 8;  LightBlue = 9;     LightGreen = 10; LightCyan = 11;
      LightRed = 12; LightMagenta = 13; Yellow = 14;     White = 15;
      Blink = 128;

Var AnsiFile: Text;

Procedure TextColor(fore : Byte);
Procedure TextBackGround(back : Byte);
Procedure NormVideo;
Procedure LowVideo;
Procedure HighVideo;
Procedure ClrEol;
Procedure ClrScr;

Implementation

Const forestr: Array[Black..LightGray] of String[2]
               = ('30','34','32','36','31','35','33','37');
      backstr: Array[Black..LightGray] of String[2]
               = ('40','44','42','46','41','45','43','47');
      decisiontree: Array[Boolean, Boolean, Boolean, Boolean] of Integer =
      ((((0,1),(2,0)),((1,1),(3,3))),(((4,5),(6,4)),((0,5),(2,0))));

Var forecolour, backcolour: Byte; { stores last colours set }
    boldstate, blinkstate: Boolean;

Procedure TextColor(fore : Byte);
  Var
    blinknow, boldnow: Boolean;
    outstr: String;
  begin
    blinknow := (fore and $80) = $80;
    boldnow := (fore and $08) = $08;
    fore := fore and $07;  { mask out intensity and blink attributes }
    forecolour := fore;
    Case decisiontree[blinknow, blinkstate, boldnow, boldstate] OF
    0: outstr := Concat(#27,'[',forestr[fore],'m');
    1: outstr := Concat(#27,'[0;',backstr[backcolour],';',forestr[fore],'m');
    2: outstr := Concat(#27,'[1;',forestr[fore],'m');
    3: outstr :=
         Concat(#27,'[0;1;',backstr[backcolour],';',forestr[fore],'m');
    4: outstr := Concat(#27,'[5;',forestr[fore],'m');
    5: outstr :=
         Concat(#27,'[0;5;',backstr[backcolour],';',forestr[fore],'m');
    6: outstr := Concat(#27,'[1;5;',forestr[fore],'m');
    end; { Case }
    Write(AnsiFile,outstr);
    blinkstate := blinknow;
    boldstate := boldnow;
  end;

Procedure TextBackGround(back: Byte);
  Var outString: String;
  begin
    if Back > 7 then Exit; { No such thing as bright or blinking backgrounds }
    BackColour := Back;
    outString := Concat(#27,'[',backstr[back],'m');
    Write(AnsiFile,outString)
  end;

Procedure NormVideo;
  begin
    Write(AnsiFile,#27'[0m');
    forecolour := LightGray;
    backcolour := Black;
    boldstate := False;
    blinkstate := False
  end;

Procedure LowVideo;
  begin
    if blinkstate then forecolour := forecolour or $80;  { retain blinking }
    TextColor(forecolour);   { stored forecolour never contains bold attr }
  end;

Procedure HighVideo;
  begin
    if not boldstate then
    begin
      boldstate := True;
      Write(AnsiFile,#27,'[1m')
    end;
  end;

Procedure ClrEol;
  begin
    Write(AnsiFile,#27'[K')
  end;

Procedure ClrScr;
  begin
    Write(AnsiFile,#27'[2J');
  end;

begin
  forecolour := LightGray;
  backcolour := Black;
  boldstate := False;
  blinkstate := False
end.

___------------------------------------------------------------------
Program Demo;
Uses AnsiOut;
begin
  Assign(AnsiFile,'CON');   { or a File - e.g. 'MYSCREEN.ANS' }
  ReWrite(AnsiFile);
  ClrScr;
  TextColor(Blue); TextBackGround(LightGray);
  Writeln(AnsiFile,' Blue Text on LightGray ');
  HighVideo; Write(AnsiFile,' Now the Text is LightBlue ');
  TextBackground(Red); Writeln(AnsiFile,' on a Red background');
  TextColor(Black+Blink); TextBackground(Cyan);
  Writeln(AnsiFile,' Blinking Black ');
  TextBackGround(Green); ClrEol;         { a blank Green line }
(53 min left), (H)elp, More?   Writeln(AnsiFile);
  NormVideo;
  Close(AnsiFile);
end.

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