home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol019 / conchar.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  6KB  |  210 lines
  1. (********************************************************
  2. **  PROGRAM TITLE:    ConChar
  3. **
  4. **  WRITTEN BY:        RAYMOND E. PENLEY
  5. **  DATE WRITTEN:    19 June 1980
  6. **
  7. **  WRITTEN FOR:    PASCAL/Z USERS
  8. **
  9. **
  10. ********************************************************)
  11. Program CONCHARDEMO;
  12. LABEL    999; { Fatal error }
  13. CONST
  14.   default = 80;        { Default length of strings }
  15.   input   = 0;        { *** Implementation dependent *** }
  16.   strmax  = 255;
  17.   space   = ' ';
  18. TYPE
  19.   Linebuffer = STRING 80;{ Command line input buffer }
  20. (*---Pascal/Z needs these TYPE definitions---<UGLY UGLY UGLY>---*)
  21.   str0       = STRING 0 ;
  22.   str255   = STRING strmax;
  23. VAR
  24.   bell        : char;
  25.   Cmlline    : STRING default;{ this prgms Console input buffer }
  26.   Cmllen    : integer;
  27.   fatal_error    : boolean;
  28.   Text_file,
  29.   Work_file    : Text;
  30.  
  31. (*---Pascal/Z needs these definitions---<UGLY UGLY UGLY>---*)
  32. Function length(x: str255): integer; external;
  33. Procedure setlength(var x: str0; y: integer); external;
  34.  
  35. Procedure GCML( VAR Line : Linebuffer;
  36.         VAR len  : integer );
  37. {    Read the system input buffer.
  38.     This MUST be the first read in the
  39.     entire program.
  40. RETURNS:
  41.   len = 0 if buffer is empty
  42.     else the length of line
  43.   Line = operating system buffer
  44.      <in uppercase>
  45.  
  46. GLOBAL    Linebuffer : string 80;
  47. }
  48. begin
  49.   setlength(line,0);
  50.   len := 0;
  51.   If not eoln(input) then
  52.     begin{  read from the input buffer  }
  53.     readln(line);
  54.     len := length(line);
  55.     end{  read from the input buffer  };
  56. End{of GCML};
  57.  
  58. Procedure ConnectFiles;
  59. LABEL    3;
  60. CONST    FSpecLeng = 14;    { Max length of total CP/M file Identifier }
  61.  
  62. TYPE       fspecs = array[1..FSpecLeng] of char;
  63.     FileSpecs = array[1..2] of fspecs;
  64.     extension = array[1..4] of char;
  65.     FileNames = array[1..FSpecLeng] of char;
  66.  
  67. VAR    fspec: FileSpecs;
  68.      flen: 0..FSpecLeng;
  69.        Cmlptr: 1..80;
  70.     CmlCh: char;
  71. ext_specified: boolean;
  72.       pos: 0..255;
  73.  
  74.    Procedure FILE_SCAN;
  75.    begin
  76.    (* OPEN file "fspec[2]" for READ<INPUT> assign Text_file *)
  77.     RESET(fspec[2],Text_file);
  78.      If not EOF(Text_file) then
  79.    (* OPEN file "fspec[1]" for WRITE<OUTPUT> assign Work_File *)
  80.     REWRITE(fspec[1],Work_File)
  81.       Else
  82.         begin
  83.           Write('File ', fspec[2],'not found.');
  84.           {EXIT}fatal_error := true;
  85.         end;
  86.    end{of file scan};
  87.  
  88.    Procedure QUIT;
  89.    begin
  90.      Writeln(bell,' Command Line error.');
  91.      Writeln('Your Command line --->',Cmlline);
  92.      Writeln('You entered ',Cmllen:3,' characters');
  93.      writeln;
  94.      write(  '< (dr unit:)Input File name.PAS > ');
  95.      writeln('< (dr unit:)Output File name(.XRF) >');
  96.      writeln;
  97.      writeln('Input file must be a Pascal progam.');
  98.      writeln('Output file name may have an extension of your choice.');
  99.      writeln('If not specified the output file ext = .XRF');
  100.      writeln('() = otional');
  101.      writeln;writeln;
  102.      fatal_error := true;
  103.    end;
  104.  
  105.    Procedure Next_ClmCh;
  106.    begin
  107.      If (Cmlptr >= Cmllen) then fatal_error := true
  108.      Else
  109.        begin
  110.      Cmlptr := Cmlptr + 1;
  111.      CmlCh := Cmlline[Cmlptr];
  112.        end;
  113.    end;
  114.  
  115.    Procedure GetFspec( IO: integer; dfltext: extension );
  116.    LABEL    4;
  117.  
  118.       Procedure Get_Next;
  119.       begin
  120.         If (flen >= FSpecLeng) then fatal_error := true
  121.     Else
  122.       begin
  123.          FSPEC[IO][flen] := CmlCh;
  124.              flen := flen + 1;
  125.          Next_ClmCh;
  126.       end;
  127.       end;
  128.  
  129.    begin{ get fspec }
  130.      FSPEC[IO] := '              ';
  131.      flen := 1;
  132.      ext_specified := false;
  133.      while CmlCh IN ['A'..'Z','0'..'9',':','.'] do
  134.        begin
  135.          If not ext_specified then
  136.         ext_specified := (CmlCh='.');
  137.          Get_Next;If fatal_error then{EXIT}goto 4;
  138.        end;
  139.      If (flen > 1) and (not ext_specified) then
  140.        for pos := 1 to 4 do
  141.          begin
  142.        FSPEC[IO][flen] := dfltext[pos];
  143.        flen := flen + 1;
  144.          end;
  145.    4:
  146.    end{ Get Fspec };
  147.  
  148. begin{  ConnectFiles  }
  149. {  Read the system input buffer into Cmlline   }
  150.   GCML(CmlLine,Cmllen);
  151.   If (Cmllen=0) then{EXIT}
  152.      begin fatal_error := true;goto 3 end;
  153.   CmlCh := CmlLine[1];
  154.   Cmlptr := 1;
  155.   Cmllen := Cmllen + 1;
  156.   CmlLine[Cmllen] := space;
  157.   While (CmlCh = space) AND (not fatal_error) do Next_ClmCh;
  158.   Getfspec(2,'.PAS');
  159.   If flen=1 then
  160.     begin
  161.     Write( 'No Input File Specified.');
  162.     fatal_error := true;
  163.     {EXIT}goto 3;
  164.     end;
  165.   Next_ClmCh;
  166.   While (CmlCh = space) AND (not fatal_error) do Next_ClmCh;
  167.   Getfspec(1,'.XRF');
  168.   If flen=1 then
  169.     begin
  170.     Write( 'No Output File Specified.');
  171.     fatal_error := true;
  172.     {EXIT}goto 3;
  173.     end;
  174.    FILE_SCAN;
  175. 3: If fatal_error then QUIT;
  176. end{ Connect files };
  177.  
  178. Procedure Initialize;
  179. LABEL    5;
  180. begin
  181.   fatal_error := false;
  182.   bell := chr(7);
  183.   ConnectFiles;
  184.   If fatal_error then goto 5;
  185.   {                    }
  186.   {  continue with initialization now   }
  187.   {                    }
  188. 5:
  189. end;
  190.  
  191. begin(*---ConChar Demo---*)
  192.   writeln(' ':15,'---   Command Line Input Demo  ---');
  193.   writeln;writeln;
  194.   writeln('This program reads directly from the system buffer.');
  195.   writeln('Proper execution will provide your program with:');
  196.   writeln(' 1. a drive unit and a file name so you can');
  197.   writeln('    open a file for input.');
  198.   writeln(' 2. A drive unit and a file name for an output');
  199.   writeln('    file. The extension defaults to .XRF if not specified.');
  200.   Writeln('Execute this program like so:');
  201.   writeln('   CONCHAR  A:input file.PAS  B:output file.XRF');
  202.   writeln;writeln;
  203.   Initialize;
  204.   If fatal_error then{HALT} goto 999;
  205.   Writeln('---End of program');
  206.   writeln;
  207. 999:{Fatal error}
  208. end.
  209.  
  210.