home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / cpyform.lzh / CPYFORM.EXE / arc / FCFC.PAS < prev   
Pascal/Delphi Source File  |  1987-06-03  |  4KB  |  167 lines
  1. Program First_Character_File_Control;
  2.  
  3. {
  4.   3.11  87-06-03  Handle blank lines correctly !
  5.   3.10  87-04-13  Add total file size and characters processed display;
  6.                   Test for file existence;
  7.                   Create output file as *.prn if not equal to input file;
  8. }
  9.  
  10. Const
  11.   NL   = #13#10;
  12.   CR   = #13;
  13.   LF   = #10;
  14.   FF   = #12;
  15.  
  16. Type
  17.   Str255 = String[255];
  18.  
  19. Var
  20.   Ch          : Char;
  21.   OutName,
  22.   OutLine,
  23.   Line        : Str255;
  24.   Line_Len    : Byte Absolute Line;
  25.   File_Size,
  26.   Line_In,
  27.   Char_In,
  28.   Line_Out,
  29.   Char_Out    : Real;
  30.   Disp_Idx,
  31.   X           : Integer;
  32.   SizeOpen    : File of Byte;
  33.   Inp         : Text[4096];
  34.   Out         : Text[7168];
  35.   Err         : Text;
  36.  
  37. Procedure CTLASA( Ch : Char );
  38.   Begin;
  39.     Case Ch
  40.       Of
  41.         ' ':            { 1 Line }
  42.           Begin;
  43.             Write( Out, NL:2 );
  44.             Char_Out := Char_Out + 2.0;
  45.             Line_Out := Line_Out + 1.0;
  46.           End;
  47.         '0':            { 2 Lines }
  48.           Begin;
  49.             Write( Out, NL:2, NL:2 );
  50.             Char_Out := Char_Out + 4.0;
  51.             Line_Out := Line_Out + 2.0;
  52.           End;
  53.         '-':             { 3 lines }
  54.           Begin;
  55.             Write( Out, NL:2, NL:2, NL:2 );
  56.             Char_Out := Char_Out + 6.0;
  57.             Line_Out := Line_Out + 3.0;
  58.           End;
  59.         '1':             { Form Feed - Line added ! }
  60.           Begin;
  61.             Write( Out, NL:2, FF:1 );
  62.             Char_Out := Char_Out + 3.0;
  63.             Line_Out := Line_Out + 1.0;
  64.           End;
  65.         '+':             { NO SPACING - Cr ONLY }
  66.           Begin;
  67.             Write( Out, CR:1 );
  68.             Char_Out := Char_Out + 1.0;
  69.           End;
  70.         Else
  71.           Begin;
  72.             { nothing ! } ;
  73.           End;
  74.       End;
  75.   End;  { CTLASA }
  76.  
  77. Begin;
  78.   Disp_Idx := 9;
  79.   Assign(Err,'ERR:');                  { MSDOS Handle #2 }
  80.   Rewrite( Err );
  81.   Writeln(Err);
  82.   Writeln(Err,'First Character File Control   V/M 3.10    87-04-13  PRW');
  83.   Writeln(Err);
  84.  
  85.   If (ParamCount < 1) or (ParamStr(1) = '?') Then
  86.     Begin;
  87.       Writeln(Err,'Usage format:  FCFC  infile  [outfile]');
  88.       Writeln(Err,'  -- Input file name required.');
  89.       WriteLn(Err,'     Output file will be input name with ".PRN" ending.');
  90.       Writeln(Err,'  -- Output file may be "PRN" to output to printer.');
  91.       Halt;
  92.     End;
  93.  
  94.   Line := ParamStr(1);
  95.   If (ParamCount = 1) Then
  96.     Begin;
  97.       X := Pos('.',Line);
  98.       If X > 0 Then OutName := Copy(Line,1,X-1) + '.PRN'
  99.       Else          OutName := Line + '.PRN';
  100.     End
  101.   Else
  102.     OutName := ParamStr(2);
  103.   Assign(SizeOpen, Line);
  104. {$I-}
  105.   Reset( SizeOpen );
  106. {$I+}
  107.   If IOresult <> 0 Then
  108.     Begin;
  109.       Writeln(Err,'File "'+Line+'" not found !');
  110.       Writeln(err);
  111.       Halt;
  112.     End;
  113.   File_Size := LongFileSize(SizeOpen);
  114.   Close( SizeOpen );
  115.   Assign(Inp,Line);
  116.   Reset( Inp );
  117.   Assign(Out,OutName);
  118.   Rewrite( Out );
  119.   Writeln(Err,'Input = "',Line,'"        Output = "',OutName,'"',NL);
  120.   Char_In  := 1.0;                     { EOF Character !! }
  121.   Line_In  := 0.0;
  122.   Char_Out := 0.0;
  123.   Line_Out := 0.0;
  124.   Write(Err,CR,Char_In:8:0,' Processed of',File_Size:8:0,' Characters.');
  125.   While Not EOF( Inp ) Do
  126.     Begin;
  127.       ReadLn ( Inp, Line );
  128.       Char_In := Char_In + Line_Len + 2.0;
  129.       Line_In := Line_In + 1.0;
  130.       Case Line_Len
  131.         Of
  132.           0:
  133.             Begin;
  134.               CTLASA(' ');    { Space 1 line }
  135.             End;
  136.           1:
  137.             Begin;
  138.               CTLASA( Line[1] );
  139.             End;
  140.           Else
  141.             Begin;
  142.               CTLASA ( Line[1] );
  143.               X := Pred(Line_Len);
  144.               Move (Line[2],Outline[1],X);
  145.               OutLine[0] := Char(X);
  146.               Write( Out, OutLine );
  147.               Char_Out := Char_Out + X;
  148.             End;
  149.         End;
  150.       Disp_Idx := Succ(Disp_Idx);
  151.       If Disp_Idx = 10 Then
  152.         Begin;
  153.           Disp_Idx := 1;
  154.           Write(Err,CR,Char_In:8:0);
  155.         End;
  156.     End;
  157.   Write(Err,CR,Char_In:8:0);
  158.   CTLASA ('1');                         { New Page }
  159.   Close ( Out );
  160.   Close ( Inp );
  161.   Writeln(Err,NL:2);
  162.   Writeln(Err,'Input:  ',Char_In:8:0 ,' Char',Line_In:8:0 ,' Lines');
  163.   Writeln(Err,'Output: ',Char_Out:8:0,' Char',Line_Out:8:0,' Lines');
  164.   Writeln(Err);
  165.   Flush(Err);
  166. End.
  167.