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 / BEEHIVE / UTILITYS / BOX1.ARC / BOX.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-06  |  14KB  |  378 lines
  1. Program BOX;
  2. { Version 3, March 19, 1987 by Loring Chien, Houston, Texas }
  3. { places a box around text, centers, right justify, or left justify
  4. using .CE, .LJ, or .RJ commands. }
  5.  
  6. Const
  7.   Width : integer = 00;
  8.   LftJustify=1;
  9.   Center=2;
  10.   RtJustify=3;
  11.   IBM_PC : Boolean = True; { this only affects the cosmetics of the
  12.                              title block, nothing else. Set to False for
  13.                              CP/M or MS-DOS w/o IBM char set }
  14.  
  15. Type
  16.   Strng132 = String[132];
  17.   Strng80 = String[80];
  18.   Strng20 = string[20];
  19.   FName = String[20];
  20.  
  21.  
  22. Var
  23.   BoxChar,ans,WSChar,NxtWSChar : Char;
  24.   TopCHar,SideChar,UpLftChar,LowLftChar,UpRtChar,LowRtChar : CHar;
  25.   Prefix,PostFix : Strng80;
  26.   TextIn, TextOut : strng132;
  27.   FileIn, Fileout, ViewIn, WSFile : Text;
  28.   TExtFile, BoxFile : fname;
  29.   I,TxtLen,PadLen,PadLenLeft,PadLenRt, LineNo, CmdCnt : Integer;
  30.   Basefile : FName;
  31.   MOde : integer;   { 1= left justify, 2=center, 3=right justify}
  32.   BoxMode : Integer;
  33.  
  34.     Function Exist(filename:fname):Boolean;
  35.     {This function returns true if the filename exists, otherwise,
  36.      it returns false.}
  37.     Var
  38.       Fil:file;
  39.     Begin
  40.       Assign(fil, filename);
  41.       {$I-}
  42.       Reset (Fil);
  43.       {$I+}
  44.       EXIST := (IOresult = 0);
  45.     End;
  46.  
  47.     Procedure GetFileName (Var FileName: fname; Style:fname;
  48.                            var BaseFile:Fname; DefaultExt:fname;BFUse:integer);
  49.      { read in a file name, make sure it exists }
  50.      { FileName - output gets put here, a legal filename}
  51.      { Style - asks 'Input ',STYLE,' file name'         }
  52.      { BaseFile - default file less ext on input. Used if BFUse =1 or 3 }
  53.      { DefaultExt - ext used if none supplied           }
  54.      { BFUse - if 1 or 3, use BaseFIle, if 2 or 3, make Basefile from result }
  55.      { BFUse : 00000xxxb
  56.                     |||
  57.                     ||+---- use Basefile as default base
  58.                     |+----- make entered base filename as new BaseFile
  59.                     +------ Do not Check to make sure file exists, i.e.
  60.                               to be used as an input file
  61.      }
  62.  
  63.      Var
  64.       FileNameBad: Boolean;
  65.       I : integer;
  66.      Begin
  67.       FileNameBad:=True;
  68.       While FileNameBad do
  69.        begin
  70.         write ('Enter file name for ',Style,' ');
  71.         IF (BFUse and 1) = 1 then write ('[',Basefile);
  72.         Write ('[.',DefaultExt,']');
  73.         If (BFUse and 1) = 1 then write (']');
  74.         Write (' : ');
  75.         readln (FileName);
  76.         If ((BFUse and 1)=1) and (Length(FileName)=0) then Filename:=BaseFile;
  77.         If pos('.',FileName)=0 then FileName :=FileName+'.'+DefaultExt;
  78.         For I :=1 to length(FileName) do FileName[i]:=upCase(FileName[i]);
  79.         If (BFUse and 4) =4 then FileNameBad :=false
  80.         else FileNameBad := not exist(FileName);
  81.         If FileNameBad then writeln (FileName,' not found.');
  82.        end;
  83.       If (BFUse and 2) =2 then BaseFile := Copy(FileName,1,pos('.',FileName)-1);
  84.      end;  { GetFileName }
  85.  
  86.  
  87. Begin {program BOX }
  88.  
  89.   ClrScr;
  90.   If not IBM_PC then
  91.   Begin
  92.   Writeln ('+----------------------------------------------------------------------------+');
  93.   Writeln ('|                                                                            |');
  94.   Writeln ('|              BOX.COM   /  BOX.PAS    by Loring Chien  3/19/87              |');
  95.   Writeln ('|                                                                            |');
  96.   Writeln ('| This program places a "BOX" around text from an Input File and writes it   |');
  97.   Writeln ('| into an Output File.  You specify the width (must be 4 greater than the    |');
  98.   Writeln ('| longest line) of the box, or let the program choose it by specifying zero. |');
  99.   Writeln ('|                                                                            |');
  100.   Writeln ('| There are three "dot" commands -                                           |');
  101.   Writeln ('|                                                                            |');
  102.   Writeln ('| ".LJ" to left justify text                                                 |');
  103.   Writeln ('|                                                                            |');
  104.   Writeln ('|                          ".CE" to center text, and                         |');
  105.   Writeln ('|                                                                            |');
  106.   Writeln ('|                                               ".RJ" to right justify text. |');
  107.   Writeln ('|                                                                            |');
  108.   Writeln ('| The dot must be in column one and the mode remains in effect until         |');
  109.   Writeln ('| changed.  Mode commands must be in upper case  and the default is ".CE".   |');
  110.   Writeln ('|                                                                            |');
  111.   Writeln ('|               (note: this title block was done with BOX.PAS)               |');
  112.   Writeln ('|                                                                            |');
  113.   Writeln ('+----------------------------------------------------------------------------+');
  114.   End
  115.   Else Begin
  116.   Writeln ('╔════════════════════════════════════════════════════════════════════════════╗');
  117.   Writeln ('║                                                                            ║');
  118.   Writeln ('║              BOX.COM   /  BOX.PAS    by Loring Chien  3/19/87              ║');
  119.   Writeln ('║                                                                            ║');
  120.   Writeln ('║ This program places a "BOX" around text from an Input File and writes it   ║');
  121.   Writeln ('║ into an Output File.  You specify the width (must be 4 greater than the    ║');
  122.   Writeln ('║ longest line) of the box, or let the program choose it by specifying zero. ║');
  123.   Writeln ('║                                                                            ║');
  124.   Writeln ('║ There are three "dot" commands -                                           ║');
  125.   Writeln ('║                                                                            ║');
  126.   Writeln ('║ ".LJ" to left justify text                                                 ║');
  127.   Writeln ('║                                                                            ║');
  128.   Writeln ('║                          ".CE" to center text, and                         ║');
  129.   Writeln ('║                                                                            ║');
  130.   Writeln ('║                                               ".RJ" to right justify text. ║');
  131.   Writeln ('║                                                                            ║');
  132.   Writeln ('║ The dot must be in column one and the mode remains in effect until         ║');
  133.   Writeln ('║ changed.  Mode commands must be in upper case  and the default is ".CE".   ║');
  134.   Writeln ('║                                                                            ║');
  135.   Writeln ('║               (note: this title block was done with BOX.PAS)               ║');
  136.   Writeln ('║                                                                            ║');
  137.   Writeln ('╚════════════════════════════════════════════════════════════════════════════╝');
  138.   end;
  139.   writeln;
  140.  
  141.   GetFileName (TextFile,'Text to be Boxed',BaseFile,'TXT',2);
  142.  
  143.   Write ('Is this a Wordstar Document-mode file (Y/[N]) ? ');
  144.   Begin
  145.     Read (kbd,ans);
  146.     Ans := UpCase (ans);
  147.   End;
  148.   Writeln (ans);
  149.  
  150.   If ans = 'Y' then
  151.   Begin   { fixing Wordstar file }
  152.     Writeln ('Fixing Wordstar Document-mode file...');
  153.     Assign (WSFile,TextFile);
  154.     Reset (WSFile);
  155.     Assign (FileIn,BaseFile+'.$$$');  {temp file}
  156.     Rewrite (FileIn);
  157.     Repeat
  158.       Read (WSFIle,WSChar);
  159.       WSChar := Chr ( Ord (WSChar) and 127 );
  160.       If Ord(WSChar) = $1F then WSCHar := '-';
  161.       If Ord(WSChar) = $1E then
  162.       Begin
  163.         Read (WSFIle,WSChar);
  164.         WSChar := Chr ( Ord (WSChar) and 127 );
  165.       End;
  166.       Write (FileIn,WSChar);
  167.     Until Ord(WSChar) = 26; {end-of-file}
  168.     CLose (FileIn);
  169.     Close (WSFIle);
  170.     TextFile := BaseFile+'.$$$';
  171.   End; {Fixing Wordstar file }
  172.  
  173.   Assign (FileIn, TextFile);
  174.   Reset (FileIn);
  175.  
  176.   GetFileName (BoxFile,'Output of Boxed Text', BaseFile,'BOX',5);
  177.   Assign (FileOut, BoxFile);
  178.   Rewrite (FileOut);
  179.  
  180.   Width :=0;
  181.   Write ('Enter desired width (columns) of Boxed text (0=AutoSize) [',Width,'] : ');
  182.   Readln (Width);
  183.  
  184.   If width =0 then { Auto-Size Input File }
  185.   Begin
  186.     Write ('Auto-Sizing ',TextFile,'... ');
  187.     While not EOF (FileIn) do
  188.     Begin
  189.       Readln (FileIn,TExtIn);
  190.       If Length(TextIn) > Width then Width := Length(TextIn);
  191.     End;
  192.     Width := Width +4;
  193.     Reset (FileIn);
  194.     Writeln ('Width set to ',Width, ' columns.');
  195.   End;
  196.  
  197.   Mode := Center;
  198.   BoxChar := '*';
  199.   TopChar := '-';
  200.   SideChar := '|';
  201.   UpLftChar := '+';
  202.   UpRtChar := '+';
  203.   LowRtChar := '+';
  204.   LowLftChar := '+';
  205.   Prefix := '';
  206.   PostFix := '';
  207.  
  208.   BoxMode := 1;
  209.   Writeln;
  210.   writeln ('Choose Box Mode :');
  211.   Writeln ('1 = line box,                2 = "*" box');
  212.   Writeln ('3 = Double-line Graphic box, 4 = Single-line graphic box');
  213.   Writeln ('5 = custom box');
  214.   Write ('Enter  ([1], 2, 3, 4, or 5) : ');
  215.   Readln (Boxmode);
  216.  
  217.   Case BoxMode of
  218.   1: Begin  { character line box }
  219.      End;
  220.   2: Begin  { Box of Asterisks }
  221.       TopChar := Boxchar;
  222.       SideChar := BoxChar;
  223.       UpLftChar := BoxChar;
  224.       UpRtChar := BoxChar;
  225.       LowLftChar := Boxchar;
  226.       LowRtChar := BoxChar;
  227.      End;
  228.   3: Begin  { Doouble-line Graphic Box }
  229.       TopChar    := Chr($CD);
  230.       SideChar   := Chr($BA);
  231.       UpLftChar  := Chr($C9);
  232.       UpRtChar   := Chr($BB);
  233.       LowLftChar := Chr($C8);
  234.       LowRtChar  := Chr($BC);
  235.      End;
  236.   4: Begin  { single-line graphic box }
  237.       TopChar    := Chr($C4);
  238.       SideChar   := Chr($B3);
  239.       UpLftChar  := Chr($DA);
  240.       UpRtChar   := Chr($BF);
  241.       LowLftChar := Chr($C0);
  242.       LowRtChar  := Chr($D9);
  243.      End;
  244.  
  245.   5: Begin
  246.        Writeln;
  247.        Write ('Enter Top Line Character     : ');
  248.        Readln (TopChar);
  249.        Write ('Enter Side Character         : ');
  250.        Readln (SideChar);
  251.        Write ('Enter Upper Left Character   : ');
  252.        Readln (UpLftChar);
  253.        Write ('Enter Upper Rt. Character    : ');
  254.        Readln (UpRtChar);
  255.        Write ('Enter Lower Left Character   : ');
  256.        Readln (LowLftChar);
  257.        Write ('Enter Lower Rt. Character    : ');
  258.        Readln (LowRtChar);
  259.      End;
  260.    End;  {Case BoxMode}
  261.  
  262.   Writeln;
  263.   Write ('Use Prefix  (Y/[N]) ? ');
  264.   Begin
  265.     Read (Kbd,Ans);
  266.     Ans := UpCase (Ans);
  267.   end;
  268.   If Ans = 'Y' then
  269.   Begin
  270.     Write ('Enter Prefix string  : ');
  271.     Readln (Prefix);
  272.   End
  273.   else writeln;
  274.  
  275.   Write ('Use Postfix (Y/[N]) ? ');
  276.   Begin
  277.     Read (Kbd,Ans);
  278.     Ans := UpCase (Ans);
  279.   end;
  280.   If Ans = 'Y' then
  281.   Begin
  282.     Write ('Enter Postfix string : ');
  283.     Readln (PostFix);
  284.   End
  285.   else writeln;
  286.  
  287.  
  288.   Write (FileOut,Prefix,UpLftChar);
  289.   For i:= 2 to Width-1 do write (FileOut,TopChar);
  290.   Writeln (FileOut,UpRtChar,Postfix);
  291.   Write (Fileout,Prefix,SideChar);
  292.   For I:= 1 to Width-2 do Write (FileOut,' ');
  293.   Writeln (FileOut, SideChar,PostFix);
  294.  
  295.   LineNo := 0;
  296.   CmdCnt := 0;
  297.  
  298.   While not EOF(FileIn) do
  299.   Begin    { handling input lines }
  300.     Readln (FileIn, TextIn);
  301.     If (Length(TextIn)>2) and (TextIn[1] = '.') then
  302.     Begin
  303.       If TextIn = '.CE' then Mode := Center;
  304.       If TextIn = '.LJ' then Mode := LftJustify;
  305.       If TextIn = '.RJ' then Mode := RtJustify;
  306.       CmdCnt := CmdCnt + 1;
  307.     End
  308.     Else
  309.     Begin { Boxing text lines }
  310.       LineNo := LineNo +1;
  311.       PadLen := Width - 2 - Length(TextIn);
  312.       If PadLen <=0 then
  313.       Begin
  314.         PadLen :=1;
  315.         Writeln ('Warning - Line # ',LineNo+CmdCnt,'in input file too long!');
  316.         Writeln (TextIn);
  317.       End;
  318.       If Mode = Center then
  319.       Begin
  320.         PadLenRt := PadLen Div 2;
  321.         PadLenLeft := PadLen - PadLenRt;
  322.       End;
  323.       If Mode = LftJustify then
  324.       Begin
  325.         PadLenLeft :=1;
  326.         PadLenRt   :=PadLen-PadLenLeft;
  327.       End;
  328.       If Mode = RtJustify then
  329.       Begin
  330.         PadLenRt :=1;
  331.         PadLenLeft := PadLen-PadLenRt;
  332.       End;
  333.  
  334.       Write (FileOut,Prefix,SideChar);
  335.       For i:=1 to PadLenLeft do write (FileOut,' ');
  336.       Write (FileOut,TextIn);
  337.       For I:=1 to PadLenRt do write (FileOut,' ');
  338.       Writeln (FileOut, SideChar,PostFix);
  339.  
  340.     End; { else Box text lines }
  341.  
  342.   End; { While... handle input lines }
  343.  
  344.   Write (FileOut,Prefix,SideChar);
  345.   For I:=1 to Width -2 do Write (FileOut,' ');
  346.   Writeln (FileOUt, SideChar,PostFix);
  347.   Write (FileOut,Prefix,LowLftChar);
  348.   For I:=2 to Width-1 do write (FileOut,TopChar);
  349.   Writeln (FileOut,LowRtChar,PostFix);
  350.  
  351.   Close (FileIn);
  352.   Close (FileOut);
  353.  
  354.   Writeln;
  355.   Writeln (LineNo,' text lines read from input file.');
  356.   Writeln (CmdCnt,' justify commands in input file.');
  357.   Writeln (LineNo+4,' lines written to ',BoxFile,'.');
  358.  
  359.   Writeln;
  360.   Write ('View Boxed Text ([Y]/N) ? ');
  361.   Read (Kbd,Ans);
  362.   Ans := UpCase (Ans);
  363.   Writeln (Ans);
  364.   Writeln;
  365.  
  366.   If not (ans = 'N') then Begin  { View output file }
  367.   assign (ViewIn,BoxFile);
  368.   Reset (ViewIn);
  369.   Repeat
  370.   Begin
  371.     Readln (ViewIn, TextIn);
  372.     Writeln (TextIn);
  373.   End;
  374.   Until EOF (ViewIn);
  375.   Close (ViewIn);
  376.   End;  { view output file }
  377.  
  378. End.  { program BOX }