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

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

    				  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.
    *)

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