(*-------------------------------------------------------------------------

  Amiga Oberon Library Module: FileSystem
  Adapted for AmokEd!!

  © 1990 by Fridtjof Siebert

:Date: 27 Aug 1991 18:16:05
:History.    Mai 1991 Volker Rudolph +ReadStringLen
:History. 08 Aug 1991 hartmut Goebel +ReadStringLenTab
-------------------------------------------------------------------------*)

(*-------------------------------------------------------------------------

   Dieses Modul erleichtert das Arbeiten mit Dateien. Es stellt Prozeduren
   zur Dateiverwaltung zur Verfügung.

   Die Geschwindigkeit liegt normalerweise über der von Dos, da beim Lesen
   und Schreiben Puffer verwendet werden.

   Die Prozeduren, die ein boolsches Ergebnis liefern, waren immer
   erfolgreich, wenn sie TRUE zurückliefern. Ansonsten steht in der
   Variable File.status die Fehlernummer, die eine genauere Diagnose der
   Fehlerursache erlaubt.

   Die Prozedur Delete() macht das gleiche wie Close(), löscht danach aber
   die bearbeitete Datei.

-------------------------------------------------------------------------*)
(* $Debug- *)
MODULE EdFileSystem;

IMPORT d*: Dos,
       sd: EdSecureDos;

CONST
  BufSize = 1024;

(* File.status: *)

  ok        * = 0;  (* alles in Ordnung   *)
  eof       * = 1;  (* Dateiende erreicht *)
  readerr   * = 2;  (* Lesefehler         *)
  writeerr  * = 3;  (* Schreibfehler      *)
  onlyread  * = 4;  (* aus Datei darf nur gelesen werden    *)
  onlywrite * = 5;  (* in Datei darf nur geschrieben werden *)
  toofar    * = 6;  (* mit Move, Forward oder Backward zu weit gesprungen *)
  outofmem  * = 7;  (* kein freier Speicher mehr *)
  cantopen  * = 8;  (* konnte Datei nicht öffnen *)
  cantlock  * = 9;  (* konnte Datei nicht locken *)

TYPE
  FilePtr * = POINTER TO File;
  File * = RECORD

             handle * : d.FileHandlePtr;
             status * : INTEGER;
             write  * : BOOLEAN;
             read   * : BOOLEAN;
             name   * : ARRAY 256 OF CHAR;

             buffer : POINTER TO ARRAY BufSize OF BYTE;
             bufpos : INTEGER;
             buflen : LONGINT;
             pos    : LONGINT;
             size   : LONGINT;
             lastRead : BOOLEAN;
           END;

VAR
  info: d.FileInfoBlock;


(*-------------------------------------------------------------------------*)


(*------  Open:  ------*)


PROCEDURE Open*(VAR file: File;
                    name: ARRAY OF CHAR;
                    write: BOOLEAN): BOOLEAN;

(* öffnet die Datei mit dem Namen 'name'. Ist write TRUE, wird die Datei
   neu erzeugt und zum Schreiben geöffnet. Sonst wird sie zum Lesen
   geöffnet. Das Ergebnis ist TRUE, wenn alles ordnungsgemäß verlief. *)

VAR
  mode: INTEGER;
  lock: d.FileLockPtr;

BEGIN
  file.buffer := NIL; file.handle := NIL; lock := NIL;
  LOOP
    NEW(file.buffer); IF file.buffer=NIL THEN file.status := outofmem; EXIT END;
    COPY(name,file.name);
    IF write THEN mode := d.newFile
             ELSE mode := d.oldFile END;
    file.handle := sd.Open(name,mode);
    IF file.handle = NIL THEN file.status := cantopen; EXIT END;
    IF write THEN
      file.size := 0;
    ELSE
      lock := sd.Lock(name,d.sharedLock);
      IF lock=NIL                 THEN file.status := cantlock; EXIT END;
      IF NOT d.Examine(lock,info) THEN file.status := cantlock; EXIT END;
      file.size := info.size;
      sd.UnLock(lock);
    END;
    file.bufpos := 0;
    file.buflen := 0;
    file.pos    := 0;
    file.write  := write;
    file.read   := ~ write;
    file.status := ok;
    RETURN TRUE;
  END;
  IF file.buffer#NIL THEN DISPOSE(file.buffer) END;
  IF file.handle#NIL THEN sd.Close(file.handle); file.handle := NIL END;
  IF lock#NIL THEN sd.UnLock(lock) END;
  RETURN FALSE;
END Open;


(*------  OpenReadWrite:  ------*)


PROCEDURE OpenReadWrite*(VAR file: File;
                         name: ARRAY OF CHAR): BOOLEAN;

(* öffnet die Datei mit dem Namen 'name' zum wechselnd schreibenden
   und lesenden Zugriff. Das Ergebnis ist TRUE, wenn alles
   ordnungsgemäß verlief. *)

VAR
  lock: d.FileLockPtr;

BEGIN
  file.buffer := NIL; file.handle := NIL; lock := NIL;
  LOOP
    NEW(file.buffer); IF file.buffer=NIL THEN file.status := outofmem; EXIT END;
    COPY(name,file.name);
    file.handle := sd.Open(name,d.oldFile);
    IF file.handle # NIL THEN
      lock := sd.Lock(name,d.sharedLock);
      IF lock=NIL                 THEN file.status := cantlock; EXIT END;
      IF NOT d.Examine(lock,info) THEN file.status := cantlock; EXIT END;
      file.size := info.size;
      sd.UnLock(lock);
    ELSE
      file.handle := sd.Open(name,d.newFile);
      IF file.handle = NIL THEN file.status := cantopen; EXIT END;
      file.size := 0;
    END;
    file.bufpos := 0;
    file.buflen := 0;
    file.pos    := 0;
    file.write  := TRUE;
    file.read   := TRUE;
    file.status := ok;
    RETURN TRUE;
  END;
  IF file.buffer#NIL THEN DISPOSE(file.buffer) END;
  IF file.handle#NIL THEN sd.Close(file.handle); file.handle := NIL END;
  IF lock#NIL THEN sd.UnLock(lock) END;
  RETURN FALSE;
END OpenReadWrite;


PROCEDURE WriteBuf(VAR file: File): BOOLEAN;

VAR i,j,l: INTEGER;

BEGIN
  i := 0; j := file.bufpos; file.bufpos := 0;
  REPEAT
    l := SHORT(d.Write(file.handle,file.buffer[i],j));
    IF l<0 THEN
      file.status := writeerr;
      RETURN FALSE
    END;
    INC(i,l); DEC(j,l);
  UNTIL j<=0;
  file.status := ok;
  RETURN TRUE;
END WriteBuf;



PROCEDURE EmptyWriteBuf(VAR file: File): BOOLEAN;

BEGIN
  IF file.write AND (file.bufpos#0) THEN RETURN WriteBuf(file) END;
  file.status := ok;
  RETURN TRUE;
END EmptyWriteBuf;


(*------  Close:  ------*)


PROCEDURE Close*(VAR file: File): BOOLEAN;

(* schließt die Datei file. Ergebnis ist TRUE, wenn alles korrekt verlief.
*)

VAR res: BOOLEAN;

BEGIN
  file.status := ok;
  res := TRUE;
  IF file.write AND (NOT file.read OR NOT file.lastRead) THEN
    res := EmptyWriteBuf(file);
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := TRUE;
  END;
  sd.Close(file.handle); file.handle := NIL;
  DISPOSE(file.buffer);
  RETURN res;
END Close;


(*-------------------------------------------------------------------------*)


(*------  Read:  ------*)


PROCEDURE Read*(VAR file: File; VAR to: ARRAY OF BYTE): BOOLEAN;

(* liest LEN(to) Bytes aus file nach to. Ergebnis ist TRUE, wenn alles
korrekt verlieft. *)

VAR
  cnt: INTEGER;
  bufpos: INTEGER;

BEGIN
  IF NOT file.read THEN file.status := onlywrite; RETURN FALSE END;
  IF file.write AND NOT file.lastRead THEN
    IF NOT EmptyWriteBuf(file) THEN RETURN FALSE END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := TRUE;
  END;
  cnt := 0; bufpos := file.bufpos;
  WHILE cnt<LEN(to) DO
    IF (bufpos=file.buflen) THEN
      file.bufpos := 0; bufpos := 0;
      file.buflen := d.Read(file.handle,file.buffer^,BufSize);
      IF file.buflen=0 THEN file.status := eof;     RETURN FALSE END;
      IF file.buflen<0 THEN file.status := readerr; RETURN FALSE END;
    END;
    to[cnt] := file.buffer[bufpos];
    INC(cnt); INC(bufpos);
  END;
  file.bufpos := bufpos;
  INC(file.pos,cnt);
  file.status := ok;
  RETURN TRUE;
END Read;


(*------  ReadChar:  ------*)


PROCEDURE ReadChar*(VAR file: File; VAR ch: CHAR): BOOLEAN;

(* liest ein Zeichen aus file. Ergebnis ist TRUE, wenn alles korrekt
verlieft. *)

BEGIN
  IF NOT file.read THEN file.status := onlywrite; RETURN FALSE END;
  IF file.write AND NOT file.lastRead THEN
    IF NOT EmptyWriteBuf(file) THEN RETURN FALSE END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := TRUE;
  END;
  IF (file.bufpos=file.buflen) THEN
    file.bufpos := 0;
    file.buflen := d.Read(file.handle,file.buffer^,BufSize);
    IF file.buflen=0 THEN file.status := eof;     RETURN FALSE END;
    IF file.buflen<0 THEN file.status := readerr; RETURN FALSE END;
  END;
  ch := file.buffer[file.bufpos];
  INC(file.bufpos);
  INC(file.pos);
  file.status := ok;
  RETURN TRUE;
END ReadChar;


(*------  ReadString:  ------*)


PROCEDURE ReadString*(VAR file: File; VAR to: ARRAY OF CHAR): BOOLEAN;

(* liest einen String aus file nach to. Stringende ist durch 0X oder 0AX
markiert. Ergebnis ist TRUE, wenn alles korrekt verlieft. *)

VAR
  cnt: INTEGER;
  bufpos: INTEGER;
  eos: BOOLEAN;

BEGIN
  IF NOT file.read THEN file.status := onlywrite; RETURN FALSE END;
  IF file.write AND NOT file.lastRead THEN
    IF NOT EmptyWriteBuf(file) THEN RETURN FALSE END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := TRUE;
  END;
  cnt := 0; bufpos := file.bufpos; eos := FALSE;
  WHILE (cnt<LEN(to)) AND NOT eos DO
    IF (bufpos=file.buflen) THEN
      file.bufpos := 0; bufpos := 0;
      file.buflen := d.Read(file.handle,file.buffer^,BufSize);
      IF file.buflen=0 THEN file.status := eof;     RETURN FALSE END;
      IF file.buflen<0 THEN file.status := readerr; RETURN FALSE END;
    END;
    to[cnt] := file.buffer[bufpos];
    CASE to[cnt] OF 0X,0AX: eos := TRUE; to[cnt] := 0X | ELSE END;
    INC(cnt); INC(bufpos);
  END;
  file.bufpos := bufpos;
  INC(file.pos,cnt);
  file.status := ok;
  RETURN TRUE;
END ReadString;

PROCEDURE ReadStringLen*(VAR file: File; VAR to: ARRAY OF CHAR): INTEGER;

(* liest einen String aus file nach to. Stringende ist durch 0X oder 0AX
markiert. Ergebnis ist str.Length(to), wenn alles korrekt verlieft. *)

VAR
  cnt: INTEGER;
  bufpos: INTEGER;
  eos: BOOLEAN;

BEGIN
  IF NOT file.read THEN file.status := onlywrite; RETURN -1 END;
  IF file.write AND NOT file.lastRead THEN
    IF NOT EmptyWriteBuf(file) THEN RETURN -1 END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := TRUE;
  END;
  cnt := 0; bufpos := file.bufpos; eos := FALSE;
  WHILE (cnt<LEN(to)) AND NOT eos DO
    IF (bufpos=file.buflen) THEN
      file.bufpos := 0; bufpos := 0;
      file.buflen := d.Read(file.handle,file.buffer^,BufSize);
      IF file.buflen=0 THEN file.status := eof;     RETURN -1 END;
      IF file.buflen<0 THEN file.status := readerr; RETURN -1 END;
    END;
    to[cnt] := file.buffer[bufpos];
    INC(bufpos);
    CASE to[cnt] OF
      0X,0AX: eos := TRUE; to[cnt] := 0X |
    ELSE
      INC(cnt);
    END;
  END;
  file.bufpos := bufpos;
  INC(file.pos,cnt);
  file.status := ok;
  RETURN cnt;
END ReadStringLen;

(* $Debug= *)
PROCEDURE ReadStringLenTab*(VAR file: File; VAR to: ARRAY OF CHAR;
                            tabStop: INTEGER): INTEGER;

(* liest einen String aus file nach to, Tabs werden          *)
(* expantiert. Stringende ist durch 0X oder 0AX markiert.    *)
(* Ergebnis ist str.Length(to), wenn alles korrekt verlieft. *)

VAR
  cnt, bufcnt: INTEGER;
  bufpos: INTEGER;
  i, j: INTEGER;
  eos: BOOLEAN;

BEGIN
  IF NOT file.read THEN file.status := onlywrite; RETURN -1 END;
  IF file.write AND NOT file.lastRead THEN
    IF NOT EmptyWriteBuf(file) THEN RETURN -1 END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := TRUE;
  END;
  cnt := 0; bufcnt := 0; bufpos := file.bufpos; eos := FALSE;
  WHILE (cnt<LEN(to)) AND NOT eos DO
    IF (bufpos=file.buflen) THEN
      file.bufpos := 0; bufpos := 0;
      file.buflen := d.Read(file.handle,file.buffer^,BufSize);
      IF file.buflen=0 THEN file.status := eof;     RETURN -1 END;
      IF file.buflen<0 THEN file.status := readerr; RETURN -1 END;
    END;
    to[cnt] := file.buffer[bufpos];
    INC(bufpos); INC(bufcnt);
    CASE to[cnt] OF
      "\t": i := tabStop-(cnt MOD tabStop)+cnt;
            IF i>=LEN(to) THEN
              i := LEN(to)-1;
              to[i] := "\o"; eos := TRUE;
            END;
            j := i;
            REPEAT
              DEC(i);
              to[i] := " ";
            UNTIL i <= cnt;
            cnt := j;
    | 0X,0AX: eos := TRUE; to[cnt] := 0X;
    ELSE
      INC(cnt);
    END;
  END;
  file.bufpos := bufpos;
  INC(file.pos,bufcnt);
  file.status := ok;
  RETURN cnt;
END ReadStringLenTab;
(* $Debug- *)

(*------  ReadBlock:  ------*)


PROCEDURE ReadBlock*(VAR file: File; to, size: LONGINT): BOOLEAN;

(* liest size Bytes aus file nach to^. Ergebnis ist TRUE, wenn alles
korrekt verlieft. *)

VAR
  cnt: LONGINT;
  bufpos: INTEGER;
  ptrtob: POINTER TO BYTE;

BEGIN
  IF NOT file.read THEN file.status := onlywrite; RETURN FALSE END;
  IF file.write AND NOT file.lastRead THEN
    IF NOT EmptyWriteBuf(file) THEN RETURN FALSE END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := TRUE;
  END;
  ptrtob := to;
  cnt := 0; bufpos := file.bufpos;
  WHILE cnt<size DO
    IF (bufpos=file.buflen) THEN
      file.bufpos := 0; bufpos := 0;
      file.buflen := d.Read(file.handle,file.buffer^,BufSize);
      IF file.buflen=0 THEN file.status := eof;     RETURN FALSE END;
      IF file.buflen<0 THEN file.status := readerr; RETURN FALSE END;
    END;
    ptrtob^ := file.buffer[bufpos];
    INC(cnt); INC(ptrtob); INC(bufpos);
  END;
  file.bufpos := bufpos;
  INC(file.pos,size);
  file.status := ok;
  RETURN TRUE;
END ReadBlock;


(*-------------------------------------------------------------------------*)


(*------  Write:  ------*)


PROCEDURE Write*(VAR file: File; from: ARRAY OF BYTE): BOOLEAN;

(* schreibt LEN(to) Bytes aus from in die Datei file. Ergebnis ist TRUE,
wenn alles korrekt verlieft. *)

VAR
  cnt: INTEGER;
  bufpos: INTEGER;

BEGIN
  IF NOT file.write THEN file.status := onlyread; RETURN FALSE END;
  IF file.read AND file.lastRead THEN
    IF d.Seek(file.handle,file.pos,d.beginning)=0 THEN END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := FALSE;
  END;
  cnt := 0; bufpos := file.bufpos;
  WHILE cnt<LEN(from) DO
    IF (bufpos=BufSize) THEN
      file.bufpos := bufpos;
      bufpos := 0;
      IF NOT WriteBuf(file) THEN RETURN FALSE END;
    END;
    file.buffer[bufpos] := from[cnt];
    INC(cnt); INC(bufpos);
  END;
  file.bufpos := bufpos;
  INC(file.pos,cnt);
  IF file.pos>file.size THEN file.size := file.pos END;
  file.status := ok;
  RETURN TRUE;
END Write;


(*------  WriteChar:  ------*)


PROCEDURE WriteChar*(VAR file: File; ch: CHAR): BOOLEAN;

(* schreibt 1 Char in die Datei file. Ergebnis ist TRUE, wenn alles korrekt
verlieft. *)

BEGIN
  IF NOT file.write THEN file.status := onlyread; RETURN FALSE END;
  IF file.read AND file.lastRead THEN
    IF d.Seek(file.handle,file.pos,d.beginning)=0 THEN END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := FALSE;
  END;
  IF file.bufpos=BufSize THEN
    IF NOT WriteBuf(file) THEN RETURN FALSE END;
  END;
  file.buffer[file.bufpos] := ch;
  INC(file.bufpos);
  INC(file.pos);
  IF file.pos>file.size THEN file.size := file.pos END;
  file.status := ok;
  RETURN TRUE;
END WriteChar;


(*------  WriteString:  ------*)


PROCEDURE WriteString*(VAR file: File; from: ARRAY OF CHAR): BOOLEAN;

(* schreibt String in die Datei. Danach wird eine LF in die Datei
geschrieben. Ergebnis ist TRUE, wenn alles korrekt verlieft. *)

VAR
  cnt: INTEGER;
  bufpos: INTEGER;
  eos: BOOLEAN;

BEGIN
  IF NOT file.write THEN file.status := onlyread; RETURN FALSE END;
  IF file.read AND file.lastRead THEN
    IF d.Seek(file.handle,file.pos,d.beginning)=0 THEN END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := FALSE;
  END;
  cnt := 0; bufpos := file.bufpos; eos := FALSE;
  WHILE (cnt<LEN(from)) AND NOT eos DO
    IF (bufpos=BufSize) THEN
      file.bufpos := bufpos;
      bufpos := 0;
      IF NOT WriteBuf(file) THEN RETURN FALSE END;
    END;
    IF from[cnt] = 0X THEN
      eos := TRUE;
      file.buffer[bufpos] := 0AX;
    ELSE
      file.buffer[bufpos] := from[cnt];
    END;
    INC(cnt); INC(bufpos);
  END;
  file.bufpos := bufpos;
  INC(file.pos,cnt);
  IF file.pos>file.size THEN file.size := file.pos END;
  file.status := ok;
  RETURN TRUE;
END WriteString;


(*------  WriteBlock:  ------*)


PROCEDURE WriteBlock*(VAR file: File; from, size: LONGINT): BOOLEAN;

(* schreibt size Bytes aus from^ in die Datei file. Ergebnis ist TRUE, wenn
alles korrekt verlieft. *)

VAR
  cnt: LONGINT;
  bufpos: INTEGER;
  ptrtob: POINTER TO BYTE;

BEGIN
  IF NOT file.write THEN file.status := onlyread; RETURN FALSE END;
  IF file.read AND file.lastRead THEN
    IF d.Seek(file.handle,file.pos,d.beginning)=0 THEN END;
    file.bufpos := 0;
    file.buflen := 0;
    file.lastRead := FALSE;
  END;
  cnt := 0; bufpos := file.bufpos; ptrtob := from;
  WHILE cnt<size DO
    IF (bufpos=BufSize) THEN
      file.bufpos := bufpos;
      bufpos := 0;
      IF NOT WriteBuf(file) THEN RETURN FALSE END;
    END;
    file.buffer[bufpos] := ptrtob^;
    INC(cnt); INC(bufpos); INC(ptrtob);
  END;
  file.bufpos := bufpos;
  INC(file.pos,cnt);
  IF file.pos>file.size THEN file.size := file.pos END;
  file.status := ok;
  RETURN TRUE;
END WriteBlock;


(*-------------------------------------------------------------------------*)


(*------  Size:  ------*)


PROCEDURE Size*(VAR file: File): LONGINT;

(* Ergibt die Größe der Datei *)

BEGIN
  RETURN file.size;
END Size;


(*------  Position:  ------*)


PROCEDURE Position* (VAR file: File): LONGINT;

(* Ergibt die aktuelle Position innerhalb der Datei *)

BEGIN
  RETURN file.pos;
END Position;


(*-------------------------------------------------------------------------*)


(*------  Move:  ------*)


PROCEDURE Move*(VAR file: File; to: LONGINT): BOOLEAN;

(* spring an die Stelle to (vom Dateianfang ausgehend). Ergebnis ist TRUE,
wenn alles korrekt verlieft. *)

VAR l: LONGINT;

BEGIN
  IF NOT EmptyWriteBuf(file)  THEN                        RETURN FALSE END;
  IF (to>file.size) OR (to<0) THEN file.status := toofar; RETURN FALSE END;
  IF d.Seek(file.handle,to,d.beginning)=0 THEN END;
  file.status := ok;
  file.buflen := 0;
  file.bufpos := 0;
  file.pos := to;
  RETURN TRUE;
END Move;


(*------  Forward:  ------*)


PROCEDURE Forward*(VAR file: File; to: LONGINT): BOOLEAN;

(* überspringt to Bytes. Ergebnis ist TRUE, wenn alles korrekt verlieft. *)

BEGIN
  RETURN Move(file,file.pos+to);
END Forward;


(*------  Backward:  ------*)


PROCEDURE Backward*(VAR file: File; to: LONGINT): BOOLEAN;

(* springt to Bytes zurück . Ergebnis ist TRUE, wenn alles korrekt
verlieft. *)

BEGIN
  RETURN Move(file,file.pos-to);
END Backward;


(*-------------------------------------------------------------------------*)

PROCEDURE Delete*(VAR file: File): BOOLEAN;

(* schließt und löscht die Datei *)

BEGIN
  IF file.handle#NIL THEN IF Close(file) THEN END END;
  RETURN d.DeleteFile(file.name);
END Delete;


(*-------------------------------------------------------------------------*)


PROCEDURE Exists*(name: ARRAY OF CHAR): BOOLEAN;

(* prüft, ob die Datei mit dem Namen 'name' existiert. *)

VAR lock: d.FileLockPtr;

BEGIN
  lock := sd.Lock(name,d.sharedLock);
  IF lock#NIL THEN
    sd.UnLock(lock); RETURN TRUE
  ELSE
    RETURN FALSE;
  END;
END Exists;


END EdFileSystem.