home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / RADOOR30.ZIP / ML-MOD.ZIP / MLFILTER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-10  |  11.9 KB  |  339 lines
  1. {╔═════════════════════════════════════════════════════════════════════════╗
  2.  ║                                                                         ║
  3.  ║                   (c) CopyRight LiveSystems 1990, 1994                  ║
  4.  ║                                                                         ║
  5.  ║ Author    : Gerhard Hoogterp                                            ║
  6.  ║ FidoNet   : 2:282/100.5   2:283/7.33                                    ║
  7.  ║ BitNet    : GERHARD@LOIPON.WLINK.NL                                     ║
  8.  ║                                                                         ║
  9.  ║ SnailMail : Kremersmaten 108                                            ║
  10.  ║             7511 LC Enschede                                            ║
  11.  ║             The Netherlands                                             ║
  12.  ║                                                                         ║
  13.  ║        This module is part of the RADoor BBS doorwriters toolbox.       ║
  14.  ║                                                                         ║
  15.  ╚═════════════════════════════════════════════════════════════════════════╝}
  16.  
  17. {---------------------------------------------------------------------------|
  18.  
  19.  Description:
  20.  
  21.  This unit provides the toolbox with a standard output filter. This makes it
  22.  easy to give your programs a nice consistent look and feel...
  23.  Features:
  24.  
  25.      - HighAscii translation for ASCII users. This way you don't have to
  26.        care about the special language characters and linedrawing symbols.
  27.        This filter translates them into comparible low-ascii.
  28.  
  29.      - Easy colormapping. Indirect color access through a colortable.
  30.        You define up to 10 color-combination in your program (Just TextAttr
  31.        values) and use ^0..^9 in the output strings. The filter translates
  32.        them into the correct ansi or avatar sequence, or skips them completely
  33.        for ASCII users.
  34.        The ANSI translation is smart, that is, it always sends the shortest
  35.        string needed..
  36.  
  37.      - You can define the used EscapeCharacter, default the ^ is used, but
  38.        it can be anything, also HighAscii.
  39.  
  40.      - The filter tries to be smart about and Clear until End Of Line.
  41.        If you put an ^! in your text, it's translated to the ANSI or
  42.        AVATAR ClrEol sequence. For ASCII an #13<79 Spaces>#13 is send.
  43.        This isn't the fasted methode, but as the unit doesn't know where
  44.        on the line it is, it's a failsave methode.. Anyone who knows a
  45.        better way is welcome..
  46.  
  47.  
  48. |---------------------------------------------------------------------------}
  49.  
  50. Unit MLFilter;  { Output filter with multilanguage support }
  51. Interface
  52. Uses Dos,
  53.      LowLevel,
  54.      Language;
  55.  
  56. {----------------------------------------------------------------------------|
  57.   Color definitions so you don't need the CRT unit for these
  58. |----------------------------------------------------------------------------}
  59.  
  60. Const Black        = 0;
  61.       Blue         = 1;
  62.       Green        = 2;
  63.       Cyan         = 3;
  64.       Red          = 4;
  65.       Magenta      = 5;
  66.       Brown        = 6;
  67.       LightGray    = 7;
  68.       DarkGray     = 8;
  69.       LightBlue    = 9;
  70.       LightGreen   = 10;
  71.       LightCyan    = 11;
  72.       LightRed     = 12;
  73.       LightMagenta = 13;
  74.       Yellow       = 14;
  75.       White        = 15;
  76.       Blink        = 128;
  77.  
  78. {---------------------------------------------------------------------------|
  79.   The table for the HighAscii translation.
  80.   Translates diacritical characters and linedrawing symbols plus a few
  81.   special characters. (The #254 which is often used as attention bullet
  82.   into a * f.e.)
  83. |---------------------------------------------------------------------------}
  84.  
  85. Const TransTable : Array[#128..#255] of Char =
  86.                   (
  87. {128}             'C'  ,'u'  ,'e'  ,'a'  ,'a'  ,'a'  ,'a'  ,'c',
  88. {136}             'e'  ,'e'  ,'e'  ,'i'  ,'i'  ,'i'  ,'A'  ,'A',
  89.  
  90. {144}             'E'  ,' '  ,' '  ,'o'  ,'o'  ,'o'  ,'u'  ,'u',
  91. {152}             'y'  ,'O'  ,'U'  ,'c'  ,' '  ,'O'  ,' ' ,'f',
  92.  
  93. {160}             'a'  ,'i'  ,'o'  ,'u'  ,'n'  ,'N'  ,'a'  ,'o',
  94. {168}             '?'  ,' '  ,' '  ,' '  ,' '  ,'i'  ,' '  ,' ',
  95.  
  96. {176}             ' '  ,' '  ,' '  ,'|'  ,'+'  ,'+'  ,'+'  ,'+',
  97. {184}             '+'  ,'+'  ,'|'  ,'+'  ,'+'  ,'+'  ,'+'  ,'+',
  98.  
  99. {192}             '+'  ,'+'  ,'+'  ,'+'  ,'-'  ,'+'  ,'+'  ,'+',
  100. {200}             '+'  ,'+'  ,'+'  ,'+'  ,'+'  ,'-'  ,'+'  ,'+',
  101.  
  102. {208}             '+'  ,'+'  ,'+'  ,'+'  ,'+'  ,'+'  ,'+'  ,'+',
  103. {216}             '+'  ,'+'  ,'+'  ,' '  ,' '  ,' '  ,' '  ,' ',
  104.  
  105. {224}             'a'  ,'b' ,'g'  ,' '  ,' '  ,' '  ,' '  ,' ',
  106. {232}             ' '  ,' '  ,' '  ,' '  ,' '  ,' '  ,' '  ,' ',
  107.  
  108. {240}             '='  ,' '  ,' '  ,' '  ,' '  ,' '  ,'/'  ,' ',
  109. {248}             ' '  ,' '  ,' '  ,' '  ,' '  ,' '  ,'*'  ,' '
  110.                   );
  111.  
  112.  
  113.  
  114.  
  115. {---------------------------------------------------------------------------|
  116.  Colortable for up to 10 TextAttr bytes. Should be more than enough in most
  117.  cases. Can be expanded without to much hassel. Although in my humble opinion
  118.  to many colors makes a program to "busy". Keep it simple..;)
  119.  
  120.  You should provide the contents of the table in the mainprogram. You can
  121.  use the same colorattributes as for normal CRT usage.
  122. |---------------------------------------------------------------------------}
  123.  
  124. Const ColorTable   : Array[0..9] Of Byte =
  125.                      (
  126.                        $0F,   { Color 0 }
  127.                        $0F,   { Color 1 }
  128.                        $0F,   { Color 2 }
  129.                        $0F,   { Color 3 }
  130.                        $0F,   { Color 4 }
  131.                        $0F,   { Color 5 }
  132.                        $0F,   { Color 6 }
  133.                        $0F,   { Color 7 }
  134.                        $0F,   { Color 8 }
  135.                        $0F    { Color 9 }
  136.                      );
  137.  
  138. {---------------------------------------------------------------------------|
  139.   Initialize the filter options.
  140.  
  141.   Because I liked to keep the filter as standalone as possible you have to
  142.   initialize the filter yourself.
  143.  
  144.   Grap     Graphics (Use ANSI)  Default OFF
  145.   Avt      AVATAR               Default OFF
  146.   EscChar  Escape character.    Default  ^
  147. |---------------------------------------------------------------------------}
  148.  
  149. Procedure InitUsedFilter( Grap,
  150.                           Avt     : Boolean;
  151.                           Lang    : PathStr;
  152.                           EscChar : Char
  153.                         );
  154.  
  155. {---------------------------------------------------------------------------|
  156.  And the filter itself. Note that the header comformes the OutputFilterType
  157.  procedure type definition in the FOSSIL unit, so if you write your own
  158.  filter, it MUST have the same definition:
  159.  
  160.     Procedure <ProcedureName>(Var <StringName> : String);
  161.  
  162.  It should be compiled in FAR mode. (When in an units interface section
  163.  this is automaticaly)
  164.  
  165. |---------------------------------------------------------------------------}
  166.  
  167.  
  168. Procedure UsedFilter(Var InStr : String);
  169.  
  170. Implementation
  171.  
  172. {---------------------------------------------------------------------------|
  173.   The default values of the filtervariables
  174. |---------------------------------------------------------------------------}
  175.  
  176. Const EscapeChar   : Char    = '^';
  177.       Graphics     : Boolean = False;
  178.       Avatar       : Boolean = False;
  179.  
  180.  
  181. {---------------------------------------------------------------------------|
  182.   The initialization procedure
  183. |---------------------------------------------------------------------------}
  184. Procedure InitUsedFilter( Grap,
  185.                           Avt     : Boolean;
  186.                           Lang    : PathStr;
  187.                           EscChar : Char
  188.                         );
  189. Begin
  190. Graphics:=Grap;
  191. Avatar:=AVT;
  192. If InitLanguageData(Lang)<>0
  193.    Then Begin
  194.         WriteLn(#254' Error reading languagedata!!');
  195.         Halt(1);
  196.         End;
  197. EscapeChar:=EscChar;
  198. End;
  199.  
  200.  
  201. {---------------------------------------------------------------------------|
  202.   S  Translates a Word to a string of an given length. (Max. 20 characters)
  203. |---------------------------------------------------------------------------}
  204.  
  205.  
  206. Type Str20 = String[20];
  207.  
  208. Function S(Num : Word;Len : Byte):Str20;
  209. Var Temp : Str20;
  210. Begin
  211. Str(Num:Len,Temp);
  212. S:=Temp;
  213. End;
  214.  
  215.  
  216. {---------------------------------------------------------------------------|
  217.   Byte2Ansi translates an TextMode attribute byte into the shortest ANSI
  218.             sequence. This is done by storing the last foreground and
  219.             background colors and only sending something if there are
  220.             changes.
  221. |---------------------------------------------------------------------------}
  222.  
  223. Var LastFG    : Byte;
  224.     LastBG    : Byte;
  225.  
  226. Function Byte2Ansi(B : Byte):Str20;
  227. Const AnsiTable : Array[0..7] Of Byte
  228.                 = (0,4,2,6,1,5,3,7);
  229.  
  230. Var FG,BG : Byte;
  231.     Tmp   : Str20;
  232.     Temp  : Byte;
  233.  
  234. Begin
  235. Tmp:='';
  236.  
  237. BG:=(B And $70) Shr 4;
  238. FG:=(B and $0F);
  239. If FG<>LastFG
  240.    Then Begin
  241.         Temp:=FG;
  242.         If (FG>7)
  243.            Then Begin
  244.                 Dec(FG,8);
  245.                 If LastFG<=7
  246.                    Then Tmp:=Tmp+'0;1';
  247.                 End
  248.            Else Begin
  249.                 If LastFG>7
  250.                    Then Tmp:=Tmp+'0';
  251.                 End;
  252.         If (B And $80)=$80
  253.            Then Tmp:=Tmp+';6';
  254.         Tmp:=Tmp+';'+S(AnsiTable[FG]+30,0);
  255.         LastFG:=Temp;
  256.         End;
  257. If BG<>LastBG
  258.    Then Begin
  259.         LastBG:=BG;
  260.         Tmp:=Tmp+';'+S(AnsiTable[BG]+40,0);
  261.         End;
  262.  
  263. If Tmp[1]=';'
  264.    Then Delete(Tmp,1,1);
  265. If Tmp<>''
  266.    Then Byte2Ansi:=#27'['+Tmp+'m'
  267.    Else Byte2Ansi:='';
  268. End;
  269.  
  270. {---------------------------------------------------------------------------|
  271.    EmptyLine is the string used to clear the line with an ^! in ASCII mode.
  272.  
  273.    UsedFilter is the output filter procedure.
  274. |---------------------------------------------------------------------------}
  275.  
  276. Var EmptyLine : String[80];
  277.  
  278. Procedure UsedFilter(Var InStr : String);
  279. Var StrCount : Byte;
  280.     TempStr  : String;
  281.     Index    : Byte;
  282.     LangNr   : String[5];
  283. Begin
  284. InStr:=ExpandString(InStr);  { Do the language translation }
  285. TempStr:='';
  286. StrCount:=1;
  287. While StrCount <= Length(InStr) Do
  288.  Begin
  289.  If (InStr[StrCount]=EscapeChar) And
  290.     (StrCount<Length(InStr))
  291.     Then Begin
  292.          Inc(StrCount);
  293.          Case InStr[StrCount] Of
  294.            '!'     : Begin
  295.                      If Graphics Or Avatar
  296.                         Then Begin
  297.                              If AVATAR
  298.                                 Then TempStr:=TempStr+^V^G
  299.                                 Else TempStr:=TempStr+#27'[K';
  300.                              End
  301.                         Else TempStr:=TempStr+#13+EmptyLine+#13;
  302.                      Inc(StrCount);
  303.                      End;
  304.            '0'..'9': Begin
  305.                      If Graphics Or Avatar
  306.                         Then Begin
  307.                              Index:=Ord(InStr[StrCount])-48;
  308.                              If AVATAR
  309.                                 Then TempStr:=TempStr+^V^A+Chr(ColorTable[Index])
  310.                                 Else TempStr:=TempStr+Byte2Ansi(ColorTable[Index]);
  311.                              End;
  312.                      Inc(StrCount);
  313.                      End;
  314.            '^'     : TempStr:=TempStr+'^';
  315.          End; {Case}
  316.          End
  317.     Else Begin
  318.          If (InStr[StrCount]=#12) And
  319.             (Graphics And (Not AVATAR))
  320.             Then TempStr:=TempStr+#27'[2J'
  321.             Else Begin
  322.                  If (InStr[StrCount]>#127) And
  323.                     (Not (Graphics or Avatar))
  324.                     Then TempStr:=TempStr+TransTable[InStr[StrCount]]
  325.                     Else TempStr:=TempStr+InStr[StrCount];
  326.                  End;
  327.          Inc(StrCount);
  328.          End;
  329.  End; {While}
  330. InStr:=TempStr;
  331. End;
  332.  
  333. Begin
  334. FillChar(EmptyLine,SizeOf(EmptyLine),#32);
  335. EmptyLine[0]:=#79;
  336. LastFG:=0;
  337. LastBG:=0;
  338. End.
  339.