(*********************************************************************)
(* Title:	ArchiveLib - Implementation			     *)
(* Author: 	Mick Jordan,107,x304				     *)
(* 		Copyright (C) 1985 by Acorn Research Centre	     *)
(*********************************************************************)


(*
  $Revision$
  $Author$
  $Date$
  $Source$
  $State$
*)

IMPLEMENTATION MODULE ArchiveLib;

FROM SYSTEM IMPORT WORD, TSIZE, BYTESPERWORD, ADR, ADDRESS, MAXINT;
FROM SystemTypes IMPORT LongCARDINAL, LongINTEGER;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM Streams IMPORT 
    Stream, SeekMode, ErrorCode, Create, StreamProcs, OptionalFunction;
FROM StreamRep IMPORT DefaultProcs, Procs;
FROM CharCodes IMPORT NewLineCh, SpaceCh;
IMPORT Strings;
IMPORT ChunkLib;
FROM ChunkFlFmt IMPORT ChunkEntry;
FROM ArchTypes IMPORT ArchiveDirEntry;

TYPE 
  MemberId = CARDINAL;        (* chunk index of member's data *)

  ArchiveRec = RECORD
    chunkHandle: ChunkLib.ChunkHandle;
    dirData: ADDRESS;       (* directory chunk *) 
    dirSize: CARDINAL;      (* size of directory in bytes *)
    bytesUsed: CARDINAL;    (* during FindNextMember *)
  END;

TYPE 
  ArchiveId = POINTER TO ArchiveRec;

  MemberData = POINTER TO ARRAY [0 .. MAXINT DIV 4] OF CHAR;

  Member = POINTER TO RECORD
    memberdata: MemberData;
    memberDataSize: CARDINAL;
    index: CARDINAL;
  END;

PROCEDURE OpenArchive(name: ARRAY OF CHAR; VAR arcid: ArchiveId): BOOLEAN;
  VAR
    xChunkHandle: ChunkLib.ChunkHandle;
    xDirData: ADDRESS;
    entry: CARDINAL;
    chunkEntry: ChunkEntry;
  BEGIN
    IF ChunkLib.OpenChunkFile(name, xChunkHandle) THEN
      IF ChunkLib.FindChunk(xChunkHandle, "ARCHDIR", entry) THEN
        ChunkLib.GetEntry(xChunkHandle, entry, chunkEntry);
        ALLOCATE(xDirData, chunkEntry.size);
        IF ChunkLib.GetChunk(xChunkHandle, entry, xDirData) THEN
          NEW(arcid);
          WITH arcid^ DO
            chunkHandle := xChunkHandle;
            dirData := xDirData;
            bytesUsed := 0;
            dirSize := chunkEntry.size;
          END;
          RETURN TRUE;
        END;
      END;
    END;
    RETURN FALSE;
  END OpenArchive;

PROCEDURE CloseArchive(a: ArchiveId);
  VAR
    r: INTEGER;
  BEGIN
    ChunkLib.CloseChunkFile(a^.chunkHandle);
    DEALLOCATE(a^.dirData, a^.dirSize);
    DISPOSE(a);
  END CloseArchive;

PROCEDURE GetNextMember(archiveId: ArchiveId; VAR name: ARRAY OF CHAR;
  VAR memberId: MemberId): BOOLEAN;
  TYPE 
    ArchiveDirEntryPtr = POINTER TO ArchiveDirEntry;
  VAR
    dirName: Strings.String;
    dirEntry: ArchiveDirEntryPtr;
    dirData: ADDRESS;
  BEGIN
    dirData := archiveId^.dirData + archiveId^.bytesUsed;
    WHILE archiveId^.bytesUsed < archiveId^.dirSize DO
      dirEntry := ArchiveDirEntryPtr(dirData);
      INC(archiveId^.bytesUsed, dirEntry^.entryLength);
      IF dirEntry^.chunkIndex # 0 THEN
        dirName := Strings.String(CARDINAL(dirData) +
         TSIZE(ArchiveDirEntry));
        Strings.CopySC(dirName, name);
        memberId := dirEntry^.chunkIndex;
        RETURN TRUE;
      END;
      INC(dirData, dirEntry^.entryLength);
    END;
    RETURN FALSE;
  END GetNextMember;

PROCEDURE FindMember(archiveId: ArchiveId; 
  name: ARRAY OF CHAR; VAR memberId: MemberId): BOOLEAN;
  VAR nextName: ARRAY [0..255] OF CHAR;
  BEGIN
    archiveId^.bytesUsed := 0;
    WHILE GetNextMember(archiveId, nextName, memberId) DO
      IF Strings.EqualCC(name, nextName) THEN RETURN TRUE END;
    END;
    RETURN FALSE;
  END FindMember;

PROCEDURE CreateInput(archiveId: ArchiveId; name: ARRAY OF CHAR): Stream;
  VAR
    memberId: MemberId;
    s: Stream;
  BEGIN
    s := Create(StreamProcs(procs), 0);
    IF FindMember(archiveId, name, memberId) THEN
      Initialise(s, archiveId, memberId);
    ELSE
      s^.status := StreamError;
    END (* if *);
    RETURN s;
  END CreateInput;

PROCEDURE CreateFastInput(archiveId: ArchiveId; memberId: MemberId): Stream;
  VAR
    s: Stream;
  BEGIN
    s := Create(StreamProcs(procs), 0);
    Initialise(s, archiveId, memberId);
    RETURN s;
  END CreateFastInput;

PROCEDURE Initialise(s: Stream; archiveId: ArchiveId; memberId: MemberId);
  VAR
    member: Member;
    chunkEntry: ChunkEntry;
  BEGIN
    NEW(member);
    s^.instanceData := WORD(member);
    ChunkLib.GetEntry(archiveId^.chunkHandle, memberId, chunkEntry);
    WITH member^ DO
      memberDataSize := chunkEntry.size;
      ALLOCATE(memberdata, memberDataSize);
      index := 0;
      IF NOT ChunkLib.GetChunk(archiveId^.chunkHandle, memberId, memberdata) THEN
        DEALLOCATE(memberdata, memberDataSize);
        DISPOSE(member);
        s^.status := StreamError;
      END;
    END (* with *);
  END Initialise;

PROCEDURE Get(s: Stream): WORD;
  VAR
    member: Member;
  BEGIN
    member := Member(s^.instanceData);
    WITH member^ DO
      IF index >= memberDataSize THEN
        s^.status := EndOfStream;
        RETURN WORD(0C);
      ELSE
        INC(index);
        RETURN WORD(memberdata^[index-1]);
      END (* if *);
    END (* with *);
  END Get;

PROCEDURE GetN(s: Stream; a: ADDRESS; n: CARDINAL): CARDINAL;
  VAR
    member: Member;
    getBuf: MemberData;
    i, toGet: CARDINAL;
  BEGIN
    member := Member(s^.instanceData);
    getBuf := MemberData(a);
    IF member^.memberDataSize - member^.index >= n THEN
      toGet := n;
    ELSE
      toGet := member^.memberDataSize - member^.index;
      IF toGet = 0 THEN
        s^.status := EndOfStream;
      END (* if *);
    END (* if *);
    IF toGet > 0 THEN
      FOR i := 0 TO toGet-1 DO
        getBuf^[i] := member^.memberdata^[i+member^.index];
      END (* for *);
      INC(member^.index, toGet);
    END (* if *);
    RETURN toGet;
  END GetN;

PROCEDURE Backspace(s: Stream);
  VAR
    member: Member;
  BEGIN
    member := Member(s^.instanceData);
    IF member^.index > 0 THEN
      DEC(member^.index);
    END (* if *);
  END Backspace;

PROCEDURE Tell(s: Stream; VAR p: LongCARDINAL);
  VAR
    member: Member;
  BEGIN
    member := Member(s^.instanceData);
    p := member^.index;
  END Tell;

PROCEDURE Seek(s: Stream; seekMode: SeekMode; offset: LongINTEGER);
  VAR
    member: Member;
  BEGIN
    member := Member(s^.instanceData);
    WITH member^ DO
      CASE seekMode OF
        Beginning:
         index := CARDINAL(offset);
      | Current:
          index := CARDINAL(INTEGER(index)+offset);
      | End:
          index := CARDINAL(INTEGER(memberDataSize)+offset);
      END (* case *);
    END (* with *);
  END Seek;

PROCEDURE Delete(s: Stream);
  VAR
    member: Member;
  BEGIN
    member := Member(s^.instanceData);
    DEALLOCATE(member^.memberdata, member^.memberDataSize);
    DISPOSE(member);
  END Delete;

PROCEDURE Implements(s: Stream; f: OptionalFunction): BOOLEAN;
  BEGIN
    RETURN TRUE;
  END Implements;

PROCEDURE InitProcs(): Procs;
  VAR
    p: Procs;
  BEGIN
    p := DefaultProcs(8);
    p^.Get := Get;
    p^.GetN := GetN;
    p^.Delete := Delete;
    p^.Seek := Seek;
    p^.Tell := Tell;
    p^.Backspace := Backspace;
    RETURN p;
  END InitProcs;

VAR procs: Procs;

BEGIN
  procs := InitProcs();
END ArchiveLib.

(*
$Log$
*)