home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol062 / stdio.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.5 KB  |  151 lines
  1. EXTERNAL KFORMAT::STDIO;
  2.  
  3. {++++++++++++++++++++++++++++++++++++++++}
  4. {+    STANDARD FILE IO MODULE        +}
  5. {++++++++++++++++++++++++++++++++++++++++}
  6. {
  7. WRITTEN BY:    Raymond E. Penley
  8. DATE WRITTEN:  March 13, 1981
  9. }
  10. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  11.      DECLARE THE FOLLOWING IN YOUR MAIN PROGRAM.
  12. CONST
  13.   DEFAULT    = 80;
  14.   SMAX        = 255;
  15.   space     = ' ';
  16.   maxargc    = 5;    < maximum # of words you expect to parse >
  17.             < out of the Command line.         >
  18.  
  19. TYPE
  20.   byte        = 0..255;
  21.   int        = INTEGER;
  22.   DSTRING    = string default;
  23.   MSTRING    = STRING SMAX;
  24.   S$0        = string 0;
  25.   S$255     = string 255;
  26.  
  27. VAR
  28.   argc : byte;
  29.   argv : ARRAY [1..maxargc] OF DSTRING;
  30.   infile,
  31.   outfile,
  32.   params : byte;
  33.   inbuf : MSTRING;
  34.   ioresult,
  35.   con_wanted,
  36.   printer_wanted : boolean;
  37.   stdin,
  38.   stdout    : TEXT;
  39.  
  40. PROCEDURE HALT(message:MSTRING);EXTERNAL;
  41.  
  42. ++++++++++++++++++++++++++++++++++++++++++++++++++++}
  43.  
  44. {$C-}{ CONTROL-C CHECKING OFF }
  45. {$M-}{ INTEGER MULT & DIVD ERROR CHECKING OFF }
  46. {$F-}{ FLOATING POINT ERROR CHECKING OFF }
  47.  
  48.  
  49. {$iOPEN.LIB }
  50.  
  51. {$iGCML.LIB }
  52.  
  53.  
  54. PROCEDURE PARSE(inbuf: MSTRING);
  55. var    idlen,cpos: int;
  56. begin
  57.   append(inbuf,' ');
  58.   for argc := 1 to maxargc do setlength(argv[argc],0);
  59.   argc := 0;
  60.   cpos := 1;
  61.      WHILE cpos < length(inbuf) DO
  62.        BEGIN
  63.      WHILE (cpos < length(inbuf)) AND (inbuf[cpos]=space) DO
  64.        cpos := cpos + 1; { skip over spaces  }
  65.      idlen := 0;
  66.      argc := argc + 1;
  67.      WHILE (cpos < length(inbuf)) AND (inbuf[cpos]<>space) DO
  68.        BEGIN {accept only non-space}
  69.          idlen := idlen + 1;
  70.          append( argv[argc], inbuf[cpos] );
  71.          cpos := cpos + 1;
  72.        END;
  73.        END; {WHILE cpos<length(inbuf)}
  74. end;
  75.  
  76.  
  77. PROCEDURE STDOPEN;
  78. BEGIN
  79.   xeof := false;
  80.   xeoln := false;
  81.   infile  := 1;  { argv[1] should be the input file. }
  82.   outfile := 2;  { argv[2] should be the output file. }
  83.   params  := 3;  { argv[3] should hold any optional parameters }
  84.  
  85.   GCML(inbuf);
  86.  
  87.   if length(inbuf)<>0 then
  88.     begin  PARSE(inbuf);
  89.        { open input file }
  90.        OPEN(argv[infile],'I',stdin);
  91.        if ioresult=false then HALT(' ');
  92.        { open output file                }
  93.        { if no file specified then default=LST: }
  94.        if length(argv[outfile])=0 then argv[outfile] := 'LST:';
  95.        OPEN(argv[outfile],'O',stdout);
  96.        if ioresult=false then HALT(' ');
  97.     end
  98. END { * STD OPEN * };
  99.  
  100.  
  101. PROCEDURE getc(VAR ch: char);    {$R-}{ * RANGE CHECKING OFF * }
  102. BEGIN
  103.   xeof := false;
  104.   IF NOT EOF(stdin) THEN
  105.     READ(stdin,ch);
  106.   IF EOF(stdin) THEN
  107.     begin ch := ' ';
  108.       xeof := true;
  109.     end
  110.   else if ch=chr(5) then    { * end of file on the console? * }
  111.     xeof := true;        { * do eof stuff if yes     * }
  112. end;                {$R+}{ * RANGE CHECKING ON    * }
  113.  
  114.  
  115. PROCEDURE putc(c:CHAR);
  116. BEGIN
  117.   if c=newline
  118.     then writeln(stdout)
  119.     else WRITE(stdout,c);    {output the character}
  120. END;
  121.  
  122.  
  123. PROCEDURE puts(VAR LINE:MSTRING);
  124. var    i:int;
  125. BEGIN
  126.    for i:=1 to length(LINE) do putc( LINE[i] );
  127. END;
  128.  
  129.  
  130. procedure gets(var inbuf:MSTRING);
  131. { * this version of gets() specially modified for kformat.pas * }
  132. (* GLOBAL:
  133.        newline, xeof, SMAX, stdin *)
  134. var    ch: char;
  135. BEGIN
  136.   setlength(inbuf,0);            { * inbuf := ''; * }
  137.   WHILE not eoln(stdin) and not xeof do
  138.     begin
  139.       getc(ch);
  140.       If ORD(ch)>127 then ch := CHR( ORD(ch)-127 );
  141.       If length(inbuf) < SMAX then (* start accepting characters *)
  142.     append(inbuf, ch)
  143.     end;
  144.   READLN(stdin); {+++ ignore the line boundary +++}
  145.   append(inbuf,newline);        { *** MAR 81 *** }
  146. end;
  147.  
  148.  
  149. {END EXTERNAL}.
  150.  
  151.