(*
    Title: 	StringStream - implementation
    LastEdit:	"Tue Sep 25 11:04:37 1984"
    Author: 	Mick Jordan
		Acorn Research Centre

*)

IMPLEMENTATION MODULE StringStream;
(* $T-, $R- *)  (* self-checked *)

FROM SYSTEM IMPORT WORD, ADR;
FROM SystemTypes IMPORT LongINTEGER, LongCARDINAL, String;

FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM StreamRep IMPORT 
	DefaultProcs, NullFlush, SetStreamError, 
        Procs;
FROM Streams IMPORT
        Create, Stream, StreamProcs, ErrorCode, SeekMode, OptionalFunction;

FROM Exceptions IMPORT RAISEC, ArrayIndexOutOfRange;
IMPORT Strings;

TYPE StringData = POINTER TO
    RECORD
	index: CARDINAL;
        stringBody: String;
        length, maxLength: CARDINAL;
    END;

VAR procs: Procs;   (* read only *)

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

PROCEDURE Get(s: Stream): WORD;
    VAR
        b: StringData;
        ch: CHAR;
    BEGIN
        b := StringData(s^.instanceData);
        WITH b^ DO
	    IF index >= length THEN 
		s^.status := EndOfStream;
                RETURN WORD(0);
            ELSE
                ch := stringBody^[index];
                IF ch = 0C THEN
                    length := index;
                    s^.status := EndOfStream
                END (* if *);
                INC(index);
	        RETURN WORD(ch);
	    END (* if *);
	END (* with *);
    END Get;

PROCEDURE Put(s: Stream; w: WORD);
   VAR
        b: StringData;
    BEGIN
        b := StringData(s^.instanceData);
        WITH b^ DO
            stringBody^[index] := CHAR(w);
            INC(index);
            IF index > length THEN
                length := index;
            END (* if *);
        END (* with *);
    END Put;

PROCEDURE Backspace(s: Stream);
    VAR
        b: StringData;
    BEGIN
        b := StringData(s^.instanceData);
        IF (b^.index # 0) AND (b^.index < b^.length) THEN
            DEC(b^.index);
        END (* if *);
    END Backspace;

PROCEDURE Seek(s: Stream; sm: SeekMode; seeko: LongINTEGER);
    VAR
        b: StringData;
        m: CARDINAL;
    BEGIN    
        b := StringData(s^.instanceData);
        m := b^.maxLength;
        WITH b^ DO
            CASE sm OF
              Beginning: 
                IF (seeko<0) OR (CARDINAL(seeko) >= m) THEN
                    RAISEC(ArrayIndexOutOfRange);
                ELSE
                    index := CARDINAL(seeko);
                END (* if *);
            | Current: 
                IF CARDINAL(INTEGER(index)+seeko) >= m THEN
                    RAISEC(ArrayIndexOutOfRange);
                ELSE
                    index := CARDINAL(INTEGER(index)+seeko);
                END (* if *);
            | End: 
                IF INTEGER(m)+seeko < 0 THEN
                    RAISEC(ArrayIndexOutOfRange);
                ELSE
                    index := CARDINAL(INTEGER(m)+seeko);
                END (* if *);
            END;
        END;
    END Seek;

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

PROCEDURE Delete(s: Stream);
    VAR
        b: StringData;
    BEGIN
        b := StringData(s^.instanceData);
        DISPOSE(b);
    END Delete;

PROCEDURE CreateInOutString(s: String; xmaxLength: CARDINAL): Stream;
    VAR
        stringdata: StringData;
    BEGIN
        NEW(stringdata);
        WITH stringdata^ DO
            length := Strings.LengthS(s);
            IF xmaxLength=0 THEN
                maxLength := length
            ELSE
                maxLength := xmaxLength;
            END (* if *);
            stringBody := s;
            index := 0;
        END (* with *);
        RETURN Create(StreamProcs(procs), stringdata);
    END CreateInOutString;

PROCEDURE CreateInOutChars(VAR chars: ARRAY OF CHAR): Stream;
    VAR
        stringdata: StringData;
    BEGIN
        NEW(stringdata);
        WITH stringdata^ DO
            length := Strings.LengthC(chars);
            maxLength := HIGH(chars);
            stringBody := String(ADR(chars));
            index := 0;
        END (* with *);
        RETURN Create(StreamProcs(procs), stringdata);
    END CreateInOutChars;

PROCEDURE InitProcs(): Procs;
    VAR
        pt: Procs;
    BEGIN
        pt := DefaultProcs(8);
        pt^.Put := Put; 
        pt^.Get := Get; pt^.Backspace := Backspace;
        pt^.Put := Put; pt^.Flush := NullFlush; 
        pt^.Delete := Delete;
        pt^.Seek := Seek; pt^.Tell := Tell;
        pt^.Implements := Implements;
        RETURN pt;
    END InitProcs;

BEGIN
    procs := InitProcs();
END StringStream .