DIRECTORY
Imager, ImagerFont, ImagerSample,
IO,
Pipal, PipalInt, PipalMutate, PipalPaint, PipalReal, PipalTextMutant,
Real, Rope, SF, VFonts;
PipalTextMutantImpl:
CEDAR
PROGRAM
IMPORTS Imager, ImagerFont, ImagerSample, IO, Pipal, PipalInt, PipalMutate, PipalPaint, PipalReal, Real, Rope, VFonts
EXPORTS PipalTextMutant =
BEGIN OPEN PipalTextMutant;
Text Class
pipalTextClass:
PUBLIC Pipal.Class ← Pipal.RegisterClass[name: "PipalText", type:
CODE[PipalTextRec]];
TextDescribe: Pipal.DescribeProc = {
text: PipalText ← NARROW [object];
Pipal.PutIndent[out, indent, cr];
IO.PutF[out, "Text [%g]", IO.rope[text.rope]];
};
TextSize: PipalReal.SizeProc ~ {
size ← NARROW [object, PipalText].size;
};
fixedFont: Imager.Font ← VFonts.defaultFont;
feedbackHeight: REAL ← 4.0;
fontHeight: REAL ← ImagerFont.FontBoundingBox[fixedFont].descent + ImagerFont.FontBoundingBox[fixedFont].ascent;
lineHeight:
REAL ← fontHeight + feedbackHeight;
TextPaint: PipalPaint.PaintProc ~ {
clip: PipalReal.Rectangle ← PipalPaint.GetBounds[context];
EachRow: RowProc = {
IF NOT PipalReal.DoRectanglesIntersect[clip, [[0.0, y], [text.size.x, lineHeight]]] THEN RETURN;
Imager.SetXY[context, [0.0, y]];
Imager.ShowRope[context, text.rope, interval.base, interval.size];
};
text: PipalText ← NARROW[object];
PipalPaint.SetColor[context, Imager.black];
Imager.SetFont[context, fixedFont];
[] ← EnumerateRows[text, EachRow];
};
emptySize: PipalReal.Size ← PipalReal.emptySize;
CreatePipalText:
PUBLIC
PROC [rope: Pipal.
ROPE, size: PipalReal.Size ← PipalReal.emptySize]
RETURNS [text: PipalText] = {
text ← NEW [PipalTextRec ← [rope, size]];
IF size=PipalReal.emptySize
THEN {
extents: ImagerFont.Extents ← ImagerFont.RopeBoundingBox[font: fixedFont, rope: rope];
text.size ← [extents.leftExtent+extents.rightExtent, lineHeight];
};
};
GetIntervalArea:
PUBLIC
PROC [text: PipalText, interval: PipalInt.Interval]
RETURNS [rectangle: PipalReal.Rectangle] = {
interest: PipalInt.Interval ← interval;
EachRow: RowProc = {
IF NOT PipalInt.DoIntervalsIntersect[interest, interval] THEN RETURN;
rectangle ← PipalReal.BoundingBox[rectangle, [[0.0, y], [text.size.x, lineHeight]]];
};
rectangle ← PipalReal.emptyRectangle;
[] ← EnumerateRows[text, EachRow];
};
GetSelectionInterval:
PUBLIC
PROC [text: PipalText, position: PipalReal.Position, grain: SelectionGrain]
RETURNS [interval: PipalInt.Interval ← [0, 0], closerRight:
BOOL ←
FALSE] = {
ropeSize: INT ← Rope.Size[text.rope];
IF ropeSize>0
THEN {
leftEdge, rightEdge: REAL ← 0.0;
location: Location;
bbox: PipalReal.Rectangle;
[location, bbox] ← CharLocation[text, position];
leftEdge ← bbox.base.x;
rightEdge ← bbox.base.x+bbox.size.x;
SELECT grain
FROM
point => {
interval.base ← location;
interval.size ← 0;
};
char => {
interval.base ← location;
interval.size ← 1;
};
word => {
start: Location ← location;
char: CHAR ← Rope.Fetch[text.rope, location];
IF CharSeparator[char] THEN interval.base ← location
ELSE {
UNTIL location=0
OR CharSeparator[(char ← Rope.Fetch[text.rope, location-1])]
DO
location ← location-1;
leftEdge ← leftEdge-CharSize[char].x;
ENDLOOP;
interval.base ← location;
location ← start;
UNTIL location=ropeSize-1
OR CharSeparator[(char ← Rope.Fetch[text.rope, location+1])]
DO
location ← location+1;
rightEdge ← rightEdge+CharSize[char].x;
ENDLOOP;
};
interval.size ← location-interval.base+1;
};
ENDCASE => ERROR;
closerRight ← ABS[rightEdge-position.x]<ABS[position.x-leftEdge];
};
};
CharLocation:
PROC [text: PipalText, position: PipalReal.Position]
RETURNS [location: Location, bbox: PipalReal.Rectangle] = {
EachChar: CharProc = {
distance: REAL ← RectanglePointDistance[bbox, position];
IF (quit ← PipalReal.IsInsidePoint[bbox, position])
OR distance<closest
THEN {
loc ← location;
bb ← bbox;
closest ← distance;
};
};
loc: Location ← 0;
bb: PipalReal.Rectangle ← PipalReal.emptyRectangle;
closest: REAL ← PipalReal.infinity;
[] ← EnumerateChars[text, EachChar];
location ← loc;
bbox ← bb;
};
CharProc: TYPE = PROC [char: CHAR, location: Location, bbox: PipalReal.Rectangle] RETURNS [quit: BOOL ← FALSE];
EnumerateChars:
PROC [text: PipalText, eachChar: CharProc]
RETURNS [quit:
BOOL ←
FALSE] = {
EachRow: RowProc = {
quit ← EnumerateCharsInRow[text, interval, y, eachChar];
};
quit ← EnumerateRows[text, EachRow];
};
EnumerateCharsInRow:
PROC [text: PipalText, interval: PipalInt.Interval, y:
REAL, eachChar: CharProc]
RETURNS [quit:
BOOL ←
FALSE] = {
x: REAL ← 0.0;
FOR loc: Location
IN [interval.base..interval.base+interval.size)
DO
char: CHAR ← Rope.Fetch[text.rope, loc];
cx: REAL ← CharSize[char].x;
IF eachChar[char, loc, [[x, y-feedbackHeight], [cx, lineHeight]]] THEN {quit ← TRUE; EXIT};
x ← x + cx;
ENDLOOP;
};
CharSize:
PROC [char:
CHAR]
RETURNS [size: PipalReal.Size] = {
size ← [ImagerFont.Escapement[fixedFont, [0, LOOPHOLE[char]]].x, lineHeight]
};
RowProc: TYPE = PROC [interval: PipalInt.Interval, y: REAL] RETURNS [quit: BOOL ← FALSE];
EnumerateRows:
PROC [text: PipalText, eachRow: RowProc]
RETURNS [quit:
BOOL ←
FALSE] = {
start: Location ← 0;
y: REAL ← text.size.y-lineHeight+feedbackHeight;
length: INT ← Rope.Length[text.rope];
IF length>0
THEN
DO
rightEdge: REAL ← 0.0;
firstUnpaintedChar: Location ← start;
lastSeparator: Location ← start;
DO
char: CHAR ← Rope.Fetch[text.rope, firstUnpaintedChar];
rightEdge ← rightEdge + CharSize[char].x;
IF rightEdge>=text.size.x THEN EXIT;
IF CharSeparator[char] THEN lastSeparator ← firstUnpaintedChar;
firstUnpaintedChar ← firstUnpaintedChar + 1;
IF firstUnpaintedChar=length THEN EXIT;
ENDLOOP;
IF firstUnpaintedChar=length THEN lastSeparator ← length-1;
IF eachRow[[start, lastSeparator-start+1], y] THEN {quit ← TRUE; EXIT};
IF lastSeparator+1=length THEN EXIT;
start ← lastSeparator+1;
y ← y-lineHeight;
ENDLOOP;
};
CharSeparator:
PROC [char:
CHAR]
RETURNS [separator:
BOOL] = {
separator ← NOT (char IN ['a..'z] OR char IN ['A..'Z] OR char IN ['0..'9]);
};
Text Mutant Class
textMutantClass:
PUBLIC Pipal.Class ← Pipal.RegisterClass[name: "TextMutant", type:
CODE [TextMutantRec]];
TextMutantDescribe: Pipal.DescribeProc = {
textMutant: TextMutant ← NARROW[object];
Pipal.PutIndent[out, indent, cr];
IO.PutF[out, "Text Mutant"];
};
TextMutantSize: PipalReal.SizeProc ~ {
size ← PipalReal.ObjectSize[NARROW [object, TextMutant].text];
};
caretH: INTEGER = 6;
CaretBits: TYPE ~ REF CaretBitsRep;
CaretBitsRep:
TYPE =
ARRAY [0..caretH)
OF
WORD;
caretBits: CaretBits ←
NEW[CaretBitsRep ← [
000400B, -- 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0
001600B, -- 0 0 0 0 0 0 1 1 1 0 0 0 0 0 0 0
003700B, -- 0 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0
003300B, -- 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0
006140B, -- 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0
004040B -- 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0
]];
caretMap: ImagerSample.SampleMap ← SampleMapFromCaretBits[caretBits];
SampleMapFromCaretBits:
PROC [bits: CaretBits]
RETURNS [ImagerSample.SampleMap] ~
TRUSTED {
RETURN [ImagerSample.UnsafeNewSampleMap[
box: [min: [s: 0, f: 0], max: [s: caretH, f: caretW]],
bitsPerSample: 1, bitsPerLine: BITS[WORD], base: [word: LOOPHOLE[bits], bit: 0],
ref: bits, words: SIZE[CaretBitsRep]
]];
};
TextMutantPaint: PipalPaint.PaintProc = {
EachRow: RowProc = {
y ← y-feedbackHeight;
FOR selection: Selections
IN Selections
DO
IF tm.selections[selection].valid
AND PipalInt.DoIntervalsIntersect[interval, tm.selections[selection].interval]
THEN {
sel: Selection ← tm.selections[selection];
selectInterval: PipalInt.Interval ← PipalInt.IntersectionIntervals[interval, sel.interval];
start: REAL ← ImagerFont.RopeEscapement[fixedFont, text.rope, interval.base, selectInterval.base-interval.base].x;
SELECT
TRUE
FROM
selection=primary => Imager.SetColor[context, PipalPaint.invertingBlack];
sel.pendingDelete => Imager.SetColor[context, PipalPaint.invertingLightGray];
ENDCASE => Imager.SetColor[context, PipalPaint.invertingDarkGray];
IF selectInterval.size>0
THEN {
length: REAL ← ImagerFont.RopeEscapement[fixedFont, text.rope, selectInterval.base, selectInterval.size].x;
IF sel.pendingDelete THEN Imager.MaskRectangle[context, [start, y, length, fontHeight]]
ELSE Imager.MaskRectangle[context, [start, y, length, feedbackHeight]];
IF (sel.caretAfter AND PipalInt.IsInsideIntervalNumber[selectInterval, sel.interval.base+sel.interval.size]) OR (NOT sel.caretAfter AND PipalInt.IsInsideIntervalNumber[selectInterval, sel.interval.base]) THEN Imager.MaskBitmap[context, caretMap, [0, 7], Imager.defaultScanMode, [IF sel.caretAfter THEN start+length ELSE start, y+feedbackHeight]];
}
ELSE Imager.MaskBitmap[context, caretMap, [0, 7], Imager.defaultScanMode, [start, y+feedbackHeight]];
};
ENDLOOP;
};
tm: TextMutant ← NARROW [object];
text: PipalText ← tm.text;
PipalPaint.Paint[text, context];
Imager.SetStrokeWidth[context, feedbackHeight];
[] ← EnumerateRows[text, EachRow];
};
Manipulation
InsertRope:
PUBLIC
PROC [tm: TextMutant, characters: Pipal.
ROPE]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
[changed, newtm] ← BasicInsert[tm, characters];
message ← "insert rope";
};
InsertChar:
PUBLIC
PROC [tm: TextMutant, character:
CHAR]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
[changed, newtm] ← BasicInsert[tm, Rope.FromChar[character]];
message ← "insert char";
};
Copy:
PUBLIC
PROC [tm: TextMutant]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
IF tm.selections[secondary].valid
THEN {
otherChange: PipalInt.Interval;
[changed, newtm] ← BasicInsert[tm, Rope.Substr[tm.text.rope, tm.selections[secondary].interval.base, tm.selections[secondary].interval.size]];
IF newtm.selections[secondary].pendingDelete
THEN {
[otherChange, newtm] ← BasicDelete[newtm, newtm.selections[secondary].interval];
changed ← PipalInt.UnionIntervals[changed, otherChange];
};
}
ELSE ERROR Pipal.Error[$noSecondarySelection];
message ← "copy";
};
Transpose:
PUBLIC
PROC [tm: TextMutant]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
SEEMS BUGGY (BS March 1, 1988 12:09:39 pm PST)
text: PipalText ← tm.text;
newtm ← NEW [TextMutantRec ← tm^];
IF NOT tm.selections[primary].valid THEN ERROR Pipal.Error[$noPrimarySelection];
IF NOT tm.selections[secondary].valid THEN ERROR Pipal.Error[$noSecondarySelection];
{
i1: PipalInt.Interval;
i2: PipalInt.Interval;
switched: BOOL;
[i1, i2, switched] ← DecomposeIntervals[tm.selections[primary].interval, tm.selections[secondary].interval];
newtm.text ← CreatePipalText[Rope.Cat[
Rope.Substr[text.rope, 0, i1.base],
Rope.Substr[text.rope, i2.base, i2.size],
Rope.Substr[text.rope, i1.base+i1.size, i2.base-(i1.base+i1.size)],
Rope.Substr[text.rope, i1.base, i1.size],
Rope.Substr[text.rope, i2.base+i2.size, Rope.Length[text.rope]-i2.base+i2.size]], text.size];
changed ← [i1.base, PipalInt.infinity];
{
difference: INT ← tm.selections[primary].interval.size - tm.selections[secondary].interval.size;
t: Location ← tm.selections[primary].interval.base;
newtm.selections[primary].interval.base ← newtm.selections[secondary].interval.base;
newtm.selections[secondary].interval.base ← t;
IF switched THEN newtm.selections[secondary].interval.base ← newtm.selections[secondary].interval.base + difference
ELSE newtm.selections[primary].interval.base ← newtm.selections[primary].interval.base - difference;
};
};
message ← "transpose";
};
Delete:
PUBLIC
PROC [tm: TextMutant]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
newtm ← NEW [TextMutantRec ← tm^];
IF NOT tm.selections[primary].valid THEN ERROR Pipal.Error[$noPrimarySelection];
newtm.paste ← Rope.Substr[tm.text.rope, tm.selections[primary].interval.base, tm.selections[primary].interval.size];
[changed, newtm] ← BasicDelete[newtm, tm.selections[primary].interval];
message ← "delete";
};
Paste:
PUBLIC
PROC [tm: TextMutant]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
[changed, newtm] ← BasicInsert[tm, tm.paste];
message ← "paste";
};
Erase:
PUBLIC
PROC [tm: TextMutant]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
sel: Selection ← tm.selections[primary];
loc: Location;
IF NOT sel.valid THEN ERROR Pipal.Error[$noPrimarySelection];
loc ← IF sel.caretAfter THEN sel.interval.base+sel.interval.size ELSE sel.interval.base;
IF loc=0 THEN ERROR Pipal.Error[$noCharacterToErase];
[changed, newtm] ← BasicDelete[tm, [loc-1, 1]];
message ← "erase";
};
BasicInsert:
PROC [oldtm: TextMutant, characters: Pipal.
ROPE]
RETURNS [changed: PipalInt.Interval, newtm: TextMutant] = {
size: Location ← Rope.Size[characters];
loc: Location;
changed ← [PipalInt.infinity/2, 0];
IF NOT oldtm.selections[primary].valid THEN ERROR Pipal.Error[$noPrimarySelection];
IF oldtm.selections[primary].pendingDelete
THEN {
paste: Rope.ROPE ← Rope.Substr[oldtm.text.rope, oldtm.selections[primary].interval.base, oldtm.selections[primary].interval.size];
[changed, newtm] ← BasicDelete[oldtm, oldtm.selections[primary].interval];
newtm.paste ← paste;
}
ELSE newtm ← NEW [TextMutantRec ← oldtm^];
loc ← IF newtm.selections[primary].caretAfter THEN newtm.selections[primary].interval.base + newtm.selections[primary].interval.size ELSE newtm.selections[primary].interval.base;
newtm.text ← CreatePipalText[Rope.Cat[
Rope.Substr[newtm.text.rope, 0, loc],
characters,
Rope.Substr[newtm.text.rope, loc, Rope.Size[newtm.text.rope]-loc]], newtm.text.size];
changed ← PipalInt.UnionIntervals[changed, [loc, size+Rope.Size[newtm.text.rope]-loc]];
FOR selection: Selections
IN Selections
DO
IF newtm.selections[selection].valid AND loc<=newtm.selections[selection].interval.base THEN newtm.selections[selection].interval.base ← newtm.selections[selection].interval.base + size;
ENDLOOP;
};
BasicDelete:
PROC [oldtm: TextMutant, interval: PipalInt.Interval]
RETURNS [changed: PipalInt.Interval, newtm: TextMutant] = {
oldSize: INT ← Rope.Size[oldtm.text.rope];
base: Location ← interval.base;
size: INT ← interval.size;
newtm ← NEW [TextMutantRec ← oldtm^];
newtm.text ← CreatePipalText[Rope.Cat[Rope.Substr[oldtm.text.rope, 0, base], Rope.Substr[oldtm.text.rope, base+size, oldSize-(base+size)]], oldtm.text.size];
changed ← [base, oldSize];
FOR sel: Selections
IN Selections
DO
IF oldtm.selections[sel].valid
THEN {
oldInterv: PipalInt.Interval ← oldtm.selections[sel].interval;
interv: PipalInt.Interval ← PipalInt.IntersectionIntervals[interval, oldInterv];
IF base<oldInterv.base
THEN newtm.selections[sel].interval.base ←
IF base+size<oldInterv.base
THEN oldInterv.base - size
ELSE base;
IF interv.size>0 THEN newtm.selections[sel].interval.size ← oldInterv.size - interv.size;
};
ENDLOOP;
};
Selection
SetSelection:
PUBLIC
PROC [tm: TextMutant, interval: PipalInt.Interval, selection: Selections ← primary, pendingDelete:
BOOL ←
FALSE, caretAfter:
BOOL ←
FALSE, granularity: SelectionGrain ← char]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
text: PipalText ← tm.text;
newtm ← NEW [TextMutantRec ← tm^];
changed ←
IF newtm.selections[selection].valid
THEN newtm.selections[selection].interval
ELSE [0, 0];
newtm.selections[selection].valid ← TRUE;
newtm.selections[selection].interval ← interval;
newtm.selections[selection].pendingDelete ← pendingDelete;
newtm.selections[selection].caretAfter ← caretAfter;
newtm.selections[selection].granularity ← granularity;
IF (tm.selections[selection].interval.size#0 AND tm.selections[selection].granularity=point) OR (caretAfter AND interval.base>=Rope.Size[text.rope]) THEN ERROR;
changed ← PipalInt.UnionIntervals[changed, interval];
message ← "select";
};
CancelSelection:
PUBLIC
PROC [tm: TextMutant, selection: Selections ← primary]
RETURNS [message: Pipal.
ROPE, changed: PipalInt.Interval, newtm: TextMutant] = {
newtm ← NEW [TextMutantRec ← tm^];
newtm.selections[selection].valid ← FALSE;
changed ← newtm.selections[selection].interval;
message ← "cancel selection";
};
Initialization
Pipal.PutClassMethod[pipalTextClass, Pipal.describeMethod, NEW [Pipal.DescribeProc ← TextDescribe]];
Pipal.PutClassMethod[pipalTextClass, PipalReal.sizeMethod, NEW [PipalReal.SizeProc ← TextSize]];
Pipal.PutClassMethod[pipalTextClass, PipalPaint.paintMethod, NEW [PipalPaint.PaintProc ← TextPaint]];
Pipal.PutClassMethod[textMutantClass, Pipal.describeMethod, NEW [Pipal.DescribeProc ← TextMutantDescribe]];
Pipal.PutClassMethod[textMutantClass, PipalReal.sizeMethod, NEW [PipalReal.SizeProc ← TextMutantSize]];
Pipal.PutClassMethod[textMutantClass, PipalPaint.paintMethod, NEW [PipalPaint.PaintProc ← TextMutantPaint]];
Pipal.PutClassMethod[pipalTextClass, PipalMutate.mutationMethod, NEW [PipalMutate.MutationProc ← MutatePipalText]];