{
*****************************************************************************

				  COLOR.PAS

 By Tobin Fricke

 This should solve everyone's problems with Ascii, ANSI, WWIV, Avatar, LVI,
 Pipe, Direct, and RIP.


*****************************************************************************
}
{$IFDEF DEBUG}
{$D+,L+}
{$ENDIF}

Unit Color;

{$S-}

(* BBS Color Unit by Tobin Fricke                                          *)
(* TobinTech Software Research and Development                             *)
(* Copyright (c) 1994 Tobin Fricke, All Rights Reserved                    *)

(* This is a unit to allow the use of color on bbs systems.  It will send  *)
(* the color codes to the screen using BIOS.  These can easily be trapped  *)
(* and sent to the modem by most BBS systems.                              *)


(* -=- If you use this in any of your programs, you must give credit to the
       author of this toolkit, Tobin Fricke.  You must register this and 
       receive permission to use it in any commercial product or shareware
       product.  It may be used without consent from the author (as long as
       credit is given) in any "freeware" or "public domain" programs. This
       may not be bought or sold, and contains no warrantee.  Use it at your
       own risk.  Please send the author a copy of anything you create using
       this toolkit.  Thanks.  For information on registration, contact the
       author. *)

(* -=- Reaching The Author                                                 
     
       Internet:        dr261@cleveland.freenet.edu


       Postal:          25271 Arion Way, Mission Viejo, Ca, 92691-3702

	
       Phone:           (714) 586-4906

       
       BBS:             (714) 586-6142 The Digital Forest Information system


       DFIN:            13:714/100

	*)
	
	

Interface

uses DOS;

Type ProcType=Procedure(S:String);

Const NoColor=0;              { Ignores Color commands, no color         }
      ASCIIColor=0;           { Same as NoColor                          }
      ANSIColor=1;            { Uses ANSI Escape Codes                   }
      WWIVColor=2;            { Uses WWIV Heart  Codes                   }
      AVATARColor=3;          { Uses AVATAR codes                        }
      LVIColor=4;             { Uses LVI (Last Video Interface)  codes   }
      DirectColor=7;
      PipeSystemColor=5;      { The Renegade Pipe System for Color       }
      RipColor=6;

      WWIVEscape:Char=#3;     { These are escape codes for the different }
      ANSIEscape:Char=#27;    { modes.                                   }
      AVATEscape:Char=#22;

      Black=0;                { These are color constants.               }
      Blue=1;
      Green=2;
      Cyan=3;
      Red=4;
      Magenta=5;
      Brown=6;
      Gray=7;
      Bright=8;

      EmuNum=6;
      EmuMenu:Array[0..EmuNum] of String=
       ('ASCII ',
	'ANSI  ',
	'WWIV  ',
	'AVATAR',
	'LVI   ',
	'PIPE System',
	'RIPScrip');
      EmuComment:Array[0..EmuNum] of String=
      ('No Color or Screen Control',
       'ANSI Color and Screen Control',
       'WWIV BBS Software "Heart Codes"',
       'This isn''t used much anymore',
       'The Last Video Interface, Faster than ANSI',
       'Renegade Style Color Codes',
       'Remote Imaging Protocol Script');

var WriteMode:Byte;           { Prior to use, you must set WriteMode equal }
    Output:ProcType;          { to NoColor, ANSIcolor, AVATARColor, or LVI-}
			      { color }

Var T:Text;                   {Assigned to StdOutput }


Procedure Default;                  { Change colors to default (7 on 0) }
Procedure BackgroundColor(I:Byte);  { Set Background color to I         }
Procedure ForgroundColor(I:Byte);   { Set Foreground Color to I         }
Procedure GotoXY(X,Y:Byte);         { Go to specific location on screen }
Procedure CLRSCR;                   { Clear the screen                  }
function readkey:char;              { Not Implemented Yet               }
Procedure D;                        { Same as Default;                  }
Procedure WWIVParse(S:String);      { See the end of this file...       }
Procedure GetEmu;                   { See the end of this file...       }
Procedure FColor(B:Byte);           { Same as ForegroundColor           }
Procedure BColor(B:Byte);           { Same as BackgroundColor           }

Implementation

Uses CRT;




Procedure DefOutput(S:StrinG);
Begin
 Write(T,S);
End;

{function readkey:char;
var B:Byte;
begin
 ASM;
  Mov AH, 01h
  Int 21
  Mov [B], AL
 End;
 readkey:=chr(B);
end; }
function readkey:char;
var it:string;
    Regs:Registers;
begin
Regs.AH:=$01;
MSDOS(Regs);
STr(Regs.AL,it);
readkey:=it[1];
end;

Procedure PIPEBackground(B:Byte);
Var S:String;
Begin
 Case B Of
   0: S:='|16';
   1: S:='|17';
   2: S:='|18';
   3: S:='|19';
   4: S:='|20';
   5: S:='|21';
   6: S:='|22';
   7: S:='|23';
  End;
 Write(S);
End;

Procedure PIPEForground(B:Byte);
Var S:String;
Begin
 Case B Of
   0: S:='|00';
   1: S:='|01';
   2: S:='|02';
   3: S:='|03';
   4: S:='|04';
   5: S:='|05';
   6: S:='|06';
   7: S:='|07';
   8: S:='|08';
   9: S:='|09';
  10: S:='|10';
  11: S:='|11';
  12: S:='|12';
  13: S:='|13';
  14: S:='|14';
  15: S:='|15';
  End;
 Write(S);
End;


Procedure AVATARGotoXy(X,Y:Byte);
begin
 Write(#22+#8+Char(X)+Char(Y));
end;

Procedure AvatarForground(A:Byte);
begin
 Write(#22+#1+Char(A and $7F));
end;

Procedure AvatarClrScr;
begin
 Write(#12);
end;

Procedure WWIVForground(I:Byte);
var C:Byte;
    D:Char;
begin
 Repeat
  If I>8 then I:=I-8;
 Until I<9;
 C:=I;
 Case I of
    0:C:=0;
    1:C:=7;
    2:C:=5;
    3:C:=1;
    4:C:=6;
    5:C:=3;
    6:C:=2;
    7:C:=4;
    8:C:=4;
  end;
  Output(WWIVEscape+Char(48+C));
end;

Procedure WWIVBackground(I:Byte);
begin
 If I=1 then Output(WWIVEscape+'4');
end;

procedure ANSIDefault;
begin
 Output(ANSIEscape+'[0m');
end;

Procedure ANSIForground(I:Byte);
var z:string;
begin
{ANSIDefault;}
case I of
     0:z:='0;30';
     1:z:='0;34';
     2:z:='0;32';
     3:z:='0;36';
     4:z:='0;31';
     5:z:='0;35';
     6:z:='0;33';
     7:z:='0;37';
     8:z:='1;30';
     9:z:='1;34';
     10:z:='1;32';
     11:z:='1;36';
     12:z:='1;31';
     13:z:='1;35';
     14:z:='1;33';
     15:z:='1;37';
     end;
Output(ANSIescape+'['+z+'m');
end;

Procedure ANSIBackground(I:Byte);
var z:string;
    ansistr:string;
begin
{ ANSIDefault;}
 case I of
      0:z:='40';
      1:z:='44';
      2:z:='42';
      3:z:='46';
      4:z:='41';
      5:z:='45';
      6:z:='43';
      7:z:='47';
      end;
ansistr:=ANSIEscape+'['+z+'m';
Output(ansistr);
end;

Procedure GotoXY(X,Y:Byte);
var SX,SY:string;
begin
Str(X,SX);
Str(Y,SY);
Output(ANSIEscape+'['+SY+';'+SX+'H');
end;

Var F,B:Byte;

Procedure LVIForground(I:Byte);
Begin
 F:=I;
 Output(#29+Char(F+(B*16)));
end;

Procedure LVIBackground(I:Byte);
Begin
 B:=I;
 Output(#29+Char(F+(B*16)));
end;

Procedure Zero(Var X:Byte);
Begin
 X:=0;
end;

Procedure FColor(B:Byte);
Begin
 ForgroundColor(B);
end;

Procedure BColor(B:Byte);
Begin
 BackgroundColor(B);
End;

Procedure WWIVParse(S:String);
var I:Byte;
begin
 Zero(I);
 Repeat
  Inc(I);
  Case S[I] of
    #3:Begin            { #3 =  }
	Inc(I);
	Case S[I] of
	   '0':Begin BColor(0); FColor(7+0);  End;
	   '1':Begin BColor(0); FColor(3+8); End;
	   '2':Begin BColor(0); FColor(6+8); End;
	   '3':Begin BColor(0); FColor(5+0); End;
	   '4':Begin BColor(1); FColor(1+0); End;
	   '5':Begin BColor(0); FColor(2+0); End;
	   '6':Begin BColor(0); FColor(4+8); End;
	   '7':Begin BColor(0); FColor(1+8); End;
	   '8':Begin BColor(0); FColor(2+8); End;
	   '9':Begin BColor(0); FColor(3+8); End;
	  End;
	End;
    Else Output(S[I]);
  End;
 Until I>=Length(S);
End;

Procedure BackgroundColor(I:Byte);
begin
 Case WriteMode of
   ANSIColor:ANSIBackground(I);
   RIPColor:ANSIBackground(I);
   WWIVColor:WWIVBackground(I);
   LVIColor:LVIBackground(I);
   DirectColor:CRT.TextBackground(I);
   PipeSystemColor:PipeBackground(I);
   end;
end;

Procedure ForgroundColor(I:Byte);
begin
 Case WriteMode of
   ANSIColor:ANSIForground(I);
   RIPColor:ANSIForground(I);
   WWIVColor:WWIVForground(I);
   AVATARColor:AvatarForground(I);
   LVIColor:LVIForground(I);
   DirectColor:CRT.TextColor(I);
   PipeSystemColor:PipeForground(I);
   end;
end;

Procedure ANSIClrScr;
begin
Output(ANSIEscape+'[2J');
end;

Procedure WWIVClrScr;
var I:Byte;
begin
  For I:=1 to 25 do Writeln(T,'');
end;

Procedure ClrScr;
begin
 Case WriteMode of
    ANSIColor:ANSIClrScr;
    RIPColor:ANSIClrScr;
    WWIVColor:WWIVClrScr;
    AVATARColor:AvatarClrScr;
    LVIColor:ANSIClrScr;
    DirectColor:CRT.ClrScr;
    end;
end;

Procedure Default;
Begin
 Case Writemode of
  ANSIColor: ANSIDefault;
  RipColor:  ANSIDefault;
  end;
end;

Procedure D;
begin
 Default;
end;

Procedure GetEMu;
Var I,E:Integer;
    S:String;
    T:Integer;
Begin
Repeat
 Writeln(' Please choose a terminal type: ');
 Writeln;
 For I:=0 to Color.EmuNum do
     Writeln(' ',I,') ',Color.EmuMenu[I],#9,Color.EmuComment[I]);
 Writeln;
 Write(' TERM>');
 Readln(S);
 Val(S,T,E);
 If E<>0 then begin
    Writeln(' I can''t understand: ',S);
    Write('                    ');
    For I:=1 to E do Write(' ');
    Writeln('^');
    End;
 If ((T>Color.EmuNum) OR (T<0)) AND (E=0) then begin
    Writeln(' You must enter a number from 0 to ',EmuNum);
    E:=1;
    end;
Until E=0;
Writeln;
Writeln(' ',EmuMenu[T],' Emulation Selected ');
WriteMode:=T;
end;


begin
 Output:=DefOutput;
 Assign(System.Output,'');
 Assign(System.Input,'');
 Assign(T,'');
 Rewrite(T);
 Rewrite(System.Output);
 Reset(Input);
 DirectVideo:=False;
 WriteMode:=ANSIColor;
 F:=7;
 B:=0;
end.

(*  Information...



      Set WriteMode to one of the following before calling any color commands.


      NoColor=0;              { Ignores Color commands, no color         }
      ASCIIColor=0;           { Same as NoColor                          }
      ANSIColor=1;            { Uses ANSI Escape Codes                   }
      WWIVColor=2;            { Uses WWIV Heart  Codes                   }
      AVATARColor=3;          { Uses AVATAR codes                        }
      LVIColor=4;             { Uses LVI (Last Video Interface)  codes   }
      DirectColor=7;          { Not implemented yet  }
      PipeSystemColor=5;      { The Renegade Pipe System for Color       }
      RipColor=6;


      For TTY emulation, see TTY.PAS
      For LVI emulation, see LVI.PAS


      Output(S:String) Is called to output the ANSI/WWIV/AVATAR/LVI/PIPE/RIP
      codes.  It defaults to StdOutput, and It may be redefined like so:


      Procedure COMOutput(S:String);
      begin
       { send S to COMPort }

      end;


      begin
       Color.Output:=ComOutput;
      end.


      WWIVParse(S:String) will take a string containing WWIV (ASCII 3) color
      codes, parse it, and output it (through procedure output) with the 
      correct coloring.


      GetEmu will display a menu and ask the user for an emulation.
*)