home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / A2P.ZIP / A2P.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-11-11  |  2.9 KB  |  117 lines
  1.  
  2. program A2P;
  3.  
  4. {$A+,B+,D-,E-,F-,I-,L-,N-,O-,R-,S-,V+}
  5.  
  6. uses
  7.   crt, dos;
  8.  
  9. const
  10.   ScreenWidth = 80;
  11.  
  12. type
  13.   FileNameType = string[14];
  14.  
  15. var
  16.   InFile, OutFile          : text;
  17.   InString                 : string[ScreenWidth];
  18.   Index                    : byte;
  19.   InFileName, OutFileName  : FileNameType;
  20.   FirstPart                : string[8];
  21.  
  22.  
  23.   procedure NameOutFile(InFileName : FileNameType; var OutFileName : FileNameType);
  24.  
  25.   var
  26.     DotMarker, Index : byte;
  27.  
  28.   begin
  29.     DotMarker := pos('.', InFileName);
  30.     if DotMarker = 0 then
  31.       FirstPart := InFileName
  32.     else
  33.       FirstPart := copy(InFileName, 1, (DotMarker - 1));
  34.     OutFileName := concat(FirstPart, '.A2P')
  35.   end;
  36.  
  37.  
  38.  
  39.   procedure UserPrompt;
  40.  
  41.   begin
  42.     writeln;
  43.     writeln('  New file with ''A2P'' extension will be created.');
  44.     writeln;
  45.     if paramcount = 0 then
  46.       begin
  47.         write('  Enter name of file to be converted: ');
  48.         readln(InFileName)
  49.       end
  50.     else
  51.       InFileName := paramstr(1);
  52.     NameOutFile(InFileName, OutFileName)
  53.   end;
  54.  
  55.  
  56.   procedure ConvertAscii;
  57.  
  58.   var
  59.     LeadingBlanks  : boolean;
  60.     Y_Axis, X_Axis : byte;
  61.     TempString     : string[ScreenWidth];
  62.  
  63.   begin
  64.     Y_Axis := 0;
  65.     assign(InFile, InFileName);        (* Assign file to file variable *)
  66.     reset(InFile);                     (* Point to beginning of disk file *)
  67.     assign(OutFile, OutFileName);
  68.     rewrite(OutFile);
  69.     writeln(OutFile, '');
  70.     writeln(OutFile, 'program ', FirstPart, ';');
  71.     writeln(OutFile, '');
  72.     writeln(OutFile, 'uses');
  73.     writeln(OutFile, '  crt;');
  74.     writeln(OutFile, '');
  75.     writeln(OutFile, 'BEGIN');
  76.     writeln(OutFile, '  clrscr;');
  77.     repeat
  78.       LeadingBlanks := true;
  79.       X_Axis := 0;
  80.       TempString := '';
  81.       readln(InFile, InString);        (* Read in first line of disk file *)
  82.       if length(InString) = 0 then
  83.         inc(Y_Axis)
  84.       else
  85.         begin
  86.           for Index := 1 to length(InString) do
  87.             begin
  88.               if (InString[Index] = ' ') and LeadingBlanks = true then
  89.                 inc(X_Axis)
  90.               else
  91.                 begin
  92.                   LeadingBlanks := false;
  93.                   TempString := concat(TempString + InString[Index])
  94.                 end;
  95.               if InString[Index] = '''' then (* Single quotation mark *)
  96.                 TempString := concat(TempString + '''')
  97.             end;
  98.           inc(Y_Axis);
  99.           inc(X_Axis);
  100.           writeln(OutFile, '  gotoxy(', X_Axis, ',', Y_Axis, ');');
  101.           writeln(OutFile, '  writeln(''', TempString, ''');')
  102.         end;
  103.     until eof(InFile);
  104.     writeln(OutFile, 'END.');
  105.     close(InFile);
  106.     close(OutFile)
  107.   end;
  108.  
  109. BEGIN
  110.   clrscr;
  111.   UserPrompt;
  112.   ConvertAscii;
  113.   writeln;
  114.   writeln(' Conversion complete!');
  115.   writeln
  116. END.
  117.