home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / os2pm / files.mod < prev    next >
Encoding:
Modula Implementation  |  2020-01-01  |  3.6 KB  |  141 lines
  1. IMPLEMENTATION MODULE Files;   (* File I/O for KXCom *)
  2.  
  3.    FROM FileSystem IMPORT
  4.       File, Response, Lookup, Close, ReadNBytes, WriteNBytes;
  5.  
  6.    FROM Conversions IMPORT
  7.       CardToString;
  8.  
  9.    FROM SYSTEM IMPORT
  10.       ADR, SIZE;
  11.  
  12.    CONST
  13.       NEARFULL = 400;
  14.  
  15.    TYPE
  16.       buffer = ARRAY [1..512] OF CHAR;
  17.  
  18.  
  19.    VAR
  20.       inBuf, outBuf : buffer;
  21.       inP, outP : CARDINAL;   (* buffer pointers *)
  22.       read, written : CARDINAL;   (* number of bytes read or written *)
  23.                                   (* by ReadNBytes or WriteNBytes    *)
  24.  
  25.  
  26.    PROCEDURE Open (VAR f : File; name : ARRAY OF CHAR) : Status;
  27.    (* opens an existing file for reading, returns status *)
  28.       BEGIN
  29.          Lookup (f, name, FALSE);
  30.          IF f.res = done THEN
  31.             inP := 0;   read := 0;
  32.             RETURN Done;
  33.          ELSE
  34.             RETURN Error;
  35.          END;
  36.       END Open;
  37.  
  38.  
  39.    PROCEDURE Create (VAR f : File; name : ARRAY OF CHAR) : Status;
  40.    (* creates a new file for writing, returns status *)
  41.  
  42.       VAR
  43.          i : CARDINAL;
  44.          b : BOOLEAN;
  45.          ext : CARDINAL;  (* new file extensions to avoid name conflict *)
  46.  
  47.       BEGIN
  48.          ext := 0;
  49.          LOOP
  50.             Lookup (f, name, FALSE);   (* check to see if file exists *)
  51.             IF f.res = done THEN   (* Filename Clase: Change file name *)
  52.                Close (f);
  53.                IF ext > 99 THEN   (* out of new names... *)
  54.                   RETURN Error;
  55.                END;
  56.                i := 0;
  57.                WHILE (name[i] # 0C) AND (name[i] # '.') DO
  58.                   INC (i);   (* scan for end of filename *)
  59.                END;
  60.                name[i] := '.';
  61.                INC (i);   name[i] := 'K';
  62.                INC (i);   name[i] := 0C;
  63.                CardToString (ext, 1, name, i, b);
  64.                INC (ext);
  65.             ELSE
  66.                EXIT;
  67.             END;
  68.          END;
  69.          Lookup (f, name, TRUE);
  70.          IF f.res = done THEN
  71.             outP := 0;
  72.             RETURN Done;
  73.          ELSE
  74.             RETURN Error;
  75.          END;
  76.       END Create;
  77.  
  78.  
  79.    PROCEDURE CloseFile (VAR f : File; Which : FileType) : Status;
  80.    (* closes a file after reading or writing *)
  81.       BEGIN
  82.          written := outP;
  83.          IF (Which = Output) AND (outP > 0) THEN
  84.             WriteNBytes (f, ADR (outBuf), outP);
  85.             written := f.count;
  86.          END;
  87.          Close (f);
  88.          IF (written = outP) AND (f.res = done) THEN
  89.             RETURN Done;
  90.          ELSE
  91.             RETURN Error;
  92.          END;
  93.       END CloseFile;
  94.  
  95.  
  96.    PROCEDURE Get (VAR f : File; VAR ch : CHAR) : Status;
  97.    (* Reads one character from the file, returns status *)
  98.       BEGIN
  99.          IF inP = read THEN
  100.             ReadNBytes (f, ADR (inBuf), SIZE (inBuf));
  101.             read := f.count;
  102.             inP := 0;
  103.          END;
  104.          IF read = 0 THEN
  105.             RETURN EOF;
  106.          ELSE
  107.             INC (inP);
  108.             ch := inBuf[inP];
  109.             RETURN Done;
  110.          END;
  111.       END Get;
  112.  
  113.  
  114.    PROCEDURE Put (ch : CHAR);
  115.    (* Writes one character to the file buffer *)
  116.       BEGIN
  117.          INC (outP);
  118.          outBuf[outP] := ch;
  119.       END Put;
  120.  
  121.  
  122.    PROCEDURE DoWrite (VAR f : File) : Status;
  123.    (* Writes buffer to disk only if nearly full *)
  124.       BEGIN
  125.          IF outP < NEARFULL THEN   (* still room in buffer *)
  126.             RETURN Done;
  127.          ELSE
  128.             WriteNBytes (f, ADR (outBuf), outP);
  129.             written := f.count;
  130.             IF (written = outP) AND (f.res = done) THEN
  131.                outP := 0;
  132.                RETURN Done;
  133.             ELSE
  134.                RETURN Error;
  135.             END;
  136.          END;
  137.       END DoWrite;
  138.  
  139. BEGIN (* module initialization *)
  140. END Files.
  141.