home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BULL.ZIP / BULLETIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-10  |  15.0 KB  |  334 lines
  1. { ***** FIRST OFF!  The credits and such *****                               }
  2. {  Written in Turbo Pascal (TM) v6.0 on 10 May 1991 ( yes, one day) by       }
  3. {  Robert L. Edwards.  The idea was to make it a little simpler to generate  }
  4. {  both ANSI and ASCI bulletins for DOOR programs.  I was in the final stages}
  5. {  of a DOOR developement and needed this tool.  The idea is to set up a     }
  6. {  string with the text you want saved weaved in with your ANSI calls.  I    }
  7. {  got this idea from the Pheonix Software Group PSG (tm) collection of DOOR }
  8. {  routines named PSGIO(tm).  In that collection a routine is called PRINT   }
  9. {  and PRINTLN that handle calls from a routine ANSIColor to set the         }
  10. {  attributes.  This function was not flexible enough for me to use in file  }
  11. {  writes (or I am just too stupid?!?).                                      }
  12. {                                                                            }
  13. {  !!! THIS CODE IS CONSIDERED PUBLIC DOMAIN !!!                             }
  14. {  -  Please, if you improve on it, upload a copy to my board.  I used only  }
  15. {     one afternoon to produce this and the code is quite shakey.            }
  16. {                                                                            }
  17. {  If you find this program usefull (no, I am not going to ask for money     }
  18. {  Please call me and let me know (VIA BBS).  If enough support and interest }
  19. {  is shown, I will further clean and enhance this program.  As it is now    }
  20. {  it fits my needs.  Any recomendations are greatly appreciated.            }
  21. {     Respectfully,                                                          }
  22. {                                                                            }
  23. {                  Robert L. Edwards                                         }
  24. {                  RaJE Computer Emirates (RJE)                              }
  25. {                  Box 6725 NSGA                                             }
  26. {                  Winter Harbor, ME 04693                                   }
  27. {                                                                            }
  28. {     Call The Force! Demon-Sion BBS @ 1(207)963-2683  USR HST 14400         }
  29. {          or Voice @ 1(207)963-7056                                         }
  30.  
  31. Unit Bulletin;
  32. Interface
  33. Uses CRT;
  34.  
  35. Function A_St(FG, BG : Word) : String;
  36.  
  37. { - DESCRIPTION:  This function takes the WORDs input and translates them    }
  38. {                 if possible, to ANSI escape sequences.  The global         }
  39. {                 variable ANS (Record type) is checked for repeat requests  }
  40. {                 and will not duplicate ANSI code.  IE:  A call to set      }
  41. {                 colors to YELLOW foreground and BLUE background when       }
  42. {                 the background (ANS.BG) is already blue will produce       }
  43. {                 only the YELLOW escapes sequences.  If the global ANS.ON   }
  44. {                 is FALSE, the function will return a NUL string.           }
  45. { - CALLING:  YourString := A_St(Yellow + Bold + Blink, Blue);               }
  46. {                                                                            }
  47. {             Will yield the escape sequence for a bold blinking yellow      }
  48. {             foreground on a blue background.  Global variable are set for  }
  49. {             the allowable ANSI colors.  This variables are Mnemonics and   }
  50. {             are in no way related to their ANSI escape sequences.  For ease}
  51. {             non-conflict the values are duplicate of the TURBO PASCAL      }
  52. {             UNIT CRT global declarations.                                  }
  53. { - RESULTS:  This function returns a string of characters equal to the      }
  54. {             escape sequences need to reproduce the called foreground       }
  55. {             and background collors.  If global ANS.ON is FALSE, a NUL      }
  56. {             string will be returned.                                       }
  57. { - CALLED FROM:  Your routines.                                             }
  58. { - VARIABLES:                                                               }
  59. {     Type                                                                   }
  60. {       CAns = Record                                                        }
  61. {         Att : Word;     Current Attribute                                  }
  62. {                         Valid values:                                      }
  63. {                            OFF                                             }
  64. {                            Blink                                           }
  65. {                            Bold                                            }
  66. {                            Blink + Bold                                    }
  67. {         FG  : Word;     Current ForeGround                                 }
  68. {                         Valid Values                                       }
  69. {                         Black,   [+ Blink], [+ Bold], [+ Blink + Bold]     }
  70. {                         Red,     [+ Blink], [+ Bold], [+ Blink + Bold]     }
  71. {                         Green,   [+ Blink], [+ Bold], [+ Blink + Bold]     }
  72. {                         Yellow,  [+ Blink], [+ Bold], [+ Blink + Bold]     }
  73. {                         Blue,    [+ Blink], [+ Bold], [+ Blink + Bold]     }
  74. {                         Magenta, [+ Blink], [+ Bold], [+ Blink + Bold]     }
  75. {                         Cyan,    [+ Blink], [+ Bold], [+ Blink + Bold]     }
  76. {                         White,   [+ Blink], [+ Bold], [+ Blink + Bold]     }
  77. {         BG  : WOrd;     Current BackGround                                 }
  78. {                         Valid Values:                                      }
  79. {                          Black                                             }
  80. {                          Red                                               }
  81. {                          Green                                             }
  82. {                          Yellow                                            }
  83. {                          Blue                                              }
  84. {                          Magenta                                           }
  85. {                          Cyan                                              }
  86. {                          White                                             }
  87. {         ON  : Boolean;  Generate ANSI codes?                               }
  88. {                         Valid Values:                                      }
  89. {                           True                                             }
  90. {                           False                                            }
  91. {       End;                                                                 }
  92. {                                                                            }
  93. {   var                                                                      }
  94. {     Ans : CAns;         Holds current attributes, described above          }
  95. {   Const                                                                    }
  96. {     Esc      = #27 + '[';     Escape sequence                              }
  97. {     Off      =  50;           Off Mnemonic                                 }
  98. {     Bold     =  51;           Bold Mnemonic                                }
  99. {     Black    =   0;           Black Mnemonic, CRT Constant                 }
  100. {     Red      =   4;           Red Mnemonic, CRT Constant                   }
  101. {     Green    =   2;           Green Mnemonic, CRT Constant                 }
  102. {     Yellow   =  14;           Yellow Mnemonic, CRT Constant                }
  103. {     Blue     =   1;           Blue Mnemonic, CRT Constant                  }
  104. {     Magenta  =   5;           Magenta Mnemonic, CRT Constant               }
  105. {     Cyan     =   3;           Cyan Mnemonic, CRT Constant                  }
  106. {     White    =  15;           White Mnemonic, CRT Constant                 }
  107. {     Blink    = 128;           Blink Mnemonic, CRT Constant                 }
  108.  
  109. Type
  110.   CAns = Record
  111.     Att : Word;
  112.     FG  : Word;
  113.     BG  : WOrd;
  114.     ON  : Boolean;
  115.   End;
  116.  
  117. var
  118.   Ans : CAns;              { Holds Current Information on      }
  119.                            { Attribute ( Off, Bold, Blink, ETC }
  120.                            { ForeGround Color                  }
  121.                            { BackGround Color                  }
  122. Const
  123.   Esc      = #27 + '[';    { Escape sequence                }
  124.   Off      =  50;          { Off Mnemonic                   }
  125.   Bold     =  51;          { Bold Mnemonic                  }
  126.   Black    =   0;          { Black Mnemonic, CRT Constant   }
  127.   Red      =   4;          { Red Mnemonic, CRT Constant     }
  128.   Green    =   2;          { Green Mnemonic, CRT Constant   }
  129.   Yellow   =  14;          { Yellow Mnemonic, CRT Constant  }
  130.   Blue     =   1;          { Blue Mnemonic, CRT Constant    }
  131.   Magenta  =   5;          { Magenta Mnemonic, CRT Constant }
  132.   Cyan     =   3;          { Cyan Mnemonic, CRT Constant    }
  133.   White    =  15;          { White Mnemonic, CRT Constant   }
  134.   Blink    = 128;          { Blink Mnemonic, CRT Constant   }
  135.   Nul      = 100;          { No Change Mnemonic             }
  136. Implementation
  137.  
  138. Function SetATT(A : Word) : String;
  139.   Begin
  140.     SetAtt := '';
  141.     Case A of
  142.       Off : If Ans.ATT <> Off then
  143.               Begin
  144.                 SetAtt := '0';
  145.                 Ans.Att := Off;
  146.                 Ans.FG  := 255;
  147.                 Ans.BG  := 255;
  148.               End;
  149.       Bold  : Case Ans.Att of
  150.                 Off,
  151.                 Blink : Begin
  152.                           SetATT := '1';
  153.                           Inc(Ans.Att,Bold);
  154.                         End;
  155.                 Bold, Bold +
  156.                 Blink  : Begin
  157.                          End;
  158.                 Else Begin
  159.                        SetATT := '1';
  160.                        Ans.Att := Bold;
  161.                      End;
  162.               End;
  163.       Blink : Case Ans.Att of
  164.                 Off   : Begin
  165.                           SetAtt := '5';
  166.                            Ans.Att := Blink;
  167.                          End;
  168.                 Bold  : Begin
  169.                           SetAtt := '5';
  170.                           Inc(Ans.Att,Blink);
  171.                         End;
  172.                 Blink,
  173.                 Bold +
  174.                 Blink : Begin
  175.                         End;
  176.                 Else Begin
  177.                        SetAtt := '5';
  178.                        Ans.Att := Blink;
  179.                      End;
  180.               End;
  181.       Blink +
  182.       Bold  : Case Ans.ATT of
  183.                 Off   : Begin
  184.                           SetAtt := '1;5';
  185.                           Ans.ATT := Blink + Bold;
  186.                         End;
  187.                 Blink : Begin
  188.                           SetAtt := '1';
  189.                           Ans.ATT := Blink + Bold;
  190.                         End;
  191.                  Bold : Begin
  192.                           SetAtt := '5';
  193.                           Ans.Att := Blink + Bold;
  194.                         End;
  195.                 Blink +
  196.                 Bold   : Begin
  197.                          End;
  198.                 Else Begin
  199.                        SetAtt := '1;5';
  200.                        Ans.Att := Blink + Bold;
  201.                      End;
  202.                End; { Ans.ATT }
  203.     End; { Case A }
  204.   End;  { SetATT }
  205.  
  206. Function SetFG(f : word) : string;
  207.   Begin
  208.     SetFg := '';
  209.     If Ans.FG = F then Exit;
  210.     Case F of
  211.       Black  :  SetFG := '30';
  212.       Red    :  SetFG := '31';
  213.       Green  :  SetFG := '32';
  214.       Yellow :  SetFG := '33';
  215.       Blue   :  SetFG := '34';
  216.       Magenta:  SetFG := '35';
  217.       Cyan   :  SetFG := '36';
  218.       White  :  SetFG := '37';
  219.       Else Exit;
  220.     End;
  221.   Ans.FG := F;
  222.   End;
  223.  
  224. Function SetBG(f : word) : string;
  225.   Begin
  226.     SetBg := '';
  227.     If Ans.BG = F then Exit;
  228.     Case F of
  229.       Black  :  SetBG := '40';
  230.       Red    :  SetBG := '41';
  231.       Green  :  SetBG := '42';
  232.       Yellow :  SetBG := '43';
  233.       Blue   :  SetBG := '44';
  234.       Magenta:  SetBG := '45';
  235.       Cyan   :  SetBG := '46';
  236.       White  :  SetBG := '47';
  237.       Else Exit;
  238.     End;
  239.   Ans.BG := F;
  240.   End;
  241.  
  242. Function A_St(FG, BG : Word) : String;
  243. Var
  244.   T  : String;
  245.   T2 : String;
  246.   T3 : String;
  247.   Begin
  248.     A_ST := '';
  249.     If NOT ANS.ON then Exit;
  250.     t    := '';
  251.     t2   := '';
  252.     T3   := '';
  253.     Case FG of
  254.       100   : Begin; End;           { No Change to FG go on to BG }
  255.       Off, Bold, Blink, Bold +
  256.       Blink : T := SetAtt(FG);
  257.       Black, Bold + Black, Blink + Black, Bold + Blink +
  258.       Black : Begin
  259.                 T := SetATT(FG - Black);
  260.                 T2 := SetFG(Black);
  261.               End;
  262.       Red, Bold + Red, Blink + Red, Bold + Blink +
  263.       Red : Begin
  264.               T := SetATT(FG - Red);
  265.               T2 := SetFG(Red);
  266.             End;
  267.       Green, Bold + Green, Blink + Green, Bold + Blink +
  268.       Green : Begin
  269.                 T := SetATT(FG - Green);
  270.                 T2 := SetFG(Green);
  271.               End;
  272.       Yellow, Bold + Yellow, Blink + Yellow, Bold + Blink +
  273.       Yellow : Begin
  274.                  T := SetATT(FG - Yellow);
  275.                  T2 := SetFG(Yellow);
  276.                End;
  277.       Blue, Bold + Blue, Blink + Blue, Bold + Blink +
  278.       Blue : Begin
  279.                T := SetATT(FG - Blue);
  280.                T2 := SetFG(Blue);
  281.              End;
  282.       Magenta, Bold + Magenta, Blink + Magenta, Bold + Blink +
  283.       Magenta : Begin
  284.                   T := SetATT(FG - Magenta);
  285.                   T2 := SetFG(Magenta);
  286.                 End;
  287.       Cyan, Bold + Cyan, Blink + Cyan, Bold + Blink +
  288.       Cyan : Begin
  289.                T := SetATT(FG - Cyan);
  290.                T2 := SetFG(Cyan);
  291.              End;
  292.       White, Bold + White, Blink + White, Bold + Blink +
  293.       White : Begin
  294.                 T := SetATT(FG - White);
  295.                 T2 := SetFG(White);
  296.               End;
  297.     End;
  298.  
  299.     Case BG of
  300.       100     : T3 := '';
  301.       Black   : T3 := SetBG(Black);
  302.       Red     : T3 := SetBG(Red);
  303.       Green   : T3 := SetBG(Green);
  304.       Yellow  : T3 := SetBG(Yellow);
  305.       Blue    : T3 := SetBG(Blue);
  306.       Magenta : T3 := SetBG(Magenta);
  307.       Cyan    : T3 := SetBG(Cyan);
  308.       White   : T3 := SetBG(White);
  309.     End;
  310.  
  311.     If T + T2 + T3 = '' Then Exit;
  312.     If T <> '' Then
  313.       Begin
  314.         If T2 <> '' Then T := T + ';' + T2;
  315.         if T3 <> '' Then T := T + ';' + T3;
  316.       End Else
  317.         Begin
  318.           If T2 <> '' Then
  319.             Begin
  320.               T := T2;
  321.               if T3 <> '' Then T := T + ';' + T3;
  322.             End Else
  323.             T := T3;
  324.         End;
  325.     A_ST := Esc + T +'m';
  326.   End;
  327.  
  328. Begin
  329.   Ans.Att := 255;  { These Values set invalidly on purpose.  When the first  }
  330.   Ans.FG  := 255;  { call is made, this will FORCE! (pun for Jim and Guy)    }
  331.   Ans.BG  := 255;  { them to be set.  If I set them at say 0, and the user   }
  332.   Ans.ON  := True; { Called wanting a black backgroun, the function would not}
  333. end.               { Return the 40m required because it would think it was   }
  334.                    { already in black background                             }