{$SETC PasteTrace := PasteTrace AND fUniversalTextTrace}

CONST
    magicTabMax= itbdLst;   {The maximum number of tabstops on a ruler allowed by LisaWrite and its ilk}
    maxBacking = 12;        {Maximum number of chars saved for backing up the lpLim during Write UT}

TYPE
    TPtrToolKitUT = ^ToolKitUT;
    ToolKitUT =     Tcs;
    TSavedPara =    RECORD
        firstLp:        TLp;
        theArce:        TArce;
        theArpe:        TArpe;
{$IFC WithUObject}
        theText:        TString;
{$ELSEC}
        theText:        TUTString;
{$ENDC}
                    END;
    PSavedPara =    ^TSavedPara;
    HSavedPara =    ^PSavedPara;

{$IFC NOT WithUObject}
    Byte =          -128..127;
    TpLONGINT =     ^LONGINT;
    TPByte =        ^Byte;
{$ENDC}

{private types not used in the Toolkit; used in place of the Toolkit's type coercion to a
        Handle, since a Handle outside of the Toolkit is a double-indeirect pointer to a byte}
    UTpLongint  = ^LONGINT;
    UTppLongint = ^UTpLongint;

  { Carefull, carefull, carefull here kids. Since I can't have private fields and/or methods in my classes
    inorder to resolve a few types I am forced to do this thing to keep you innocents from having to
    include an ugly list of units. Only one instance of these variabes exists ever! Therefore I can only
    do things one at a time.}

    TSecretThings = RECORD
            streamArrayIndex:   Byte;
            lpd:                TALpd;
            achad:              TAchad;
            END;

VAR
{$IFC WithUObject}
    activeStream:   TTKWriteUnivText;
{$ELSEC}
    activeStream:   TWriteUnivText;
{$ENDC}
    secrets:        TSecretThings;
    currentLpd:     TLpd;
    dataIndex:      INTEGER;
    dataLp:         TLp;
    savedPara:      ARRAY [1..maxBacking] OF HSavedPara;
    nOfSavedPara:   0..maxBacking;
{$IFC WithUObject}
    theData:        TString;
{$ELSEC}
    theData:        TUTString;
{$ENDC}

{$IFC NOT WithUObject}

{The following is a ΅ToolKit to avoid including lots of code that is not used by non-ToolKit applications.}

{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE UTXferRight(source, dest: Ptr; nBytes: INTEGER); EXTERNAL;
PROCEDURE UTXferLeft(source, dest: Ptr; nBytes: INTEGER); EXTERNAL;
{--------------------------------------------------------------------------------------------------------}

{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
FUNCTION  Min(i, j: LONGINT): LONGINT;
{--------------------------------------------------------------------------------------------------------}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    IF i < j THEN
        Min := i
    ELSE
        Min := j;
END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
FUNCTION  Max(i, j: LONGINT): LONGINT;
{--------------------------------------------------------------------------------------------------------}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    IF i > j THEN
        Max := i
    ELSE
        Max := j;
END;


{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE ABCBreak(s: S255; errCode: LONGINT);
{--------------------------------------------------------------------------------------------------------}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    {$IFC fDbgObject}
    WriteLn;
    Write(CHR(7), s);       {Beep}
    IF errCode <> 0 THEN
        Write(': ', errCode:1);
    WriteLn;
    {$ENDC}
    HALT;
END;


{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE  SetCp(object: TUTObject; itsClass: TClass);
{--------------------------------------------------------------------------------------------------------}
    VAR index:  INTEGER;
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    UTppLongint(object)^^ := ORD(itsClass);     {Install slice table pointer}
    index := CiOfCp(TPSliceTable(itsClass));    {Determine its class index}
    IF index < 256 THEN                         {If it will fit in a byte, store it...}
        TPByte(UTppLongint(object)^)^ := index; {...to speed version conversion (cf ConvertHeap: FindClasses)}
END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
FUNCTION  NewDynObject(heap: THeap; itsClass: TClass; dynBytes: INTEGER): TUTObject;
{--------------------------------------------------------------------------------------------------------}
    VAR nBytes: INTEGER;
        object: TUTObject;
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    nBytes := SizeOfCp(TPSliceTable(itsClass)) + dynBytes;
    object := POINTER(ORD(HAllocate(THz(heap), nBytes)));    {TUTObject() won't work until after SetCp}
    IF ORD(object) = ORD(hNIL) THEN
       ABCBreak('NewObject: Heap full, can''t make an object of size', nBytes);
    SetCp(object, itsClass);
    NewDynObject := object;
END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
FUNCTION  NewUTObject(heap: THeap; itsClass: TClass): TUTObject;
{--------------------------------------------------------------------------------------------------------}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    NewUTObject := NewDynObject(heap, itsClass, 0);
END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE ResizeDynObject(object: TUTObject; newTotalBytes: INTEGER);
{--------------------------------------------------------------------------------------------------------}
    VAR i: INTEGER;
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    IF (newTotalBytes < 0) OR (newTotalBytes > (MAXINT-20)) THEN
        ABCBreak('New size must lie between 0 and 32K-20, not', newTotalBytes);
    ChangeSizeH(THz(object.Heap), TH(object), newTotalBytes);
    IF CbDataOfH(THz(object.Heap), TH(object)) < newTotalBytes THEN
       ABCBreak('ResizeDynObject: Heap full, size can''t change to', newTotalBytes);
END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
FUNCTION ClassPtr(hndl: UTppLongint): TClass;
{--------------------------------------------------------------------------------------------------------}
    VAR stp: RECORD
                CASE INTEGER OF
                    1: (asLong: LONGINT);
                    2: (asBytes: PACKED ARRAY [0..3] OF TByte);
                    3: (asClass: TClass);
                    END;
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    stp.asLong := hndl^^;
    stp.asBytes[0] := 0;
    ClassPtr := stp.asClass;
END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
FUNCTION  SizeOfClass(class: TClass): INTEGER;
{--------------------------------------------------------------------------------------------------------}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    SizeOfClass := SizeOfCp(TPSliceTable(class));
END;


{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE InitObject;
{--------------------------------------------------------------------------------------------------------}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    {Do very little for the time beeing}
END;


{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE ClascalError(error: INTEGER); {called with error = 0 after successful Clascal initialization}
{--------------------------------------------------------------------------------------------------------}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    IF error > 0 THEN
        ABCBreak('Some kind of Clascal error', error);
END;


METHODS OF TUTObject;

{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TObject.}Free;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.FreeObject;
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TObject.}FreeObject;
    {----------------------------------------------------------------------------------------------------}
        VAR heap:       THeap;
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        heap := SELF.Heap;
        FreeH(THz(heap), TH(SELF));
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TObject.}Heap: THeap;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        Heap := THeap(HzFromH(TH(SELF)));
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TObject.}Class: TClass;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        Class := ClassPtr(UTppLongint(SELF));
    END;


{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
BEGIN {Class Initialization}

{$IFC fTraceUT}    LogCall;     {$ENDC}
    InitClascal(ClascalError);   {Provide an error routine in case of errors in Clascal run-time support}
    InitObject;                  {Do remaining initialization}
END;


METHODS OF TUTCollection;

{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TCollection.}CREATE(object: TUTObject; heap: THeap; initialSlack: INTEGER): TUTCollection;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        IF object = NIL THEN
            ABCBreak('TUTCollection.CREATE must be passed an already-allocated object by a subclass CREATE', 0);
        SELF := TUTCollection(object);
        WITH SELF DO
            BEGIN
            size := 0;
      {$H-} dynStart := SizeOfClass(SELF.Class); {$H+}
            holeStart := 0;
            holeSize := initialSlack;
            holeStd := 0;
            END;
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TCollection.}AddrMember(i: LONGINT): LONGINT;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        IF i > SELF.holeStart THEN
            i := i + SELF.holeSize;
        AddrMember := TpLONGINT(SELF)^ + SELF.dynStart + (SELF.MemberBytes * (i - 1));
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TCollection.}EditAt(atIndex: LONGINT; deltaMembers: INTEGER);
    {----------------------------------------------------------------------------------------------------}
        VAR oldHoSize:      INTEGER;
            newHoSize:      INTEGER;
            oldHoStart:     INTEGER;
            newHoStart:     INTEGER;
            maxHoStart:     INTEGER;
            minHoStart:     INTEGER;
            size:           INTEGER;
            b:              0..1;
    BEGIN                                               {Removes any hole it creates unless holdStd <> 0}
{$IFC fTraceUT}    LogCall;     {$ENDC}
        oldHoSize := SELF.holeSize;
        oldHoStart := SELF.holeStart;

        IF (deltaMembers < 0) AND ((oldHoStart + 1) = atIndex) THEN {the hole is right before the deletion}
            SELF.holeStart := oldHoStart - deltaMembers
        ELSE
            BEGIN
            newHoStart := atIndex - 1 - Min(deltaMembers, 0);
            IF (deltaMembers > oldHoSize) OR (newHoStart <> oldHoStart) THEN
                BEGIN
                maxHoStart := Max(oldHoStart, newHoStart);
                newHoSize := Max(oldHoSize, deltaMembers);

                IF newHoSize > oldHoSize THEN
                    BEGIN
                    size := SELF.size;
                    newHoSize := Max(newHoSize, SELF.holeStd);
                    SELF.ResizeColl(size + newHoSize);
                    SELF.ShiftColl(maxHoStart + oldHoSize, maxHoStart + newHoSize, size - maxHoStart);
                    END;

                IF newHoStart <> oldHoStart THEN
                    BEGIN
                    b := ORD(newHoStart > oldHoStart);    {1 if hole is moving right and data is moving left}
                    minHoStart := Min(oldHoStart, newHoStart);
                    SELF.ShiftColl(minHoStart + oldHoSize*b, minHoStart + newHoSize*(1-b), maxHoStart - minHoStart);
                    END;

                SELF.holeStart := newHoStart;
                SELF.holeSize := newHoSize;
                END;
            END;

        WITH SELF DO
            BEGIN
            size := size + deltaMembers;
            holeSize := holeSize - deltaMembers;
            holeStart := holeStart + deltaMembers;
            IF oldHoSize = 0 THEN
                IF holeStd = 0 THEN
                    IF holeSize > 0 THEN
                {$H-}   SELF.StopEdit;  {$H+}
            END;
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TCollection.}InsManyAt(i: LONGINT; otherCollection: TUTCollection; index, howMany: LONGINT);
    {----------------------------------------------------------------------------------------------------}
        VAR memberBytes:    INTEGER;
            beforeHole:     INTEGER;
            srcAddr:        LONGINT;
            dstAddr:        LONGINT;
            j:              INTEGER;
            offset:         INTEGER;
    BEGIN                                                   {Stops edit if it wasn't explicitly started}
{$IFC fTraceUT}    LogCall;     {$ENDC}
        memberBytes := SELF.memberBytes;

        SELF.EditAt(i, howMany);

        IF howMany > 0 THEN
            IF otherCollection.Class = SELF.Class THEN          {Can do it with at most two Xfers}
                BEGIN
                beforeHole := Min(howMany, otherCollection.holeStart + 1 - index);

                srcAddr := otherCollection.AddrMember(index);
                dstAddr := SELF.AddrMember(i);
                IF beforeHole > 0 THEN
                    BEGIN
                    UTXferLeft(Ptr(srcAddr), Ptr(dstAddr), beforeHole * memberBytes);

                    IF beforeHole < howMany THEN
                        BEGIN
                        srcAddr := srcAddr + (beforeHole + otherCollection.holeSize) * memberBytes;
                        dstAddr := dstAddr + beforeHole * memberBytes;
                        UTXferLeft(Ptr(srcAddr), Ptr(dstAddr), (howMany - beforeHole) * memberBytes);
                        END;
                    END
                ELSE
                    UTXferLeft(Ptr(srcAddr), Ptr(dstAddr), howMany * memberBytes);
                END
            ELSE                                                {Must Xfer each member separately}
                BEGIN
                offset := SELF.dynStart + (i - 1) * memberBytes;  {AddrMember may even compact for all we know}
                FOR j := 1 TO howMany DO
                    BEGIN
                    UTXferLeft(Ptr(otherCollection.AddrMember(j)), Ptr(TpLONGINT(SELF)^ + offset), memberBytes);
                    offset := offset + memberBytes;
                    END;
                END;
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TCollection.}ResizeColl(membersPlusHole: INTEGER);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        IF membersPlusHole <> (SELF.size + SELF.holeSize) THEN
            ResizeDynObject(SELF, SELF.dynStart + (membersPlusHole * SELF.MemberBytes));
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TCollection.}ShiftColl(afterSrcIndex, afterDstIndex, howMany: INTEGER);
    {----------------------------------------------------------------------------------------------------}
        VAR memberBytes:    INTEGER;
            numBytes:       INTEGER;
            startAddr:      LONGINT;
            srcAddr:        LONGINT;
            dstAddr:        LONGINT;
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        IF (howMany > 0) AND (afterSrcIndex <> afterDstIndex) THEN
            BEGIN
            memberBytes := SELF.MemberBytes;
            numBytes := howMany * memberBytes;

            startAddr := TpLONGINT(SELF)^ + SELF.dynStart;
            srcAddr := startAddr + afterSrcIndex * memberBytes;
            dstAddr := startAddr + afterDstIndex * memberBytes;

            IF afterSrcIndex < afterDstIndex THEN
                UTXferRight(Ptr(srcAddr), Ptr(dstAddr), numBytes)
            ELSE
                UTXferLeft(Ptr(srcAddr), Ptr(dstAddr), numBytes);
            END;
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TCollection.}StartEdit(withSlack: INTEGER);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.holeStd := withSlack;
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TCollection.}StopEdit;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        IF SELF.holeStart < SELF.size THEN
            SELF.EditAt(SELF.size + 1, 0);
        SELF.ResizeColl(SELF.size);
        SELF.holeStd := 0;
        SELF.holeSize := 0;
    END;


{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
END;


METHODS OF TUTArray;

{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TArray.}CREATE(object: TUTObject; heap: THeap; initialSlack, bytesPerRecord: INTEGER): TUTArray;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        IF ODD(bytesPerRecord) THEN
            bytesPerRecord := bytesPerRecord + 1;
        IF object = NIL THEN
            object := NewDynObject(heap, THISCLASS, initialSlack * bytesPerRecord);
        SELF := TUTArray(TUTCollection.CREATE(object, heap, initialSlack));
        SELF.recordBytes := bytesPerRecord;
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TArray.}MemberBytes: INTEGER;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        MemberBytes := SELF.recordBytes;
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TArray.}At(i: LONGINT): Ptr;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
       { At := Ptr(SELF.AddrMember(i));   but for speed...}

        IF i > SELF.holeStart THEN
            i := i + SELF.holeSize;

        At := Ptr(TpLONGINT(SELF)^ + SELF.dynStart + (SELF.recordBytes * (i - 1)));
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TArray.}DelAll;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(1, -SELF.size);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TArray.}DelAt(i: LONGINT);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(i, -1);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TArray.}DelManyAt(i, howMany: LONGINT);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(i, -howMany);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TArray.}PutAt(i: LONGINT; pRecord: Ptr);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        UTXferLeft(pRecord, Ptr(SELF.AddrMember(i)), SELF.recordBytes);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TArray.}InsAt(i: LONGINT; pRecord: Ptr);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(i, 1);
        SELF.PutAt(i, pRecord);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TArray.}InsLast(pRecord: Ptr);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(3);{$ENDC}
        SELF.InsAt(SELF.size + 1, pRecord);
        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
END;


METHODS OF TUTString;

{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TString.}CREATE(object: TUTObject; heap: THeap; initialSlack: INTEGER): TUTString;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        IF ODD(initialSlack) THEN
            initialSlack := initialSlack + 1;
        IF object = NIL THEN
            object := NewDynObject(heap, THISCLASS, initialSlack);
        SELF := TUTString(TUTCollection.CREATE(object, heap, initialSlack));
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TString.}At(i: LONGINT): CHAR;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
       {At := CHAR(TPByte(SELF.AddrMember(i))^);  but for speed...}

        IF i > SELF.holeStart THEN
            i := i + SELF.holeSize;
        At := CHAR(TPByte(TpLONGINT(SELF)^ + SELF.dynStart + (i - 1))^);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TString.}DelAt(i: LONGINT);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(i, -1);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TString.}DelAll;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(1, -SELF.size);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TString.}DelManyAt(i, howMany: LONGINT);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(i, -howMany);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TString.}InsAt(i: LONGINT; character: CHAR);
    {----------------------------------------------------------------------------------------------------}
        VAR pByte:      TPByte;
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(i, 1);

       {TPByte(SELF.AddrMember(i))^ := PByte(character);  but for speed...}

        pByte := TPByte(TpLONGINT(SELF)^ + SELF.dynStart + (i - 1));
        pByte^ := TByte(character);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TString.}InsPAOCAt(i: LONGINT; pPackedArrayOfCharacter: Ptr; howMany: LONGINT);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(i, howMany);
        UTXferLeft(pPackedArrayOfCharacter, Ptr(SELF.AddrMember(i)), howMany);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TString.}ToPAOCAt(i, howMany: LONGINT; pPackedArrayOfCharacter: Ptr);
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SELF.EditAt(i + howMany, 0);
        UTXferLeft(Ptr(SELF.AddrMember(i)), pPackedArrayOfCharacter, howMany);
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TString.}MemberBytes: INTEGER;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        MemberBytes := 1;
    END;


{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
END;

{$ENDC}


{$IFC fUniversalTextTrace}
{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE PrintRun;
{--------------------------------------------------------------------------------------------------------}
VAR i:      INTEGER;
    tab:    TTabDescritor;

BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    {$IFC fTrce}BP(11);{$ENDC}
    {lpd, achad}
    WRITELN('the character Descriptor is ');
    FOR i := 1 TO activeStream.data.size DO
        WRITE(activeStream.data.At(i));
    WRITELN;
    WRITELN('   maxDataSize ', activeStream.maxDataSize);

{$H-}
    WITH activeStream.characterDescriptor DO
        BEGIN
        WRITELN('      font ', font);
        WRITELN('      face ');
        WRITELN('      Superscript ', Superscript);
        WRITELN('      keepOnSamePage ', keepOnSamePage);
        END;
    WRITELN('the paragraph Descriptor is ');
    WITH activeStream.paragraphDescriptor DO
        BEGIN
        WRITELN('      paraGraphStart ', paraGraphStart);
        WRITELN('      firstLineMargin ', firstLineMargin);
        WRITELN('      bodyMargin ', bodyMargin);
        WRITELN('      rightMargin ', rightMargin);
        WRITELN('      paraLeading ', paraLeading);
        WRITELN('      lineSpacing ', lineSpacing);
        WRITELN('      ', tabTable.size:2,' Tabs ');
        FOR i := 1 TO tabTable.size DO
            BEGIN
            tab := TTabDescritor(tabTable.At(i));
            WITH tab DO
                BEGIN
                WRITELN('           position ', position);
                WRITE  ('           fillBetweenTabs ');
                CASE fillBetweenTabs OF
                    tNoFill:        WRITELN('No fill');
                    tDotFill:       WRITELN('Dot fill');
                    tHyphenFill:    WRITELN('Hyphen fill');
                    tUnderLineFill: WRITELN('Underline fill');
                END;{CASE}
                WRITE  ('           tabType ');
                CASE tabType OF
                    qLeftTab:       WRITELN('Left tab');
                    qCenterTab:     WRITELN('Center tab');
                    qRightTab:      WRITELN('Right tab');
                    qPeriodTab:     WRITELN('Decimal period tab');
                    qCommaTab:      WRITELN('Decimal comma tab');
                END;{CASE}
                END;
            END;
        WRITE  ('      paraType ');
        CASE paraType OF
            qLeftPara:      WRITELN('Left aligned');
            qCenterPara:    WRITELN('Centered');
            qRightPara:     WRITELN('Right aligned');
            qJustPara:      WRITELN('Justified');
        END;{CASE}
        WRITELN('      hasPicture ', hasPicture);
        END;
{$H+}
    {$IFC fTrce}EP;{$ENDC}
END;
{$ENDC}


{$IFC fUniversalTextTrace}
{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE PrintLpd(theLpd: TALpd);
{--------------------------------------------------------------------------------------------------------}

    PROCEDURE WriteQuad(quad: TQuad);
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        CASE quad OF
            quadL: WRITELN('quadL');
            quadC: WRITELN('quadC');
            quadR: WRITELN('quadR');
            quadJ: WRITELN('quadJ');
        END;
    END;

    PROCEDURE WriteTArpe(arpe: TArpe);
    VAR i:  INTEGER;
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        WITH arpe DO
            BEGIN
            WRITELN('    cb:             ', cb:1);
            WRITELN('    sy:             ', sy:1);
            WRITELN('    xLftFst:        ', xLftFst:1);
            WRITELN('    xLftBody:       ', xLftBody:1);
            WRITELN('    xRt:            ', xRt:1);
            WRITELN('    yLd:            ', yLd:1);
            WRITELN('    fill1:          ', fill1:1);
            WRITELN('    yLine:          ', yLine:1);
            WRITE  ('    quad:           ');
            WriteQuad(quad);
            WRITELN('    itbLim:         ', itbLim:1);
            WRITELN('    argtbd:');
            FOR i := 0 TO itbLim - 1 DO
                {$R-}
                WITH argtbd[i] DO
                    BEGIN
                    WRITELN('    [',i:0,']:');
                    WRITELN('        x:              ', x:1);
                (*  WRITELN('        fill4:          ', fill4:1); *)
                    WRITE  ('        quad:           ');
                    WriteQuad(argtbd[i].quad);
                    WRITE  ('        tyfill:         ');
                    CASE tyfill OF
                        tyfillNil:  WRITELN('tyfillNil');
                        tyfillDots: WRITELN('tyfillDots');
                        tyfillHyph: WRITELN('tyfillHyph');
                        tyfillUL:   WRITELN('tyfillUL');
                    END;

                    WRITELN('        chLdr:          ', chLdr:1);
                    END;
                {$R+}
            END;
    END;


BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    {$IFC fTrce}BP(11);{$ENDC}

    WRITELN('ΡΡΡΡΡΡ Lpd ΡΡΡΡΡΡΡ');

    WITH theLpd DO
        BEGIN
        WRITELN('ics:            ', ics:1);
        WRITELN('ilpd:           ', ilpd:1);
        WRITELN('fParSt:         ', fParSt);
        WRITELN('lp:             ', lp:1);
        WRITELN('lplim           ', lplim:1);
        WRITELN('lpson:          ', lpson:1);
        WRITELN('icsson:         ', icsson:1);
        WRITELN('tyset:');
        WITH tyset DO
            BEGIN
            WRITELN('   fRce:            ', tyset.fRce);
            WRITELN('   fParBnds:        ', tyset.fParBnds);
            WRITELN('   fRpe:            ', tyset.fRpe);
            END;
        WRITELN('lpFstPar:       ', lpFstPar:1);
        WRITELN('lpLimPar:       ', lpLimPar:1);

        IF tyset.fRpe THEN
            IF rpe = NIL THEN
                WRITELN('rpe:            NIL')
            ELSE
                WITH rpe^ DO
                BEGIN
                WRITELN('rpe:');
                WriteTArpe(rpe^);
                END;

        IF tyset.fRce THEN
            WITH arce DO
                BEGIN
                WRITELN('arce:');
                WRITELN('    cb:             ', cb:1);
                WRITELN('    fVan:           ', fVan:1);
                WRITELN('    fBold:          ', fBold:1);
                WRITELN('    fItalic:        ', fItalic:1);
                WRITELN('    fUnderline:     ', fUnderline:1);
                WRITELN('    fill4:          ', fill4:1);
                WRITELN('    cbSuperscript:  ', cbSuperscript:1);
                WRITELN('    ifnt:           ', ifnt:1);
                WRITELN('    fKeep:          ', fKeep:1);
                WRITELN('    fOutLine:       ', fOutLine:1);
                WRITELN('    fShadow:        ', fShadow:1);
                WRITELN('    fFillB:         ', fFillB:1);
                WRITELN('    fFillC:         ', fFillC:1);
                WRITELN('    fFillD:         ', fFillD:1);
                WRITELN('    fFillE:         ', fFillE:1);
                WRITELN('    fFillF:         ', fFillF:1);
                END;

        IF tyset.fRpe THEN
                BEGIN
                WRITELN('arpe:');
                WriteTArpe(arpe);
                END;

        END;

    WRITELN('ΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡ');
    WRITELN;
    {$IFC fTrce}EP;{$ENDC}
END;
{$ENDC}




{$IFC fUniversalTextTrace}
{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE PrintAchad(achad: TAchad);
{--------------------------------------------------------------------------------------------------------}
VAR i:      INTEGER;
    size:   INTEGER;

BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    {$IFC fTrce}BP(11);{$ENDC}
    WITH achad DO
        BEGIN
        WRITELN('ΡΡΡΡΡ Achad ΡΡΡΡΡΡ');
        WRITELN('ichFst:         ', ichFst:1);
        WRITELN('ichLim:         ', ichLim:1);
        IF rgch <> NIL THEN
            BEGIN
            size := ichlim - ichFst - 1;
            IF size >= 80 THEN
                size := 79;
            FOR i := ichFst TO ichFst + size DO
                {$R-}
                IF rgch^[i] >= 32 THEN
                    WRITE(CHR(rgch^[i]))
                ELSE
                    WRITE('<', rgch^[i]:0, '>');
                {$R+}
            WRITELN;
            IF ichlim - ichFst >= 79 THEN
                WRITELN('etc, etc...');
            END;
        WRITELN('ΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡ');
        WRITELN;
        END;
    {$IFC fTrce}EP;{$ENDC}
END;
{$ENDC}




{$IFC fUniversalTextTrace}
{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE PrintSecrets(achad: TAchad; theLpd: TALpd);
{--------------------------------------------------------------------------------------------------------}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    {$IFC fTrce}BP(11);{$ENDC}
    WRITELN('streamArrayIndex is ', secrets.streamArrayIndex);
    PrintLpd(theLpd);
    PrintAchad(achad);
    {$IFC fTrce}EP;{$ENDC}
END;
{$ENDC}


{$IFC WithUObject}
{$S TKUTWrite}
{$ELSEC}
{$S UTWrite}
{$ENDC}
{--------------------------------------------------------------------------------------------------------}
PROCEDURE SeqLpdUTBB(Lpd: TLpd; var achad: Tachad);
{--------------------------------------------------------------------------------------------------------}
VAR howMany:    INTEGER;
    done:       BOOLEAN;
    index:      INTEGER;
    backUp:     INTEGER;
    newPara:    BOOLEAN;
{$IFC WithUObject}
    newData:    TString;
{$ELSEC}
    newData:    TUTString;
{$ENDC}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    {$IFC fTrce}BP(11);{$ENDC}

                {LSR: put the next assignment and the WITH before the debugging code because
                        PrintSecrets depends on it.}
    currentLpd := lpd;                                  { Remember the lpd for RunToStream }

    WITH lpd^ DO                                        { Make shure the lpd is set up OK }
        BEGIN
        rpe := @arpe;
        rce := @arce;
        END;

    {$IFC fUniversalTextTrace}
    IF fPrintSecrets THEN
        BEGIN
        WRITELN('ΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡ SeqLpdUTBB ΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡ');
        PrintSecrets(achad, currentLpd^);
        WRITELN('dataLp =       ', dataLp:0);
        WRITELN('dataIndex =    ', dataIndex:0);
        WRITELN('nOfSavedPara = ', nOfSavedPara:0);
        END;
    {$ENDC}

    newPara := FALSE;                                   {Assume no new para}
                                                        { Compute if we have to back up }
    backUp := MIN(maxBacking, MAX(dataLp - lpd^.lpLim, 0));

    {$IFC fUniversalTextTrace}
    IF fPrintSecrets THEN
        WRITELN('backUp =       ', backUp:0);
    {$ENDC}

    IF backUp > 0 THEN
        BEGIN
        index := 1;
        done := FALSE;
        WHILE (NOT done) AND (index <= nOfSavedPara) DO
            WITH savedPara[index]^^, lpd^ DO
                IF firstLp <= lpLim THEN
                    BEGIN
                    {$IFC fUniversalTextTrace}
                    IF fPrintSecrets THEN
                        WRITELN('Backing up... to saved paragraph #', index:0);
                    {$ENDC}

                    lpLim := MAX(firstLp, lpLim);
                    theData := theText;
                    dataIndex := lpLim - firstLp;
                    arpe := theArpe;
                    IF dataIndex <> 0 THEN
                        fParSt := FALSE;
                    arce := theArce;
                    done := TRUE;
                    END
                ELSE
                    index := index + 1;

        IF NOT done THEN                                { This is FATAL !!!}
            BEGIN
            {$IFC fUniversalTextTrace}
            WRITELN('Fatal back up attempt in SeqLpdUTBB');
            PrintSecrets(achad, lpd^);
            {$ENDC}

            HALT;   {Die rather than fuck up}
            END;
        END
    ELSE
        BEGIN
        IF activeStream.data.Size = 0 THEN              { Test if there is anything left in the buffer, }
            BEGIN
            newPara := TRUE;
            activeStream.ParagraphDescriptor.paraGraphStart := TRUE;
{$IFC WithUObject}
            activeStream.ParagraphDescriptor.additionalChrInParagraph := 0;
{$ENDC}
            activeStream.FillParagraph;                 { if not then try to get one more paragraph }
            activeStream.data.StopEdit;                 { Remove any holes from data }

            {$IFC fUniversalTextTrace}
            IF fPrintSecrets THEN
                BEGIN
                WRITELN('FillRun returns:');
                PrintRun;
                END;
            {$ENDC}

            dataIndex := 0;                             { Reset the index to the begining of the text}

            WITH lpd^ DO                                { Pre-fill the lpd with standard data }
                BEGIN
          {$H-} MoveRgch(@arpe, @arpeStd, arpeStd.cb); {$H+}
          {$H-} MoveRgch(@arce, @arceStd, arceStd.cb); {$H+}
                dataLp := lpLim;
                END;

            activeStream.RunToStream;                   { Convert into stream format }
            END
        ELSE
            BEGIN
            {$IFC fUniversalTextTrace}
            IF fPrintSecrets THEN
                WRITELN('Procede with the rest of the old run:');
            {$ENDC}
            dataIndex := Lpd^.lpLim - dataLp;
            IF dataIndex <> 0 THEN
                lpd^.fParSt := FALSE;
            END;

        theData := activeStream.data;
        END;


                                                        { Compute how many bytes to transfer this time }
    howMany := MIN(achad.ichLim - achad.ichFst, theData.size - dataIndex);

    {$IFC fUniversalTextTrace}
    IF fPrintSecrets THEN
        BEGIN
        WRITELN('theData.size = ', theData.size:0);
        WRITELN('dataLp =       ', dataLp:0);
        WRITELN('dataIndex =    ', dataIndex:0);
        WRITELN('howMany =      ', howMany:0);
        WRITELN('newPara =      ', newPara:0);
        END;
    {$ENDC}

    WITH lpd^ DO
        BEGIN
        lp := lpLim;
        lplim := lp + howMany;
        END;

    WITH secrets.achad DO                               { Build our own achad just in case... }
        BEGIN
        rgch := POINTER(ORD4(theData.AddrMember(1)) + dataIndex);
        ichfst := 0;
        ichLim := howMany;
        END;
                                                        { Copy the achad }
                                                        { Check for NIL rgch.}
                                                        { If NIL then pass data else copy the data }
    IF achad.rgch = NIL THEN
        achad := secrets.achad
    ELSE
        BEGIN
        achad.ichlim := achad.ichFst + howMany;
        MoveAchad(achad, secrets.achad);
        END;

    IF howMany = 0 THEN                                     { We are done, kill all saved stuff }
        FOR index := 1 TO nOfSavedPara DO
            BEGIN
            savedPara[index]^^.theText.Free;
            FreeH(HzFromH(TH(savedPara[index])), TH(savedPara[index]));
            END
    ELSE
        BEGIN
        IF newPara THEN                                  { New text in activeStream.data... }
            BEGIN
            done := FALSE;
            index := nOfSavedPara;
            WHILE (NOT done) AND (index > 0) DO             { Get ridd of old stuff }
                WITH savedPara[index]^^ DO
                    IF (lpd^.lpLim - (firstLp + theText.size) ) >= maxBacking THEN {LSR}
                        BEGIN
                        theText.Free;
                        FreeH(HzFromH(TH(savedPara[index])), TH(savedPara[index]));
                        index := index - 1;
                        nOfSavedPara := nOfSavedPara - 1;
                        END
                    ELSE
                        done := true;

                     {LSR: changed direction of following loop}
            FOR index := nOfSavedPara DOWNTO 1 DO               { Shift everything to free the first one }
                savedPara[index + 1] := savedPara[index];

            nOfSavedPara := nOfSavedPara + 1;

                                                            { Make a new place to save old paragraphs }
            savedPara[1] := POINTER(HAllocate(THz(activeStream.Heap), SIZEOF(TSavedPara)));
            WITH savedPara[1]^^, lpd^ DO
                BEGIN
                firstLp := lp;
                theArpe := arpe;
                theArce := arce;
                theText := activeStream.data;
                END;
            END;

        IF (dataIndex + howMany) >= activeStream.data.Size THEN
            BEGIN                               { Make a fresh string, the old one is in savedPara[1] }

                        {LSR: break up the assignment to activeStream.data to prevent dereferenced handles}
{$IFC WithUObject}
            newData := TString.CREATE(NIL, activeStream.heap, activeStream.maxDataSize);
{$ELSEC}
            newData := TUTString.CREATE(NIL, activeStream.heap, activeStream.maxDataSize);
{$ENDC}
            activeStream.data := newData;
            activeStream.data.StartEdit(50);                {Allow holes}
            dataLp := lpd^.lpLim;                           {Make shure backUp will compute to zero}
            END;
        END;

    {$IFC fUniversalTextTrace}
    IF fPrintSecrets THEN
        BEGIN
        PrintSecrets(achad, currentLpd^);
        WRITELN('dataLp =       ', dataLp:0);
        WRITELN('dataIndex =    ', dataIndex:0);
        WRITELN('nOfSavedPara = ', nOfSavedPara:0);
        WRITELN('ΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡΡ');
        WRITELN;
        WRITELN;
        END;
    {$ENDC}

    {$IFC fTrce}EP;{$ENDC}
END;


{$IFC WithUObject}
METHODS OF TTKUnivText
{$ELSEC}
METHODS OF TUnivText
{$ENDC}

{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
{$IFC WithUObject}
    FUNCTION  {TUnivText.}CREATE(object:  TObject;
                                 itsHeap: THeap;
                                 itsTString: TString;
                                 itsDataSize: INTEGER)
                                                      : TTKUnivText;
{$ELSEC}
    FUNCTION  {TUnivText.}CREATE(object:  TUTObject;
                                 itsHeap: THeap;
                                 itsTString: TUTString;
                                 itsDataSize: INTEGER)
                                                      : TUnivText;
{$ENDC}
    {----------------------------------------------------------------------------------------------------}

{$IFC WithUObject}
    VAR thisTabTable:   TArray;
{$ELSEC}
    VAR thisTabTable:   TUTArray;
{$ENDC}
        thisString:     ^Tsp;

    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        IF object = NIL THEN
{$IFC WithUObject}
            object := NewObject(itsHeap, THISCLASS);
{$ELSEC}
            object := NewUTObject(itsHeap, THISCLASS);
{$ENDC}

{$IFC WithUObject}
        SELF := TTKUnivText(object);
{$ELSEC}
        SELF := TUnivText(object);
{$ENDC}

        { Get the stream }

        SELF.itsOurTString := itsTString = NIL;
        IF SELF.itsOurTString THEN
{$IFC WithUObject}
            itsTString := TString.CREATE(NIL, itsHeap, itsDataSize);
{$ELSEC}
            itsTString := TUTString.CREATE(NIL, itsHeap, itsDataSize);
{$ENDC}

        itsTString.StartEdit(50);                   {Allow holes}
        SELF.data := itsTString;
        SELF.maxDataSize := itsDataSize;

{$IFC WithUObject}
        thisTabTable := TArray.CREATE(NIL, itsHeap, 0, SIZEOF(TTabDescriptor));
{$ELSEC}
        thisTabTable := TUTArray.CREATE(NIL, itsHeap, 0, SIZEOF(TTabDescriptor));
{$ENDC}
        thisTabTable.StartEdit(5);
        SELF.paragraphDescriptor.tabTable := thisTabTable;
        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TUnivText.}Free;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        {If the dynamic array was not passed in then free it}
        IF SELF.itsOurTString THEN
            SELF.data.Free;
        SELF.paragraphDescriptor.tabTable.Free;
        SUPERSELF.Free;
        {$IFC fTrce}EP;{$ENDC}
    END;


    {$IFC fDebugMethods}
{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TUnivText.}Fields(PROCEDURE Field(nameAndType: S255));
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SUPERSELF.Fields(Field);
        Field('paraGraphStart: BOOLEAN');
{$IFC WithUObject}
        Field('additionalChrInParagraph: INTEGER');
{$ENDC}
        Field('firstLineMargin: INTEGER');
        Field('bodyMargin: INTEGER');
        Field('rightMargin: INTEGER');
        Field('paraLeading: INTEGER');
        Field('lineSpacing: BYTE');
{$IFC WithUObject}
        Field('tabTable: TArray');
{$ELSEC}
        Field('tabTable: TUTArray');
{$ENDC}
        Field('paraType: BYTE');
        Field('hasPicture: BOOLEAN');
        Field('font: INTEGER');
        Field('face: BYTE');
        Field('superscript: BYTE');
        Field('keepOnSamePage: BOOLEAN');
        Field('maxDataSize: INTEGER');
{$IFC WithUObject}
        Field('data: TString');
{$ELSEC}
        Field('data: TUTString');
{$ENDC}
        Field('itsOurTString: BOOLEAN');
        Field('');
    END;
    {$ENDC}


{$IFC WithUObject}
{$S TKUTWrite}
{$ELSEC}
{$S UTWrite}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TUnivText.}RunToStream;
    {----------------------------------------------------------------------------------------------------}
    VAR i:          INTEGER;
        found:      BOOLEAN;

    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}

        IF currentLpd^.tyset.fRce THEN
          { Convert the character descriptor }
            WITH SELF.characterDescriptor, currentLpd^.rce^ DO
                BEGIN

              { Set the face fields }
                fbold       := bold IN face;
                fitalic     := italic IN face;
                funderline  := underline IN face;
                foutline    := outline IN face;
                fshadow     := shadow IN face;

                fvan := FALSE;      {No vanished runs}

              { Because of the way lotus does fonts we have to convert the a real font to a lotus font }
                found := FALSE;
                i := 0;
                WHILE (i <= ifntlst) AND NOT(found) DO
                    BEGIN
                    IF argfam[i] = font THEN
                        BEGIN
                        ifnt := i;
                        found := TRUE;
                        END;
                    i := i + 1;
                    END;
                IF NOT found THEN ifnt := 0;

                cbSuperscript := superscript;
                fKeep := keepOnSamePage;
                END; { with }

      { Convert the paragraph descriptor }
        WITH SELF.ParagraphDescriptor, currentLpd^, rpe^ DO
            BEGIN
            fParSt := paraGraphStart;
            IF paraGraphStart THEN
                BEGIN
                        {LSR: added lpLim to the right side of each of the following assignments}
                lpFstPar := lpLim;
{$IFC WithUObject}
                lpLimPar := lpLim + SELF.data.Size + additionalChrInParagraph;
{$ELSEC}
                lpLimPar := lpLim + SELF.data.Size;
{$ENDC}
                END;

            IF tyset.fRpe THEN
                BEGIN
                xLftFst := firstLineMargin;
                xLftBody := bodyMargin;
                xRt := rightMargin;
                yLd := paraLeading;
                yLine := lineSpacing;

                CASE paraType OF
                    qLeftPara:      quad := quadL;
                    qCenterPara:    quad := quadC;
                    qRightPara:     quad := quadR;
                    qJustPara:      quad := quadJ;
                    OTHERWISE       quad := quadL;
                END;{CASE}

                itbLim := tabTable.Size - 1;
          {$H-} SELF.TabTableToArgTbd; {$H+}    { This invalidates WITH statement!! }
                END;
            END;

        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TUnivText.}StreamToRun;
    {----------------------------------------------------------------------------------------------------}
    VAR ifnt:       INTEGER;
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
      { do the format stuff }
        IF secrets.lpd.tyset.frce THEN
            WITH SELF.characterDescriptor, secrets.lpd.rce^ DO
                BEGIN
                font := argfam[ifnt];
                face := [];
                IF fbold THEN
                    face := face + [bold];
                IF fitalic THEN
                    face := face + [italic];
                IF funderline THEN
                    face := face + [underline];
                IF foutline THEN
                    face := face + [outline];
                IF fshadow THEN
                    face := face + [shadow];
                superscript := cbSuperscript;
                keepOnSamePage := fKeep;
                END;

        IF secrets.lpd.tyset.frpe THEN
            BEGIN
            WITH SELF.paragraphDescriptor, secrets.lpd.rpe^ DO
                BEGIN
                paraGraphStart := secrets.lpd.fParSt;
                firstLineMargin := xLftFst;
                bodyMargin := xLftBody;
                rightMargin := xRt;
                paraLeading := yLd;
                lineSpacing := yLine;
                hasPicture := FALSE; {not yet implemented}

                CASE quad OF
                    quadL:      paraType := qLeftPara;
                    quadC:      paraType := qCenterPara;
                    quadR:      paraType := qRightPara;
                    quadJ:      paraType := qJustPara;
                    OTHERWISE   paraType := qLeftPara;
                END;{CASE}

                IF itbLim < 0 THEN                  { Resize the tab table and move the data }
                    itbLim := -1;
                END;

            SELF.ArgTbdToTabTable;
            END;
        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTWrite}
{$ELSEC}
{$S UTWrite}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TUnivText.}TabTableToArgTbd;
    {----------------------------------------------------------------------------------------------------}
    VAR i:          INTEGER;
        temp:       INTEGER;
        ptrToTab:   Ptr;
        tab:        TTabDescriptor;

    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        temp := MIN(SELF.paragraphDescriptor.tabTable.size, magicTabMax);
        FOR i:= 1 to temp  DO
            BEGIN
            tab := TTabDescriptor(SELF.paragraphDescriptor.tabTable.At(i));
            {R$-}
            WITH tab, currentLpd^.rpe^.argTbd[i-1] DO
                BEGIN
                x := position;

                CASE tabType OF
                    qLeftTab:
                        quad := quadL;
                    qCenterTab:
                        quad := quadC;
                    qRightTab:
                        quad := quadR;
                    qPeriodTab:
                        BEGIN
                        quad := quadJ;
                        fDecimalComma := FALSE;
                        END;
                    qCommaTab:
                        BEGIN
                        quad := quadJ;
                        fDecimalComma := TRUE;
                        END;
                    OTHERWISE
                        quad := quadL;
                END;{CASE}

                CASE fillBetweenTabs OF
                    tNoFill:
                        BEGIN
                        tyFill := tyFillNil;
                        chLdr := ORD(' ');
                        END;
                    tDotFill:
                        BEGIN
                        tyFill := tyFillDots;
                        chLdr := ORD('.');
                        END;
                    tHyphenFill:
                        BEGIN
                        tyFill := tyFillHyph;
                        chLdr := ORD('-');
                        END;
                    tUnderLineFill:
                        BEGIN
                        tyFill := tyFillUL;
                        chLdr := ORD('_');
                        END;
                    OTHERWISE
                        BEGIN
                        tyFill := tyFillNil;
                        chLdr := ORD(' ');
                        END;
                END;{CASE}

                END;
            {$R+}
            END;
        currentLpd^.rpe^.itbLim := temp - 1;
        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TUnivText.}ArgTbdToTabTable;
    {----------------------------------------------------------------------------------------------------}
    VAR i:          INTEGER;
        tab:        TTabDescriptor;

    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        { Size down the tab array for writing }
        SELF.paragraphDescriptor.tabTable.DelAll;
        FOR i := 0 to secrets.lpd.rpe^.itbLim - 1 DO
            BEGIN
            {$R-}
            WITH tab, secrets.lpd.rpe^.argTbd[i] DO
                BEGIN
                position := x;

                CASE quad OF
                    quadL:      tabType := qLeftTab;
                    quadC:      tabType := qCenterTab;
                    quadR:      tabType := qRightTab;
                    quadJ:      IF fDecimalComma THEN
                                    tabType := qCommaTab
                                ELSE
                                    tabType := qPeriodTab;
                    OTHERWISE   tabType := qLeftTab;
                END;{CASE}

                CASE tyFill OF
                    tyFillNil:  fillBetweentabs := tNoFill;
                    tyFillDots: fillBetweentabs := tDotFill;
                    tyFillHyph: fillBetweentabs := tHyphenFill;
                    tyFillUL:   fillBetweentabs := tUnderLineFill;
                    OTHERWISE   fillBetweentabs := tNoFill;
                END;{CASE}

                {$IFC fUniversalTextTrace}
                IF fPrintSecrets THEN
                    BEGIN
                    WRITELN('Tab #', i + 1:0, ', tabType =', ORD(tabType):0, ', quad =', ORD(quad):0);
                    END;
                {$ENDC}
                END;
            {$R+}
            SELF.paragraphDescriptor.tabTable.InsLast(@tab);
            END;
        {$IFC fTrce}EP;{$ENDC}
    END;

{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
    {$IFC fUniversalTextTrace}
    fPrintSecrets := FALSE;
    {$ENDC}
END;


{$IFC WithUObject}
METHODS OF TTKReadUnivText
{$ELSEC}
METHODS OF TReadUnivText
{$ENDC}

{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
{$IFC WithUObject}
    FUNCTION  {TReadUnivText.}CREATE(object:  TObject;
                                     itsHeap: THeap;
                                     itsTString: TString;
                                     itsDataSize: INTEGER;
                                     LevelOfGranularity: TLevelOfGranularity)
                                                                             : TTKReadUnivText;
{$ELSEC}
    FUNCTION  {TReadUnivText.}CREATE(object:  TUTObject;
                                     itsHeap: THeap;
                                     itsTString: TUTString;
                                     itsDataSize: INTEGER;
                                     LevelOfGranularity: TLevelOfGranularity)
                                                                             : TReadUnivText;
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    VAR index:      TB;
{$IFC WithUObject}
        thisList:   TString;
{$ELSEC}
        thisList:   TUTString;
{$ENDC}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}

      { Establish the level of granularity for reading }
        WITH secrets.lpd.tyset DO
            BEGIN
            frce := UTCharacters IN LevelOfGranularity;
            frpe := UTparagraphs IN LevelOfGranularity;
            fParBnds := FALSE;
            END;

        GetCSScrap(index);
        IF index = 0 THEN
            SELF := NIL
        ELSE
            BEGIN
            secrets.streamArrayIndex := index;
            IF object = NIL THEN
{$IFC WithUObject}
                object := NewObject(itsHeap, THISCLASS);
{$ELSEC}
                object := NewUTObject(itsHeap, THISCLASS);
{$ENDC}

{$IFC WithUObject}
            SELF := TTKReadUnivText(TTKUnivText.CREATE(object, itsHeap, itsTString, itsDataSize));
{$ELSEC}
            SELF := TReadUnivText(TUnivText.CREATE(object, itsHeap, itsTString, itsDataSize));
{$ENDC}

{$IFC WithUObject}
            thisList := TString.CREATE(NIL, itsHeap, itsDataSize);
{$ELSEC}
            thisList := TUTString.CREATE(NIL, itsHeap, itsDataSize);
{$ENDC}
            thisList.StartEdit(50);                   {Allow holes}
            SELF.buffer := thisList;

            SELF.dataBeforeTab := TRUE;
            SELF.Restart;               { Set up for reading from the beginning}
            END;
        {$IFC fTrce}EP;{$ENDC}
    END;


    {$IFC fDebugMethods}
{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TReadUnivText.}Fields(PROCEDURE Field(nameAndType: S255));
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        SUPERSELF.Fields(Field);
{$IFC WithUObject}
        Field('buffer: TString');
{$ELSEC}
        Field('buffer: TUTString');
{$ENDC}
        Field('');
    END;
    {$ENDC}


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TReadUnivText.}Free;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        SELF.buffer.Free;
        SUPERSELF.Free;
        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TReadUnivText.}Restart;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        { Set up the Achad for reading from the beginning}
        WITH secrets.achad DO
            BEGIN
            ichFst := 0;
            ichLim := SELF.data.size;
            END;

        secrets.lpd.lpLim := 0;

        SELF.columnCount := 0;
        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TReadUnivText.}ScanTable(VAR rows, tabColumns, tabStopColumns: INTEGER);
    {----------------------------------------------------------------------------------------------------}
    VAR
        fieldOverflow:      BOOLEAN;
        fieldTerminator:    CHAR;
        lastTerminator:     CHAR;
        tabType:            TTabTypes;
        columnsInThisRow:   INTEGER;
        dataBeforeTab:      BOOLEAN;

    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        rows := 0;
        tabColumns := 1;
        tabStopColumns := 0;
        columnsInThisRow := 1;          {There is at least one column}
        SELF.dataBeforeTab := TRUE;     {Make shure ReadField doesn't skip any fields}
        dataBeforeTab := FALSE;

        SELF.Restart;
        WHILE SELF.ReadField(1, fieldOverflow, fieldTerminator, tabType) DO
            BEGIN
            IF columnsInThisRow = 1 THEN
                BEGIN
                IF SELF.data.size > 0 THEN
                    dataBeforeTab := TRUE;
                IF tabStopColumns < SELF.paragraphDescriptor.tabTable.size THEN
                    tabStopColumns := SELF.paragraphDescriptor.tabTable.size;
                END;
            lastTerminatior := fieldTerminator;
            IF fieldTerminator = CHR(chCr) THEN
                BEGIN
                rows := rows + 1;
                columnsInThisRow := 1;
                {Check the tab table here}
                END
            ELSE
                IF fieldTerminator = CHR(chTab) THEN
                    BEGIN
                    columnsInThisRow := columnsInThisRow + 1;
                    IF columnsInThisRow > tabColumns THEN
                        tabColumns := columnsInThisRow;
                    END;
            END;

        SELF.Restart;

        IF (NOT dataBeforeTab) AND (tabColumn > 0) THEN
            tabColumns := tabColumns - 1;
        SELF.dataBeforeTab := dataBeforeTab;

        IF lastTerminatior <> CHR(chCr) THEN
            rows := rows + 1;

        {$IFC fUniversalTextTrace}
        IF fPrintSecrets THEN
            BEGIN
            WRITELN('ScanTable:');
            WRITELN('   dataBeforeTab:      ', dataBeforeTab);
            WRITELN('   tabColumns:         ', tabColumns);
            WRITELN('   tabStopColumns:     ', tabStopColumns);
            WRITELN('   rows:               ', rows);
            END;
        {$ENDC}

    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TReadUnivText.}ReadField(    maxFieldSize: INTEGER;
                                        VAR fieldOverflow: BOOLEAN;
                                        VAR fieldTerminator: CHAR;
                                        VAR tabType: TTabTypes)
                                                               : BOOLEAN;
    {----------------------------------------------------------------------------------------------------}
{$IFC WithUObject}
    VAR data:               TString;
        buffer:             TString;
{$ELSEC}
    VAR data:               TUTString;
        buffer:             TUTString;
{$ENDC}
        i:                  INTEGER;
        terminatorFound:    BOOLEAN;
        result:             BOOLEAN;
        oldSize:            INTEGER;
        newSize:            INTEGER;
        columnNr:           INTEGER;
        tab:                TTabDescriptor;
        ch:                 CHAR;

        PROCEDURE ReadBuffer;
        BEGIN
            SELF.data := buffer;
            SELF.ReadRun;
            SELF.data := data;
        END;

    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}


        REPEAT
            buffer := SELF.buffer;
            data := SELF.data;

            IF buffer.Size = 0 THEN                         { If there is no data then get some }
                ReadBuffer;

            fieldTerminator := CHR(0);
            fieldOverflow := FALSE;

            data.DelAll;
            terminatorFound := FALSE;
            IF buffer.Size > 0 THEN                         { If there is still text to paste }
                BEGIN

                tabType := qLeftTab;                       { Default tab type }
                IF SELF.columnCount > 0 THEN
                    IF SELF.paragraphDescriptor.tabTable.size >= SELF.columnCount THEN
                        tabType := TTabDescriptor(
                                        SELF.paragraphDescriptor.tabTable.At(SELF.columnCount)
                                                  ).tabType;
                SELF.columnCount := SELF.columnCount + 1;
                columnNr := SELF.columnCount;
                result := TRUE;
                REPEAT
                    i := 0;
                    WHILE (i < buffer.Size) AND (NOT terminatorFound) DO
                        BEGIN
                        i := i + 1;
                        ch := buffer.At(i);
                        IF (ch = CHR(chTab)) OR (ch = CHR(chCr)) THEN
                            BEGIN
                            terminatorFound := TRUE;
                            fieldTerminator := ch;
                            IF fieldTerminator = CHR(chCr) THEN
                                SELF.columnCount := 0;
                            END;
                        END;

                    oldSize := data.Size;
                    newSize := oldSize + i;
                    IF terminatorFound THEN                 { Hide the terminating character, if any }
                        newSize := newSize - 1;

                    IF newSize > maxFieldSize THEN
                        BEGIN
                        newSize := maxFieldSize;
                        fieldOverflow := TRUE;
                        END;

                    IF newSize > oldSize THEN
                        data.InsManyAt(1 + data.size, buffer, 1, newSize - oldSize);

                    buffer.DelManyAt(1, i);

                    IF (NOT terminatorFound) AND (buffer.Size = 0) THEN
                        ReadBuffer;
                UNTIL terminatorFound OR (buffer.Size = 0);

                {$IFC fUniversalTextTrace}
                IF fPrintSecrets THEN
                    BEGIN
                    WRITELN('Buffer size is ',buffer.Size:1, ' data size is ',data.size:1);
                    FOR i := 1 to data.size DO
                        WRITE(data.At(i));
                    IF fieldTerminator = CHR(chTab) THEN
                        WRITE('<Tab>')
                    ELSE
                    IF fieldTerminator = CHR(chCr) THEN
                        WRITE('<Cr>')
                    ELSE
                        WRITE('<End of paste>');
                    WRITELN;
                    WRITELN('FieldOverflow is ', fieldOverflow);
                    END;
                {$ENDC}
                END
            ELSE
                result := FALSE;
        UNTIL (NOT result) OR (columnNr > 1) OR SELF.dataBeforeTab;
        ReadField := result;

        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TReadUnivText.}ReadLine(    maxLineSize: INTEGER;
                                       VAR lineOverflow: BOOLEAN;
                                       VAR lineTerminator: CHAR)
                                                                : BOOLEAN;
    {----------------------------------------------------------------------------------------------------}
{$IFC WithUObject}
    VAR data:               TString;
        buffer:             TString;
{$ELSEC}
    VAR data:               TUTString;
        buffer:             TUTString;
{$ENDC}
        i:                  INTEGER;
        terminatorFound:    BOOLEAN;
        oldSize:            INTEGER;
        newSize:            INTEGER;
        ch:                 CHAR;

        PROCEDURE ReadBuffer;
        BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
            SELF.data := buffer;
            SELF.ReadRun;
            SELF.data := data;
        END;

    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        buffer := SELF.buffer;
        data := SELF.data;

        IF buffer.Size = 0 THEN                         { If there is no data then get some }
            ReadBuffer;

        lineTerminator := CHR(0);
        lineOverflow := FALSE;

        data.DelAll;
        terminatorFound := FALSE;
        IF buffer.Size > 0 THEN                         { If there is still text to paste }
            BEGIN
            ReadLine := TRUE;
            REPEAT
                i := 0;
                WHILE (i < buffer.size) AND (NOT terminatorFound) DO
                    BEGIN
                    i := i + 1;
                    ch := buffer.At(i);
                    IF ch = CHR(chCr) THEN
                        BEGIN
                        terminatorFound := TRUE;
                        lineTerminator := ch;
                        END;
                    END;

                oldSize := data.Size;
                newSize := oldSize + i;
                IF terminatorFound THEN                     { Hide the terminating character, if any }
                    newSize := newSize - 1;

                IF newSize > maxLineSize THEN
                    BEGIN
                    newSize := maxLineSize;
                    lineOverflow := TRUE;
                    END;

                IF newSize > oldSize THEN
                    data.InsManyAt(1 + data.size, buffer, 1, newSize - oldSize);

                buffer.DelManyAt(1, i);

                IF (NOT terminatorFound) AND (buffer.Size = 0) THEN
                    ReadBuffer;
            UNTIL terminatorFound OR (buffer.Size = 0);

            {$IFC fUniversalTextTrace}
            IF fPrintSecrets THEN
                BEGIN
                WRITELN('Buffer size is ',buffer.Size:1, ' data size is ',data.size:1);
                FOR i := 1 to data.size DO
                    WRITE(data.At(i));
                IF lineTerminator = CHR(chCr) THEN
                    WRITE('<Cr>')
                ELSE
                    WRITE('<End of paste>');
                WRITELN;
                WRITELN('LineOverflow is ', lineOverflow);
                END;
            {$ENDC}
            END
        ELSE
            ReadLine := FALSE;

        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TReadUnivText.}ReadRun;
    {----------------------------------------------------------------------------------------------------}
    VAR error:  INTEGER;
        size:   LONGINT;

    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        BindUTDSeg(error);

      { Size up the tab and data arrays to take the next run }
        SELF.data.DelAll;
        SELF.data.EditAt(1, SELF.maxDataSize);

      { Set the achad to receive the next run }
        WITH secrets.achad DO
            BEGIN
            rgch := POINTER(SELF.data.AddrMember(1));
            ichFst := 0;
            ichLim := SELF.maxDataSize;
            END;

        WITH secrets DO
            REPEAT
              { Get the next run }
                IF lpd.lplim = 0 THEN
                    SetLpd(@Lpd, streamArrayIndex, 0, lpd.Tyset, achad)
                ELSE
                    Seqlpd(@lpd, achad);
            UNTIL (NOT lpd.rce^.fvan) OR (achad.ichFst = achad.ichLim);

        {$IFC fUniversalTextTrace}
        IF fPrintSecrets THEN
            PrintSecrets(secrets.achad, secrets.lpd);
        {$ENDC}

      { Convert to Run }
        SELF.StreamToRun;
        WITH secrets.lpd DO
            BEGIN
            IF tyset.fRpe THEN
                size := lpLimPar - lp {LSR: changed lpFstPar to lp}
            ELSE
                size := lpLim - lp;

            IF size > (lpLim-lp) THEN
                size := lpLim - lp;

            lpLim := lp + size;
            END;
        IF size < SELF.data.size THEN
            SELF.data.DelManyAt(size + 1, SELF.data.size - size);

        UnBindUTDSeg(error);
        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTMain}
{$ELSEC}
{$S UTMain}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    FUNCTION  {TReadUnivText.}GetParaPicture(heap: THeap) : PicHandle;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        GetParaPicture := NIL;
        {$IFC fTrce}EP;{$ENDC}
    END;

{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
END;


{$IFC WithUObject}
METHODS OF TTKWriteUnivText
{$ELSEC}
METHODS OF TWriteUnivText
{$ENDC}

{$IFC WithUObject}
{$S TKUTWrite}
{$ELSEC}
{$S UTWrite}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
{$IFC WithUObject}
        FUNCTION  {TWriteUnivText.}CREATE(object: TObject;
                                          itsHeap: THeap;
                                          itsTString: TString;
                                          itsDataSize: INTEGER)
                                                               : TTKWriteUnivText;
{$ELSEC}
        FUNCTION  {TWriteUnivText.}CREATE(object: TUTObject;
                                          itsHeap: THeap;
                                          itsTString: TUTString;
                                          itsDataSize: INTEGER)
                                                               : TWriteUnivText;
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    VAR
        ptrToolKitUT:   TPtrToolKitUT;
        error:          INTEGER;
        index:          TB;

        {$IFC PasteTrace}
        dbgCh:          CHAR;
        {$ENDC}

    BEGIN
        {$IFC PasteTrace}
        WRITE('Do you want to debug (Y/N): ');
        READ(dbgCh);
        fPrintSecrets := dbgCh IN ['Y', 'y'];
        {$ENDC}

{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
        BindUTDseg(error);
        IF error <> 0 THEN
            ABCBreak('BindUTDseg Error',error);

        index := IcsCreate(tycsFld, SIZEOF(ToolKitUT), POINTER(ORD(itsHeap)));
        {$R-}
        ptrToolKitUT := POINTER( rghcs^[index]^ );
        {$R+}
        WITH secrets DO
            BEGIN
            streamArrayIndex := index;
            lpd.tyset.fRpe := TRUE;
            lpd.tyset.fRce := TRUE;
            END;

        WITH  ptrToolKitUT^ DO
            BEGIN
            cspd.argproc[IProcSeqLpd] := @SeqLpdUTBB;
            cspd.argproc[IProcFreeIcs] := Pointer(procnil);
            cspd.argproc[IProcPxHcs] := Pointer(procnil);
            cspd.argproc[IProcFindLpFixed] := @FindLpFstPar;
            cspd.argproc[IProcFSelLpBounds] := @TrueStdSelLpBounds;
            END;

        secrets.streamArrayIndex := index;

        nOfSavedPara := 0;                      {Nothing in the backLogBuffer}
        dataLp := 0;                            {Starting lpd}

        IF object = NIL THEN
{$IFC WithUObject}
            object := NewObject(itsHeap, THISCLASS);
{$ELSEC}
            object := NewUTObject(itsHeap, THISCLASS);
{$ENDC}

{$IFC WithUObject}
        SELF := TTKWriteUnivText(TTKUnivText.CREATE(object, itsHeap, itsTString, itsDataSize));
{$ELSEC}
        SELF := TWriteUnivText(TUnivText.CREATE(object, itsHeap, itsTString, itsDataSize));
{$ENDC}

    { Get a default UT character and paragraph descriptors }
        WITH secrets DO
            BEGIN
            lpd.rpe := @lpd.arpe;
      {$H-} moveRgch(@lpd.arpe, @arpeStd, arpeStd.cb); {$H+}

            Lpd.rce := @lpd.arce;
      {$H-} moveRgch(pointer(ord(lpd.rce)), @arceStd, arceStd.cb); {$H+}
            END;

        SELF.StreamToRun;

        activeStream := SELF;
        SELF.data.DelAll;

        StartGetScrap(error);
        IF error <> 0 THEN
            ABCBreak('StartGetScrap Error',error);

        PutCsScrap(index, error);
        IF error <> 0 THEN
            ABCBreak('PutCsScrap Error',error);

        freeics(index);

        EndGetScrap(error);
        IF error <> 0 THEN
            ABCBreak('EndGetScrap Error',error);

        UnbindUTDseg(error);
        IF error <> 0 THEN
            ABCBreak('UnbindUTDseg Error',error);
        {$IFC fTrce}EP;{$ENDC}
    END;


{$IFC WithUObject}
{$S TKUTWrite}
{$ELSEC}
{$S UTWrite}
{$ENDC}
    {----------------------------------------------------------------------------------------------------}
    PROCEDURE {TWriteUnivText.}FillParagraph;
    {----------------------------------------------------------------------------------------------------}
    BEGIN
{$IFC fTraceUT}    LogCall;     {$ENDC}
        {$IFC fTrce}BP(11);{$ENDC}
{$IFC WithUObject}
        ABCBreak('Failed to reimplement TTKWriteUnivText.FillParagraph',0);
{$ELSEC}
        ABCBreak('Failed to reimplement TWriteUnivText.FillParagraph',0);
{$ENDC}
        {$IFC fTrce}EP;{$ENDC}
    END;

{$IFC WithUObject}
{$S TKUTInit}
{$ELSEC}
{$S UTInit}
{$ENDC}
END;