[Indigo]<Cedar>TBase>TextLooksImpl.mesa!4

-- TextLooksImpl.mesa

-- written by Bill Paxton, February 1981

-- last edit by Bill Paxton, December 13, 1982 1:17 pm

Last Edited by: Maxwell, January 5, 1983 3:54 pm

DIRECTORY

SafeStorage,

Inline,

Rope,

RunReader,

TextLooks,

TextLooksSupport,

TextNode;

TextLooksImpl: CEDAR PROGRAM

IMPORTS TextLooks, TextLooksSupport, Rope, RunReader, SafeStorage, Inline

EXPORTS TextLooks, TextLooksSupport

SHARES TextLooks =

BEGIN OPEN TextLooks, TextLooksSupport;

qZone: PUBLIC ZONE ← SafeStorage.NewZone[quantized];

-- quantized zone for allocating run pieces

pZone: PUBLIC ZONE ← SafeStorage.NewZone[prefixed];

-- prefixed zone for allocating run arrays

OutOfBounds: PUBLIC ERROR = CODE;

-- Rope conversion

LooksToRope: PUBLIC PROC [looks: Looks] RETURNS [rope: Rope.ROPE] = {

FOR lk: TextLooks.Look IN TextLooks.Look DO

IF looks[lk] THEN rope ← Rope.Cat[rope,Rope.FromChar[lk]];

ENDLOOP };

RopeToLooks: PUBLIC PROC [rope: Rope.ROPE] RETURNS [looks: Looks] = {

looks ← noLooks;

FOR i: INT IN [0..Rope.Size[rope]) DO

char: CHAR ← Rope.Fetch[rope,i];

IF char IN Look THEN looks[char] ← TRUE;

ENDLOOP };

-- Edit operations

Substr: PUBLIC PROC [base: Runs, start: Offset, len: Offset]

RETURNS [new: Runs] = TRUSTED {

DO IF base=NIL OR len=0 THEN RETURN[NIL];

WITH x:base SELECT FROM

base => {

rem: Offset;

IF (rem ← TbaseSize[@x]-start) <= len THEN

IF start = 0 THEN RETURN [base] ELSE len ← rem};

node => WITH x:x SELECT FROM

substr => {

rem: Offset;

IF (rem ← CheckLongSub[x.size, start]) <= len THEN

IF start = 0 THEN RETURN [base] ELSE len ← rem;

start ← start + x.start; base ← x.base; LOOP};

concat => {

xpos, rem: Offset;

IF (rem ← CheckLongSub[x.size, start]) <= len THEN

IF start = 0 THEN RETURN [base] ELSE len ← rem;

IF start >= (xpos ← x.pos) THEN {

start ← start - xpos; base ← x.rest; LOOP};

IF xpos >= start+len THEN {base ← x.base; LOOP}};

replace => {

xstart, xnew, rem: Offset;

IF (rem ← CheckLongSub[x.size, start]) <= len THEN

IF start = 0 THEN RETURN [base] ELSE len ← rem;

IF start >= (xnew ← x.newPos) THEN {

start ← start - xnew + x.oldPos; base ← x.base; LOOP};

IF (rem ← start+len) <= (xstart ← x.start) THEN {

base ← x.base; LOOP};

IF start >= xstart AND rem <= xnew THEN {

start ← start - xstart; base ← x.replace; LOOP}};

change => {

xstart: Offset ← x.start;

xend: Offset ← xstart+x.len;

IF start >= xend OR start+len <= xstart THEN {

base ← x.base; LOOP}};

ENDCASE => ERROR;

IF (new ← TryFlatSubstr[base,start,len]) # NIL THEN RETURN;

EXIT;

ENDLOOP;

IF base=NIL THEN ERROR;

RETURN [qZone.NEW[Tsubstr ← [node[substr[len,base,start]]]]]};

TryFlatSubstr: PUBLIC PROC

[base: Runs, start, len: Offset, limit: Offset ← FlatMax]

RETURNS [BaseRuns] = { -- return NIL if couldn't flatten

count: Offset;

numruns: NAT;

flat: BaseRuns;

[count,,] ← CountRuns[base, start, len, limit];

IF count > limit THEN RETURN [NIL];

flat ← NewBase[numruns←Short[count]];

IF ExtractRuns[flat, base, start, len] # numruns THEN ERROR;

IF flat[numruns-1].after # len THEN ERROR;

RETURN [flat] };

Flatten: PUBLIC PROC [base: Runs] RETURNS [new: Runs] = TRUSTED {

size, half: Offset;

IF base=NIL THEN RETURN [NIL];

WITH x:base SELECT FROM

base => RETURN [@x]; -- already flat

ENDCASE;

new ← TryFlatSubstr[base,0,Size[base],8000];

IF new#NIL THEN RETURN; -- else was too big to flatten in one piece

half ← (size ← Size[base])/2; -- flatten the halves

RETURN [Concat[

Flatten[Substr[base,0,half]],

Flatten[Substr[base,half,size]],

half,

size-half]] };

Concat: PUBLIC PROC

[base, rest: Runs, baseLen, restLen: Offset] RETURNS [new: Runs] = TRUSTED {

c, numRuns, size, flatLen: Offset;

split: NAT;

merge: BOOLEAN;

looks: Looks;

IF base=NIL AND rest=NIL THEN RETURN[NIL];

IF restLen=0 THEN RETURN [base];

IF baseLen=0 THEN RETURN [rest];

size ← baseLen+restLen;

[numRuns, merge, looks] ← CountRuns[base, 0, baseLen, FlatMax];

IF numRuns <= FlatMax THEN { -- try flattening base

IF (new ← TryFlatConcatRest[base,rest,baseLen,restLen,

numRuns,merge,looks]) # NIL THEN RETURN;

-- otherwise try to break up rest

IF rest # NIL THEN WITH x:rest SELECT FROM node => WITH x:x SELECT FROM

concat => { -- try to combine base & rest.base

[c,,] ← CountRuns[x.base,0,x.pos,FlatMax-numRuns,merge,looks];

IF (numRuns ← numRuns+c) <= FlatMax THEN { -- flatten

numruns: NAT;

flat: BaseRuns ← NewBase[numruns←Short[numRuns]];

split ← ExtractRuns[flat,base,0,baseLen];

IF ExtractRuns[flat,x.base,0,x.pos,split] # numruns

THEN ERROR;

flatLen ← baseLen+x.pos;

IF flat[numruns-1].after # flatLen THEN ERROR;

RETURN[qZone.NEW[Tconcat ← [node[concat

[size,flat,x.rest,flatLen]]]]]}};

ENDCASE; ENDCASE };

IF base # NIL THEN WITH x:base SELECT FROM node => WITH x:x SELECT FROM

concat => { -- try to combine base.rest & rest

baseRestLen: Offset ← baseLen-x.pos;

[numRuns, merge, looks] ← CountRuns[x.rest,0,baseRestLen,FlatMax];

IF numRuns <= FlatMax THEN {

[c,,] ← CountRuns[rest,0,restLen,FlatMax-numRuns,merge,looks];

IF (numRuns ← numRuns+c) <= FlatMax THEN { -- flatten

numruns: NAT;

flat: BaseRuns ← NewBase[numruns←Short[numRuns]];

split ← ExtractRuns[flat,x.rest,0,baseRestLen];

IF ExtractRuns[flat,rest,0,restLen,split] # numruns

THEN ERROR;

IF flat[numruns-1].after # baseRestLen+restLen THEN ERROR;

RETURN[qZone.NEW[Tconcat ← [node[concat

[size,x.base,flat,x.pos]]]]]}}};

substr => -- see if doing concat of adjacent substr's

IF rest # NIL THEN WITH y:rest SELECT FROM node => WITH y:y SELECT FROM

substr => -- see if adjacent to x

IF x.base = y.base AND x.start+x.size = y.start THEN -- join them

RETURN[qZone.NEW[Tsubstr ←

[node[substr[size,x.base,x.start]]]]];

ENDCASE; ENDCASE;

IF base=NIL THEN base ← MakeRun[baseLen];

IF rest=NIL THEN rest ← MakeRun[restLen];

RETURN[qZone.NEW[Tconcat ← [node[concat[size,base,rest,baseLen]]]]]};

TryFlatConcat: PUBLIC PROC

[base, rest: Runs, baseLen, restLen: Offset]

RETURNS [new: BaseRuns] = { -- returns NIL if too big to flatten

numRuns: Offset;

merge: BOOLEAN;

looks: Looks;

[numRuns, merge, looks] ← CountRuns[base, 0, baseLen, FlatMax];

IF numRuns > FlatMax THEN RETURN [NIL];

RETURN [TryFlatConcatRest[base,rest,baseLen,restLen,numRuns,merge,looks]]};

TryFlatConcatRest: PUBLIC PROC

[base, rest: Runs, baseLen, restLen, numRuns: Offset,

merge: BOOLEAN, looks: Looks]

RETURNS [BaseRuns] = { -- returns NIL if too big to flatten

c: Offset;

split, numruns: NAT;

flat: BaseRuns;

[c,,] ← CountRuns[rest,0,restLen,FlatMax-numRuns,merge,looks];

IF (numRuns ← numRuns+c) > FlatMax THEN RETURN [NIL];

flat ← NewBase[numruns←Short[numRuns]];

split ← ExtractRuns[flat,base,0,baseLen];

IF ExtractRuns[flat,rest,0,restLen,split] # numruns THEN

ERROR;

IF flat[numruns-1].after # baseLen+restLen THEN ERROR;

RETURN [flat]};

Replace: PUBLIC PROC [

base: Runs, start, len: Offset, replace: Runs,

baseSize, repSize: Offset, tryFlat: BOOLEAN ← TRUE]

RETURNS [new: Runs] = TRUSTED {

oldPos, newPos, size: Offset;

IF base=NIL AND replace=NIL THEN RETURN [NIL];

oldPos ← start+len;

newPos ← start+repSize;

size ← baseSize-len+repSize;

IF repSize=0 THEN -- deleting

IF base=NIL OR (start=0 AND len=baseSize) THEN RETURN[NIL]

ELSE IF len=0 THEN RETURN[base];

IF tryFlat THEN {

merge: BOOLEAN ← FALSE;

flat: BaseRuns;

looks: Looks;

c, numRuns: Offset;

split, numruns: NAT;

Count: PROC [r: Runs, start,len: Offset] RETURNS [Offset] = TRUSTED {

IF len=0 THEN RETURN[numRuns];

[c,merge,looks] ← CountRuns[r,start,len,FlatMax-numRuns,merge,looks];

RETURN [numRuns←numRuns+c]};

Extract: PROC [r: Runs, start, len: Offset] = TRUSTED {

IF len > 0 THEN split ← ExtractRuns[flat,r,start,len,split] };

numRuns ← 0;

IF Count[base,0,start] <= FlatMax AND

Count[replace,0,repSize] <= FlatMax AND

Count[base,oldPos,baseSize-oldPos] <= FlatMax THEN {

flat ← NewBase[numruns←Short[numRuns]]; split ← 0;

Extract[base,0,start]; Extract[replace,0,repSize];

Extract[base,oldPos,baseSize-oldPos];

IF split # numruns THEN ERROR;

IF flat[numruns-1].after # size THEN ERROR;

RETURN [flat] }};

WHILE base # NIL DO WITH x:base SELECT FROM node => WITH x:x SELECT FROM

replace => {

xnewPos: Offset ← x.newPos;

xstart: Offset ← x.start;

xsize: Offset;

IF start <= xstart AND oldPos >= xnewPos THEN {

-- replacing the replacement

oldPos ← x.oldPos+(oldPos-xnewPos); len ← oldPos-start;

base ← x.base; LOOP}

ELSE IF repSize = 0 AND start > xstart AND

oldPos = xnewPos AND -- deleting end of prior replacement

(new ← TryFlatSubstr[x.replace,0,start-xstart])#NIL THEN {

newPos ← start; oldPos ← x.oldPos; start ← xstart;

replace ← new; base ← x.base}

ELSE IF repSize = 0 AND start = xstart AND

oldPos < xnewPos AND -- deleting start of prior replacement

(new ← TryFlatSubstr[x.replace,len,xnewPos-oldPos])#NIL THEN {

newPos ← start+xnewPos-oldPos; oldPos ← x.oldPos;

replace ← new; base ← x.base}

ELSE IF start = xnewPos AND -- replacing just after prior replacement

(new ← TryFlatConcat[x.replace,replace,xsize←xnewPos-xstart,repSize])#NIL

THEN {

start ← xstart;

len ← len+x.oldPos-xstart; oldPos ← start+len;

repSize ← xsize+repSize; newPos ← start+repSize;

replace ← new; base ← x.base; LOOP}

ELSE IF start+len = xstart AND -- replacing just before prior replacement

(new ← TryFlatConcat[replace,x.replace,repSize,xsize←xnewPos-xstart])#NIL

THEN {

len ← len+x.oldPos-xstart; oldPos ← start+len;

repSize ← xsize+repSize; newPos ← start+repSize;

replace ← new; base ← x.base; LOOP}};

concat => {

xpos: Offset ← x.pos;

IF start=xpos AND len=0 THEN { -- insert between base&rest

-- first try concat of x.base&replacement

IF (new ← TryFlatConcat[x.base,replace,xpos,repSize])#NIL

THEN RETURN [qZone.NEW[Tconcat ←

[node[concat[size, new, x.rest, xpos+repSize]]]]];

-- otherwise try concat of replacement&x.rest

IF (new ← TryFlatConcat[replace,x.rest,repSize,x.size-xpos])#NIL

THEN RETURN [qZone.NEW[Tconcat ←

[node[concat[size, x.base, new, x.pos]]]]]}};

ENDCASE; ENDCASE;

EXIT;

ENDLOOP;

IF base=NIL THEN base ← MakeRun[baseSize];

IF replace=NIL THEN replace ← MakeRun[repSize];

RETURN [qZone.NEW[Treplace ← [node[replace[size,base,replace,start,oldPos,newPos]]]]]};

Copy: PUBLIC PROC [

dest: Runs, destLoc: Offset, source: Runs,

start, len, destSize: Offset]

RETURNS [Runs] = {

merge: BOOLEAN ← FALSE;

flat: BaseRuns;

looks: Looks;

c, numRuns: Offset;

split, numruns: NAT;

Count: PROC [base: Runs, start,len: Offset] RETURNS [Offset] = {

IF len=0 THEN RETURN[numRuns];

[c,merge,looks] ← CountRuns[base,start,len,FlatMax-numRuns,merge,looks];

RETURN [numRuns←numRuns+c]};

Extract: PROC [base: Runs, start, len: Offset] = {

IF len > 0 THEN split ← ExtractRuns[flat,base,start,len,split] };

IF dest=NIL AND source=NIL THEN RETURN[NIL];

numRuns ← 0;

IF Count[dest,0,destLoc] > FlatMax OR

Count[source,start,len] > FlatMax OR

Count[dest,destLoc,destSize-destLoc] > FlatMax THEN RETURN [

Replace[dest,destLoc,0,Substr[source,start,len],destSize,len,FALSE]];

IF numRuns=0 THEN RETURN [NIL];

flat ← NewBase[numruns←Short[numRuns]]; split ← 0;

Extract[dest,0,destLoc]; Extract[source,start,len];

Extract[dest,destLoc,destSize-destLoc];

IF split # numruns THEN ERROR;

IF flat[numruns-1].after # destSize+len THEN ERROR;

RETURN [flat] };

-- **** General operations ****

CreateRun: PUBLIC PROC [len: Offset, looks: Looks ← noLooks]

RETURNS [new: Runs] = {

base: BaseRuns;

IF looks=noLooks OR len=0 THEN RETURN [NIL];

base ← NewBase[1];

base[0] ← [len,looks];

RETURN [base]};

MakeRun: PUBLIC PROC [len: Offset] RETURNS [new: Runs] = {

base: BaseRuns;

IF len=0 THEN RETURN [NIL];

base ← NewBase[1];

base[0] ← [len,noLooks];

RETURN [base]};

FetchLooks: PUBLIC PROC

[runs: Runs, index: Offset] RETURNS [Looks] = TRUSTED {

-- returns the looks for the character at the given location

remove, add: Looks ← noLooks;

changeLooks: BOOLEAN ← FALSE;

DO IF runs=NIL THEN RETURN [noLooks];

WITH x:runs SELECT FROM

base => {

looks: Looks ← x[BaseRun[@x,index]].looks;

IF changeLooks THEN looks ← ModifyLooks[looks, remove, add];

RETURN [looks]};

node => WITH x:x SELECT FROM

substr =>

IF index < x.size THEN {

index ← index + x.start; runs ← x.base; LOOP};

concat =>

IF index < x.size THEN

IF index < x.pos

THEN {runs ← x.base; LOOP}

ELSE {index ← index - x.pos; runs ← x.rest; LOOP};

replace =>

IF index < x.size THEN {

IF index < x.start THEN {runs ← x.base; LOOP};

IF index < x.newPos THEN {

index ← index - x.start; runs ← x.replace; LOOP};

index ← index - x.newPos + x.oldPos; runs ← x.base; LOOP};

change => {

IF index IN [x.start..x.start+x.len) THEN {

[remove, add] ← MergeChanges[x.remove, x.add, remove, add];

IF remove=allLooks THEN RETURN [add];

changeLooks ← TRUE};

runs ← x.base; LOOP};

ENDCASE => ERROR;

ERROR OutOfBounds;

ENDLOOP};

-- **** Operation to change looks ****

ChangeLooks: PUBLIC PROC [

runs: Runs, size: Offset, remove, add: Looks,

start: Offset ← 0, len: Offset ← MaxOffset]

RETURNS [new: Runs] = TRUSTED {

c, numRuns, end: Offset;

merge: BOOLEAN;

looks: Looks;

IF runs=NIL AND add=noLooks THEN RETURN [NIL];

IF start >= size OR len=0 THEN RETURN [runs];

end ← start + (len ← MIN[len, size-start]);

IF runs # NIL THEN { -- see if not really changing anything

OPEN Inline;

Pair: TYPE = RECORD [low, high: CARDINAL];

changed: BOOLEAN ← FALSE;

loc, runLen: Offset ← start;

addLow, addHigh, remLow, remHigh: CARDINAL;

noLooksLow: CARDINAL = 0;

noLooksHigh: CARDINAL = 0;

runrdr: RunReader.Ref ← RunReader.GetRunReader[];

RunReader.SetPosition[runrdr,runs,start];

addLow ← LOOPHOLE[add,Pair].low;

addHigh ← LOOPHOLE[add,Pair].high;

remLow ← LOOPHOLE[remove,Pair].low;

remHigh ← LOOPHOLE[remove,Pair].high;

UNTIL loc >= end DO -- check the runs in the section to be changed

lks: Looks;

lksLow, lksHigh: CARDINAL;

[runLen,lks] ← RunReader.Get[runrdr];

lksLow ← LOOPHOLE[lks,Pair].low;

lksHigh ← LOOPHOLE[lks,Pair].high;

IF LOOPHOLE[BITAND[lksLow,addLow],CARDINAL] # addLow OR

LOOPHOLE[BITAND[lksHigh,addHigh],CARDINAL] # addHigh OR

LOOPHOLE[BITAND[lksLow,remLow],CARDINAL] # noLooksLow OR

LOOPHOLE[BITAND[lksHigh,remHigh],CARDINAL] # noLooksHigh

THEN { changed ← TRUE; EXIT };

loc ← loc+runLen;

ENDLOOP;

RunReader.FreeRunReader[runrdr];

IF ~changed THEN RETURN [runs] };

[numRuns, merge, looks] ← CountRuns[runs, 0, start, FlatMax];

IF numRuns <= FlatMax THEN {

[c, merge, looks] ← CountRunsAfterChanges[

runs, start, len, FlatMax-numRuns, remove, add, merge, looks];

IF (numRuns ← numRuns+c) <= FlatMax THEN {

[c,,] ← CountRuns[runs,end,size-end,FlatMax-numRuns,merge,looks];

IF (numRuns ← numRuns+c) <= FlatMax THEN {

split, numruns: NAT;

flat: BaseRuns ← NewBase[numruns←Short[numRuns]];

split ← ExtractRuns[flat,runs,0,start];

split ← ExtractRunsAfterChanges[flat,runs,remove,add,start,len,split];

IF ExtractRuns[flat,runs,end,size-end,split] # numruns THEN ERROR;

IF flat[numruns-1].after # size THEN ERROR;

RETURN [flat] }}};

IF runs # NIL THEN WITH x:runs SELECT FROM node => WITH x:x SELECT FROM

change => IF x.start=start AND x.len=len THEN {

[remove,add] ← MergeChanges[x.remove, x.add, remove, add];

runs ← x.base };

ENDCASE; ENDCASE;

IF runs = NIL THEN runs ← MakeRun[size];

RETURN[qZone.NEW[Tchange ← [node[change[size,runs,remove,add,start,len]]]]]};

-- ***** Initialization

Start: PUBLIC PROC = {

};

END.