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

{ ***** FIRST OFF!  The credits and such *****                               }
{  Written in Turbo Pascal (TM) v6.0 on 10 May 1991 ( yes, one day) by       }
{  Robert L. Edwards.  The idea was to make it a little simpler to generate  }
{  both ANSI and ASCI bulletins for DOOR programs.  I was in the final stages}
{  of a DOOR developement and needed this tool.  The idea is to set up a     }
{  string with the text you want saved weaved in with your ANSI calls.  I    }
{  got this idea from the Pheonix Software Group PSG (tm) collection of DOOR }
{  routines named PSGIO(tm).  In that collection a routine is called PRINT   }
{  and PRINTLN that handle calls from a routine ANSIColor to set the         }
{  attributes.  This function was not flexible enough for me to use in file  }
{  writes (or I am just too stupid?!?).                                      }
{                                                                            }
{  !!! THIS CODE IS CONSIDERED PUBLIC DOMAIN !!!                             }
{  -  Please, if you improve on it, upload a copy to my board.  I used only  }
{     one afternoon to produce this and the code is quite shakey.            }
{                                                                            }
{  If you find this program usefull (no, I am not going to ask for money     }
{  Please call me and let me know (VIA BBS).  If enough support and interest }
{  is shown, I will further clean and enhance this program.  As it is now    }
{  it fits my needs.  Any recomendations are greatly appreciated.            }
{     Respectfully,                                                          }
{                                                                            }
{                  Robert L. Edwards                                         }
{                  RaJE Computer Emirates (RJE)                              }
{                  Box 6725 NSGA                                             }
{                  Winter Harbor, ME 04693                                   }
{                                                                            }
{     Call The Force! Demon-Sion BBS @ 1(207)963-2683  USR HST 14400         }
{          or Voice @ 1(207)963-7056                                         }

Unit Bulletin;
Interface
Uses tpCRT;

Function A_St(FG, BG : Word) : String;

{ - DESCRIPTION:  This function takes the WORDs input and translates them    }
{                 if possible, to ANSI escape sequences.  The global         }
{                 variable ANS (Record type) is checked for repeat requests  }
{                 and will not duplicate ANSI code.  IE:  A call to set      }
{                 colors to YELLOW foreground and BLUE background when       }
{                 the background (ANS.BG) is already blue will produce       }
{                 only the YELLOW escapes sequences.  If the global ANS.ON   }
{                 is FALSE, the function will return a NUL string.           }
{ - CALLING:  YourString := A_St(Yellow + Bold + Blink, Blue);               }
{                                                                            }
{             Will yield the escape sequence for a bold blinking yellow      }
{             foreground on a blue background.  Global variable are set for  }
{             the allowable ANSI colors.  This variables are Mnemonics and   }
{             are in no way related to their ANSI escape sequences.  For ease}
{             non-conflict the values are duplicate of the TURBO PASCAL      }
{             UNIT CRT global declarations.                                  }
{ - RESULTS:  This function returns a string of characters equal to the      }
{             escape sequences need to reproduce the called foreground       }
{             and background collors.  If global ANS.ON is FALSE, a NUL      }
{             string will be returned.                                       }
{ - CALLED FROM:  Your routines.                                             }
{ - VARIABLES:                                                               }
{     Type                                                                   }
{       CAns = Record                                                        }
{         Att : Word;     Current Attribute                                  }
{                         Valid values:                                      }
{                            OFF                                             }
{                            Blink                                           }
{                            Bold                                            }
{                            Blink + Bold                                    }
{         FG  : Word;     Current ForeGround                                 }
{                         Valid Values                                       }
{                         Black,   [+ Blink], [+ Bold], [+ Blink + Bold]     }
{                         Red,     [+ Blink], [+ Bold], [+ Blink + Bold]     }
{                         Green,   [+ Blink], [+ Bold], [+ Blink + Bold]     }
{                         Yellow,  [+ Blink], [+ Bold], [+ Blink + Bold]     }
{                         Blue,    [+ Blink], [+ Bold], [+ Blink + Bold]     }
{                         Magenta, [+ Blink], [+ Bold], [+ Blink + Bold]     }
{                         Cyan,    [+ Blink], [+ Bold], [+ Blink + Bold]     }
{                         White,   [+ Blink], [+ Bold], [+ Blink + Bold]     }
{         BG  : WOrd;     Current BackGround                                 }
{                         Valid Values:                                      }
{                          Black                                             }
{                          Red                                               }
{                          Green                                             }
{                          Yellow                                            }
{                          Blue                                              }
{                          Magenta                                           }
{                          Cyan                                              }
{                          White                                             }
{         ON  : Boolean;  Generate ANSI codes?                               }
{                         Valid Values:                                      }
{                           True                                             }
{                           False                                            }
{       End;                                                                 }
{                                                                            }
{   var                                                                      }
{     Ans : CAns;         Holds current attributes, described above          }
{   Const                                                                    }
{     Esc      = #27 + '[';     Escape sequence                              }
{     Off      =  50;           Off Mnemonic                                 }
{     Bold     =  51;           Bold Mnemonic                                }
{     Black    =   0;           Black Mnemonic, CRT Constant                 }
{     Red      =   4;           Red Mnemonic, CRT Constant                   }
{     Green    =   2;           Green Mnemonic, CRT Constant                 }
{     Yellow   =  14;           Yellow Mnemonic, CRT Constant                }
{     Blue     =   1;           Blue Mnemonic, CRT Constant                  }
{     Magenta  =   5;           Magenta Mnemonic, CRT Constant               }
{     Cyan     =   3;           Cyan Mnemonic, CRT Constant                  }
{     White    =  15;           White Mnemonic, CRT Constant                 }
{     Blink    = 128;           Blink Mnemonic, CRT Constant                 }

Type
  CAns = Record
    Att : Word;
    FG  : Word;
    BG  : WOrd;
    ON  : Boolean;
  End;

var
  Ans : CAns;              { Holds Current Information on      }
                           { Attribute ( Off, Bold, Blink, ETC }
                           { ForeGround Color                  }
                           { BackGround Color                  }
Const
  Esc      = #27 + '[';    { Escape sequence                }
  Off      =  50;          { Off Mnemonic                   }
  Bold     =  51;          { Bold Mnemonic                  }
  Black    =   0;          { Black Mnemonic, CRT Constant   }
  Red      =   4;          { Red Mnemonic, CRT Constant     }
  Green    =   2;          { Green Mnemonic, CRT Constant   }
  Yellow   =  14;          { Yellow Mnemonic, CRT Constant  }
  Blue     =   1;          { Blue Mnemonic, CRT Constant    }
  Magenta  =   5;          { Magenta Mnemonic, CRT Constant }
  Cyan     =   3;          { Cyan Mnemonic, CRT Constant    }
  White    =  15;          { White Mnemonic, CRT Constant   }
  Blink    = 128;          { Blink Mnemonic, CRT Constant   }
  Nul      = 100;          { No Change Mnemonic             }
Implementation

Function SetATT(A : Word) : String;
  Begin
    SetAtt := '';
    Case A of
      Off : If Ans.ATT <> Off then
              Begin
                SetAtt := '0';
                Ans.Att := Off;
                Ans.FG  := 255;
                Ans.BG  := 255;
              End;
      Bold  : Case Ans.Att of
                Off,
                Blink : Begin
                          SetATT := '1';
                          Inc(Ans.Att,Bold);
                        End;
                Bold, Bold +
                Blink  : Begin
                         End;
                Else Begin
                       SetATT := '1';
                       Ans.Att := Bold;
                     End;
              End;
      Blink : Case Ans.Att of
                Off   : Begin
                          SetAtt := '5';
                           Ans.Att := Blink;
                         End;
                Bold  : Begin
                          SetAtt := '5';
                          Inc(Ans.Att,Blink);
                        End;
                Blink,
                Bold +
                Blink : Begin
                        End;
                Else Begin
                       SetAtt := '5';
                       Ans.Att := Blink;
                     End;
              End;
      Blink +
      Bold  : Case Ans.ATT of
                Off   : Begin
                          SetAtt := '1;5';
                          Ans.ATT := Blink + Bold;
                        End;
                Blink : Begin
                          SetAtt := '1';
                          Ans.ATT := Blink + Bold;
                        End;
                 Bold : Begin
                          SetAtt := '5';
                          Ans.Att := Blink + Bold;
                        End;
                Blink +
                Bold   : Begin
                         End;
                Else Begin
                       SetAtt := '1;5';
                       Ans.Att := Blink + Bold;
                     End;
               End; { Ans.ATT }
    End; { Case A }
  End;  { SetATT }

Function SetFG(f : word) : string;
  Begin
    SetFg := '';
    If Ans.FG = F then Exit;
    Case F of
      Black  :  SetFG := '30';
      Red    :  SetFG := '31';
      Green  :  SetFG := '32';
      Yellow :  SetFG := '33';
      Blue   :  SetFG := '34';
      Magenta:  SetFG := '35';
      Cyan   :  SetFG := '36';
      White  :  SetFG := '37';
      Else Exit;
    End;
  Ans.FG := F;
  End;

Function SetBG(f : word) : string;
  Begin
    SetBg := '';
    If Ans.BG = F then Exit;
    Case F of
      Black  :  SetBG := '40';
      Red    :  SetBG := '41';
      Green  :  SetBG := '42';
      Yellow :  SetBG := '43';
      Blue   :  SetBG := '44';
      Magenta:  SetBG := '45';
      Cyan   :  SetBG := '46';
      White  :  SetBG := '47';
      Else Exit;
    End;
  Ans.BG := F;
  End;

Function A_St(FG, BG : Word) : String;
Var
  T  : String;
  T2 : String;
  T3 : String;
  Begin
    A_ST := '';
    If NOT ANS.ON then Exit;
    t    := '';
    t2   := '';
    T3   := '';
    Case FG of
      100   : Begin; End;           { No Change to FG go on to BG }
      Off, Bold, Blink, Bold +
      Blink : T := SetAtt(FG);
      Black, Bold + Black, Blink + Black, Bold + Blink +
      Black : Begin
                T := SetATT(FG - Black);
                T2 := SetFG(Black);
              End;
      Red, Bold + Red, Blink + Red, Bold + Blink +
      Red : Begin
              T := SetATT(FG - Red);
              T2 := SetFG(Red);
            End;
      Green, Bold + Green, Blink + Green, Bold + Blink +
      Green : Begin
                T := SetATT(FG - Green);
                T2 := SetFG(Green);
              End;
      Yellow, Bold + Yellow, Blink + Yellow, Bold + Blink +
      Yellow : Begin
                 T := SetATT(FG - Yellow);
                 T2 := SetFG(Yellow);
               End;
      Blue, Bold + Blue, Blink + Blue, Bold + Blink +
      Blue : Begin
               T := SetATT(FG - Blue);
               T2 := SetFG(Blue);
             End;
      Magenta, Bold + Magenta, Blink + Magenta, Bold + Blink +
      Magenta : Begin
                  T := SetATT(FG - Magenta);
                  T2 := SetFG(Magenta);
                End;
      Cyan, Bold + Cyan, Blink + Cyan, Bold + Blink +
      Cyan : Begin
               T := SetATT(FG - Cyan);
               T2 := SetFG(Cyan);
             End;
      White, Bold + White, Blink + White, Bold + Blink +
      White : Begin
                T := SetATT(FG - White);
                T2 := SetFG(White);
              End;
    End;

    Case BG of
      100     : T3 := '';
      Black   : T3 := SetBG(Black);
      Red     : T3 := SetBG(Red);
      Green   : T3 := SetBG(Green);
      Yellow  : T3 := SetBG(Yellow);
      Blue    : T3 := SetBG(Blue);
      Magenta : T3 := SetBG(Magenta);
      Cyan    : T3 := SetBG(Cyan);
      White   : T3 := SetBG(White);
    End;

    If T + T2 + T3 = '' Then Exit;
    If T <> '' Then
      Begin
        If T2 <> '' Then T := T + ';' + T2;
        if T3 <> '' Then T := T + ';' + T3;
      End Else
        Begin
          If T2 <> '' Then
            Begin
              T := T2;
              if T3 <> '' Then T := T + ';' + T3;
            End Else
            T := T3;
        End;
    A_ST := Esc + T +'m';
  End;

Begin
  Ans.Att := 255;  { These Values set invalidly on purpose.  When the first  }
  Ans.FG  := 255;  { call is made, this will FORCE! (pun for Jim and Guy)    }
  Ans.BG  := 255;  { them to be set.  If I set them at say 0, and the user   }
  Ans.ON  := True; { Called wanting a black backgroun, the function would not}
end.               { Return the 40m required because it would think it was   }
                   { already in black background                             }

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