(****************************************************************************)
(*  Bibliotheks-Modul BYTEFILE                                              *)
(*    Ermoeglicht auch unter CP/M das byteweise Lesen einer Datei           *)
(*                                                                          *)
(*  (c MaxBytePuffer = 1024 kann auf das Vielfache von 128 gesetzt werden ) *)
(*  (t BF_str14 )                                                           *)
(*  (p LiesBlock )                                                          *)
(*                                                                          *)
(*  t ByteFile  entspricht FILE OF BYTE,                                    *)
(*              kompatibel zu allen Diskettendateien                        *)
(*  p assignByteFile           wie ASSIGN                                   *)
(*  p resetByteFile            wie RESET                                    *)
(*  p rewriteByteFile          wie REWRITE                                  *)
(*  p closeByteFile            wie CLOSE                                    *)
(*  p EOFByteFile              wie EOF                                      *)
(*  f LongFileSizeByteFile     wie LONGFILEZISE, Ergebnis REAL !            *)
(*  f LongFilePosByteFile      wie LONGFILEPOS, Ergebnis REAL !             *)
(*  p FlushByteFile            wie FLUSH                                    *)
(*  p LongSeekByteFile         wie LONGSEEK, Position vom Typ REAL!         *)
(*  p readByteFile             wie READ                                     *)
(*  p writeByteFile            wie WRITE                                    *)
(*  v IOResultByteFile         wie IOResult (nur nach RESET und REWRITE)    *)
(*  p eraseByteFile            wie ERASE                                    *)
(*  p renameByteFile           wie RENAME                                   *)
(****************************************************************************)

const maxbytepuffer = 1024;
type BF_str14 = string[14];
     bytefile = record
                  f : file;
                  puffer : array[1..maxbytepuffer] of byte;
                  ptr, erster, letzter, size : integer;
                  writeflag : boolean;
                end;
var ioresultbytefile : integer;

procedure liesblock(var BF:bytefile; nr:integer);

  function min(x,y:integer) : integer;
    begin if x<y then min:=x else min:=y end;

  begin
    with bf do
      begin
        erster:=nr; ptr:=0;
        letzter:=nr+min(size-nr,pred(maxbytepuffer shr 7));
        seek(f,pred(nr));
        blockread(f,puffer,succ(letzter-erster));
      end;
  end;

procedure flushbytefile(var bf:bytefile);
  begin
    with bf do
      if writeflag then
        begin
          seek(f,pred(erster));
          blockwrite(f,puffer,succ(letzter-erster));
          writeflag:=false;
        end;
  end;

procedure longseekbytefile(var bf:bytefile; position:real);
  var seite, nummer : integer;
  begin
    seite:=trunc(position/128); nummer:=trunc(position-128.0*seite);
    seite:=succ(seite);
    with bf do
      if (seite>erster) and (seite<=letzter)
        then ptr:=((seite-erster) shl 7) or nummer
        else begin flushbytefile(bf); liesblock(bf,seite); ptr:=nummer end;
  end;

function longfileposbytefile(var bf:bytefile) : real;
  begin
    with bf do longfileposbytefile:=128.0*pred(erster)+ptr
  end;

function eofbytefile(var bf:bytefile) : boolean;
  begin
    with bf do
      eofbytefile:=(letzter=size) and (ptr=succ(letzter-erster) shl 7)
    end;

function longfilesizebytefile(var bf:bytefile) : real;
  begin
    longfilesizebytefile:=128.0*bf.size
  end;

procedure assignbytefile(var bf:bytefile; name:bf_str14);
  begin
    with bf do assign(f,name);
  end;

procedure resetbytefile(var bf:bytefile);
  begin
    with bf do
      begin
        {$I-} reset(f) {$I+}; letzter:=0; writeflag:=false;
        ioresultbytefile:=ioresult;
        if ioresultbytefile=0 then
          begin
            {$I-} size:=filesize(f); {$I+} ioresultbytefile:=ioresult;
            if ioresultbytefile=0 then longseekbytefile(bf,0);
          end;
      end;
  end;

procedure rewritebytefile(var bf:bytefile);
  begin
    with bf do
      begin
        {$I-} rewrite(f) {$I+}; ioresultbytefile:=ioresult;
        ptr:=0; erster:=1; letzter:=0; size:=0; writeflag:=false;
      end;
  end;

procedure readbytefile(var bf:bytefile; var b:byte);
  begin
    with bf do
      begin
        if ptr=maxbytepuffer
          then begin flushbytefile(bf); liesblock(bf, succ(letzter)) end;
        ptr:=succ(ptr); b:=puffer[ptr];
      end;
  end;

procedure writebytefile(var bf:bytefile; b:byte);

  function max(x,y:integer) : integer;
    begin if x>y then max:=x else max:=y end;

  begin
    with bf do
      begin
        if ptr=maxbytepuffer then
          begin flushbytefile(bf); erster:=succ(letzter); ptr:=0 end;
        ptr:=succ(ptr); puffer[ptr]:=b;
        letzter:=max(letzter, erster+(pred(ptr) shr 7));
        writeflag:=true; size:=max(size,letzter)
      end
  end;

procedure closebytefile(var bf:bytefile);
  begin
    flushbytefile(bf);
    close(bf.f);
  end;

procedure erasebytefile(var bf:bytefile);
  begin
    erase(bf.f)
  end;

procedure renamebytefile(var bf:bytefile; name:bf_str14);
  begin
    rename(bf.f, name)
  end;
