[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]