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