home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BANNERC.ZIP / BANNERC.PAS
Encoding:
Pascal/Delphi Source File  |  1986-01-28  |  11.7 KB  |  364 lines
  1. Program Banner;
  2.  
  3. {$V-}
  4.  
  5. { Written by Scott R. Houck    11 Jan 86
  6.  
  7.   This program produces banners which can be sent to the screen
  8.   or to a file.  If sent to a file, the output may be appended to
  9.   to an existing file if desired.
  10.  
  11.   The syntax is as follows:
  12.  
  13.     BANNER [/B=banner] [/I=infile] [/O=outfile [/A]] [/C=char]
  14.  
  15.   where
  16.  
  17.     banner  = a character string of maximum length 10
  18.     infile  = an input file containing the banner(s)
  19.     outfile = an output file to which the banner(s) will be written
  20.     char    = character to be used in printing the banner
  21.                 (default = the character being printed)
  22.  
  23.          /A = append to file if it already exists
  24.  
  25.  
  26.   NOTES:
  27.  
  28.     1.  Options may be specified in any order, but there must be
  29.         at least one space between each one.  Do not put spaces
  30.         on either side of the equals sign.
  31.  
  32.     2.  You may use PRN for the filename if you want to send the
  33.         output to the printer. If you choose to do this, do not
  34.         use the /A option.
  35.  
  36.     3.  To indicate a space in the banner when using the /B option, use
  37.         the carat symbol (^).  Example:  BANNER /O=DISKFILE /B=JOHN^DOE
  38.         However, this is not necessary if you are using the /I option.
  39.  
  40.     4.  Valid characters are 0-9, A-Z, and !"#$%&'()*+,-./:;<=>?@[\]
  41.         Any other characters will be printed as a space.
  42.  
  43.     6.  All lower case letters are converted to upper case.
  44.  
  45.     7.  Three blank lines are written before the banner is output.
  46.  
  47.     8.  Note that /B and /I are mutually exclusive and will produce a
  48.         syntax error if used together.
  49.  
  50.     9.  If all options are omitted or if the command line does not contain
  51.         either /B or /I, the command syntax is printed.
  52.  
  53.    10.  /A will produce a syntax error if used without /O.
  54.  
  55.    11.  You may not use < or > with the /B option because DOS would
  56.         interpret it as redirection of standard input and output.
  57.  
  58. }
  59.  
  60. Type
  61.   str13 = string[13];
  62.   str80 = string[80];
  63.   char_pattern = array[1..10] of integer;
  64.  
  65. Const
  66.   bit_value: array[1..10] of integer = (1,2,4,8,16,32,64,128,256,512);
  67.  
  68.   char_def:  array[#32..#94] of char_pattern = (
  69.  
  70.     {32:' '}   ($000,$000,$000,$000,$000,$000,$000,$000,$000,$000),
  71.     {33:'!'}   ($030,$078,$0FC,$0FC,$078,$078,$030,$000,$030,$030),
  72.     {34:'"'}   ($1CE,$1CE,$1CE,$1CE,$000,$000,$000,$000,$000,$000),     
  73.     {35:'#'}   ($0CC,$0CC,$0CC,$3FF,$0CC,$0CC,$3FF,$0CC,$0CC,$0CC),     
  74.     {36:'$'}   ($030,$1FE,$3FF,$330,$3FF,$1FF,$033,$3FF,$1FE,$030),
  75.     {37:'%'}   ($1C3,$366,$36C,$1D8,$030,$060,$0CE,$19B,$31B,$20E),
  76.     {38:'&'}   ($1E0,$330,$330,$1C0,$1E0,$331,$31A,$31C,$1FA,$0E1),     
  77.     {39:'''}   ($070,$0F8,$078,$010,$020,$000,$000,$000,$000,$000),
  78.     {40:'('}   ($004,$018,$030,$060,$060,$060,$060,$030,$018,$004),
  79.     {41:')'}   ($080,$060,$030,$018,$018,$018,$018,$030,$060,$080),
  80.     {42:'*'}   ($000,$000,$000,$084,$048,$2FD,$048,$084,$000,$000),
  81.     {43:'+'}   ($000,$000,$078,$078,$3FF,$3FF,$078,$078,$000,$000),
  82.     {44:','}   ($000,$000,$000,$000,$000,$070,$0F8,$078,$010,$020),
  83.     {45:'-'}   ($000,$000,$000,$000,$3FF,$3FF,$000,$000,$000,$000),     
  84.     {46:'.'}   ($000,$000,$000,$000,$000,$000,$000,$078,$0FC,$078),
  85.     {47:'/'}   ($001,$003,$006,$00C,$018,$030,$060,$0C0,$180,$100),
  86.     {48:'0'}   ($078,$0FC,$186,$303,$303,$303,$303,$186,$0FC,$078),
  87.     {49:'1'}   ($030,$0F0,$0B0,$030,$030,$030,$030,$030,$3FF,$3FF),
  88.     {50:'2'}   ($1FE,$3FF,$203,$003,$003,$018,$060,$0C0,$3FF,$3FF),
  89.     {51:'3'}   ($3FF,$3FE,$00C,$018,$038,$00E,$006,$203,$3FF,$1FE),
  90.     {52:'4'}   ($01C,$03C,$06C,$0CC,$18C,$3FF,$3FF,$00C,$00C,$00C),
  91.     {53:'5'}   ($3FF,$3FF,$300,$300,$3FE,$3FF,$003,$203,$3FF,$1FE),
  92.     {54:'6'}   ($1FE,$3FF,$301,$300,$3FE,$3FF,$303,$303,$3FF,$1FE),
  93.     {55:'7'}   ($3FF,$3FF,$006,$00C,$018,$030,$060,$0C0,$300,$300),
  94.     {56:'8'}   ($1FE,$3FF,$303,$303,$1FE,$1FE,$303,$303,$3FF,$1FE),
  95.     {57:'9'}   ($1FE,$3FF,$303,$303,$3FF,$1FF,$003,$003,$3FF,$1FE),
  96.     {58:':'}   ($000,$000,$000,$078,$0FC,$078,$000,$078,$0FC,$078),
  97.     {59:';'}   ($000,$038,$07C,$038,$000,$038,$07C,$03C,$004,$008),
  98.     {60:'<'}   ($000,$000,$003,$00C,$030,$0C0,$030,$00C,$003,$000),
  99.     {61:'='}   ($000,$000,$000,$3FF,$3FF,$000,$3FF,$3FF,$000,$000),
  100.     {62:'>'}   ($000,$000,$0C0,$030,$00C,$003,$00C,$030,$0C0,$000),
  101.     {63:'?'}   ($1FE,$3FF,$303,$006,$00C,$018,$018,$000,$018,$018),     
  102.     {64:'@'}   ($1FE,$303,$33B,$36B,$363,$363,$366,$37C,$300,$1FE),     
  103.     {65:'A'}   ($1FE,$3FF,$303,$303,$303,$3FF,$3FF,$303,$303,$303),
  104.     {66:'B'}   ($3FE,$3FF,$303,$303,$3FE,$3FE,$303,$303,$3FF,$3FE),
  105.     {67:'C'}   ($1FE,$3FF,$301,$300,$300,$300,$300,$301,$3FF,$1FE),
  106.     {68:'D'}   ($3FE,$3FF,$303,$303,$303,$303,$303,$303,$3FF,$3FE),
  107.     {69:'E'}   ($3FF,$3FF,$300,$300,$3E0,$3E0,$300,$300,$3FF,$3FF),
  108.     {70:'F'}   ($3FF,$3FF,$300,$300,$3E0,$3E0,$300,$300,$300,$300),
  109.     {71:'G'}   ($1FE,$3FF,$300,$300,$31F,$31F,$303,$303,$3FF,$1FF),
  110.     {72:'H'}   ($303,$303,$303,$303,$3FF,$3FF,$303,$303,$303,$303),
  111.     {73:'I'}   ($3FF,$3FF,$030,$030,$030,$030,$030,$030,$3FF,$3FF),
  112.     {74:'J'}   ($0FF,$0FF,$018,$018,$018,$018,$318,$318,$3F8,$1F0),
  113.     {75:'K'}   ($303,$306,$318,$360,$3E0,$330,$318,$30C,$306,$303),
  114.     {76:'L'}   ($300,$300,$300,$300,$300,$300,$300,$300,$3FF,$3FF),
  115.     {77:'M'}   ($303,$3CF,$37B,$333,$333,$303,$303,$303,$303,$303),
  116.     {78:'N'}   ($303,$383,$343,$363,$333,$333,$31B,$30B,$307,$303),
  117.     {79:'O'}   ($1FE,$3FF,$303,$303,$303,$303,$303,$303,$3FF,$1FE),
  118.     {80:'P'}   ($3FE,$3FF,$303,$303,$3FF,$3FE,$300,$300,$300,$300),
  119.     {81:'Q'}   ($1FE,$3FF,$303,$303,$303,$303,$33B,$30F,$3FE,$1FB),
  120.     {82:'R'}   ($3FE,$3FF,$303,$303,$3FF,$3FE,$318,$30C,$306,$303),
  121.     {83:'S'}   ($1FE,$3FF,$301,$300,$3FE,$1FF,$003,$203,$3FF,$1FE),
  122.     {84:'T'}   ($3FF,$3FF,$030,$030,$030,$030,$030,$030,$030,$030),
  123.     {85:'U'}   ($303,$303,$303,$303,$303,$303,$303,$303,$3FF,$1FE),
  124.     {86:'V'}   ($303,$303,$186,$186,$186,$186,$0CC,$0CC,$078,$030),
  125.     {87:'W'}   ($303,$303,$303,$303,$333,$333,$333,$37B,$1CE,$186),
  126.     {88:'X'}   ($303,$186,$0CC,$078,$030,$078,$0CC,$186,$303,$303),
  127.     {89:'Y'}   ($303,$186,$0CC,$078,$030,$030,$030,$030,$030,$030),
  128.     {90:'Z'}   ($3FF,$3FE,$00C,$018,$030,$030,$060,$0C0,$1FF,$3FF),
  129.     {91:'['}   ($0FE,$0FE,$0C0,$0C0,$0C0,$0C0,$0C0,$0C0,$0FE,$0FE),
  130.     {92:'\'}   ($200,$300,$180,$0C0,$060,$030,$018,$00C,$006,$002),
  131.     {93:']'}   ($0FE,$0FE,$006,$006,$006,$006,$006,$006,$0FE,$0FE),
  132.     {94:'^'}   ($000,$000,$000,$000,$000,$000,$000,$000,$000,$000)    );
  133.  
  134. Var
  135.   character: char;
  136.   banner: str13;
  137.   Param: array[1..4] of str80;
  138.   InfileName, OutfileName: str80;
  139.   Infile, Outfile: text;
  140.   Slash_A, Slash_B, Slash_C, Slash_I, Slash_O: boolean;
  141.  
  142. {----------------------------------------------------------------------}
  143.  
  144. Procedure Beep;
  145.  
  146. begin
  147.   Sound(350);
  148.   Delay(300);
  149.   NoSound;
  150. end;
  151.  
  152. {----------------------------------------------------------------------}
  153.  
  154. Procedure UpperCase(var AnyStr: str80);
  155.  
  156. var
  157.   i: integer;
  158.  
  159. begin
  160.   For i := 1 to length(AnyStr) do AnyStr[i] := UpCase(AnyStr[i]);
  161. end;
  162.  
  163. {----------------------------------------------------------------------}
  164.  
  165. Function Exist(filename: str80): boolean;
  166.  
  167. var
  168.   tempfile: file;
  169.  
  170. begin
  171.   Assign(tempfile,filename);
  172.   {$I-}
  173.   Reset(tempfile);
  174.   {$I+}
  175.   Exist := (IOresult = 0);
  176.   Close(tempfile);
  177. end;
  178.  
  179. {----------------------------------------------------------------------}
  180.  
  181. Procedure Print_Syntax;
  182.  
  183. begin
  184.   Writeln('The syntax is as follows:'^J);
  185.   Writeln('  BANNER [/B=banner] [/I=infile] [/O=outfile [/A]] ',
  186.           '[/C=char]'^J);
  187.   Writeln('where'^J);
  188.   Writeln('  banner  = character string of maximum length 10');
  189.   Writeln('  infile  = input file containing banner text');
  190.   Writeln('  outfile = output file to which the banner(s) will be ',
  191.           'written');
  192.   Writeln('  char    = character to be used in printing the banner');
  193.   Writeln('              (default = the character being printed)'^J);
  194.   Writeln('       /A = append to file if it already exists'^J);
  195.   Writeln('Note that /B and /I are mutually exclusive.');
  196.   Writeln('Use a carat (^) for a space if using /B.');
  197.   Writeln('Valid characters are 0-9, A-Z, and ',
  198.           '!"#$%&''()*+,-./:;<=>?@[\]');
  199. end;
  200.  
  201. {----------------------------------------------------------------------}
  202.  
  203. Procedure Parse;
  204.  
  205. var
  206.   n, b, c, i, o: integer;
  207.   ch1, ch2, ch3: char;
  208.  
  209.   {*} procedure Error;
  210.         begin
  211.           Beep;
  212.           Print_Syntax;
  213.           Halt;
  214.         end;
  215.  
  216. begin  { Parse }
  217.  
  218.   Slash_A := false;
  219.   Slash_B := false;    b := 0;
  220.   Slash_C := false;    c := 0;
  221.   Slash_I := false;    i := 0;
  222.   Slash_O := false;    o := 0;
  223.  
  224.   If ParamCount = 0 then
  225.     begin
  226.       Print_Syntax;
  227.       Halt;
  228.     end;
  229.  
  230.   If ParamCount > 4 then Error;
  231.  
  232.   For n := 1 to ParamCount do
  233.     begin
  234.       Param[n] := ParamStr(n);
  235.       UpperCase(Param[n]);
  236.       ch1 := Param[n][1];
  237.       ch2 := Param[n][2];
  238.       ch3 := Param[n][3];
  239.       If (ch1 <> '/') or not (ch2 in ['A','B','C','I','O']) then Error;
  240.       If ch2 = 'A' then
  241.         Slash_A := true;
  242.       If ch2 = 'B' then
  243.         begin
  244.           Slash_B := true;
  245.           b := n;
  246.         end;
  247.       If ch2 = 'C' then
  248.         begin
  249.           Slash_C := true;
  250.           c := n;
  251.         end;
  252.       If ch2 = 'I' then
  253.         begin
  254.           Slash_I := true;
  255.           i := n;
  256.         end;
  257.       If ch2 = 'O' then
  258.         begin
  259.           Slash_O := true;
  260.           o := n;
  261.         end;
  262.       If (ch2 in ['B','C','I','O']) and (ch3 <> '=') then Error;
  263.       If (ch2 = 'A') and (length(ch2) > 2) then Error;
  264.     end;
  265.  
  266.   If Slash_B and Slash_I then Error;
  267.   If not Slash_B and not Slash_I then Error;
  268.   If Slash_A and not Slash_O then Error;
  269.   If Slash_B then
  270.     begin
  271.       banner := Param[b];
  272.       Delete(banner,1,3);
  273.     end;
  274.   If Slash_C then character := Param[c][4];
  275.   If Slash_I then
  276.     begin
  277.       InfileName := Param[i];
  278.       Delete(InfileName,1,3);
  279.     end;
  280.   If Slash_O then
  281.     begin
  282.       OutfileName := Param[o];
  283.       Delete(OutfileName,1,3);
  284.     end;
  285.  
  286. end;
  287.  
  288. {----------------------------------------------------------------------}
  289.  
  290. Procedure Heading(message: str13);
  291.  
  292. var
  293.   i, j, k: integer;
  294.  
  295. begin
  296.  
  297.   If Slash_O
  298.     then Writeln(Outfile,^M^J^M^J^M^J)
  299.     else Writeln(^J^J^J);
  300.  
  301.   For i := 1 to 10 do
  302.     begin
  303.       For j := 1 to length(message) do
  304.         begin
  305.           If not (message[j] in [#32..#94]) then message[j] := #32;
  306.           For k := 10 downto 1 do
  307.             If char_def[message[j],i] and bit_value[k] = bit_value[k]
  308.               then
  309.                 begin
  310.                   If not Slash_C then character := message[j];
  311.                   If Slash_O
  312.                     then Write(Outfile,character)
  313.                     else Write(character);
  314.                 end
  315.               else
  316.                 begin
  317.                   If Slash_O
  318.                     then Write(Outfile,' ')
  319.                     else Write(' ');
  320.                 end;
  321.               If Slash_O
  322.                 then Write(Outfile,'  ')
  323.                 else Write('  ');
  324.         end;
  325.       If Slash_O
  326.         then Writeln(Outfile)
  327.         else Writeln;
  328.     end;
  329.  
  330. end;
  331.  
  332. {----------------------------------------------------------------------}
  333.  
  334. Begin  { Banner }
  335.  
  336.   Parse;
  337.  
  338.   If Slash_O then
  339.     begin
  340.       Assign(Outfile,OutfileName);
  341.       If Slash_A and Exist(OutfileName)
  342.         then Append(Outfile)
  343.         else Rewrite(Outfile);
  344.     end;
  345.  
  346.   If Slash_I then
  347.     begin
  348.       Assign(Infile,InfileName);
  349.       Reset(Infile);
  350.       While not Eof(Infile) do
  351.         begin
  352.           Readln(Infile,banner);
  353.           UpperCase(banner);
  354.           Heading(banner);
  355.         end;
  356.       Close(Infile);
  357.     end
  358.  
  359.   else Heading(banner);
  360.  
  361.   If Slash_O then Close(Outfile);
  362.  
  363. End.
  364.