ColorizeViewPointTextImpl.mesa
Copyright Ó 1989, 1990 by Xerox Corporation. All rights reserved.
Eric Nickell, May 22, 1989 10:55:02 pm PDT
Bob Coleman, July 17, 1990 6:45:44 pm PDT
DIRECTORY
ColorizeViewPointBackdoor, ColorizeViewPoint,
Convert, IO, IPMaster, IPScan, Profiles, Rope, Vector2;
ColorizeViewPointTextImpl: CEDAR PROGRAM
IMPORTS ColorizeViewPoint, ColorizeViewPointBackdoor, Convert, IO, IPMaster, IPScan, Profiles, Rope
EXPORTS ColorizeViewPointBackdoor
~ BEGIN
Types
Colorization: TYPE ~ ColorizeViewPointBackdoor.Colorization;
ROPE: TYPE ~ Rope.ROPE;
ASSERTION: TYPE ~ BOOL [TRUE..TRUE];
Text
ColorizeText: PUBLIC Colorization ~ {
[ip: ROPE, palette: Profiles.Profile, checkSystemSetting: ColorizeViewPoint.CheckSystemSettingProc, mapData: MapData] RETURNS [newIP: ROPE]
Flush: PROC [flushTo: INT, skipTo: INT ← 0, insert: ROPENIL] ~ {
IF insert#NIL THEN newIP ← newIP.Concat[insert];
IF flushTo>flushFrom THEN newIP ← newIP.Concat[ip.Substr[start: flushFrom, len: flushTo-flushFrom]];
flushFrom ← MAX[flushFrom, flushTo, skipTo];
type ← waitingStartU;
};
PerOp: IPScan.ScanProc = {
[min: INT, max: INT, op: IPMaster.Op ← nil, seq: IPScan.Seq ← nil, num: INTEGER ← 0, punt: BOOL ← FALSE]
IF punt THEN {Flush[max]; RETURN};
SELECT type FROM
waitingStartU => {
IF op=startunderline THEN {
Flush[min, max]; --Emit everything up to, but not including, the StartU
type ← waitingMaskU;
}
ELSE Flush[max]; --Emit everything up to, and including, the op
};
waitingMaskU => {
SELECT op FROM
startunderline => { -- Keep flushing for duplicate startunderline's
Flush[min, max];
type ← waitingMaskU; -- keep looking for MaskU
RETURN;
};
maskunderline => { --The Big Event.
strikeout, underline: LIST OF MaskUData ← NIL;
dy, h: INTEGER;
replace: ROPE;
index: INT ← min;
WHILE index+6<=ipSize AND (dy←Num[ip, index])#INTEGER.LAST AND (h←Num[ip, index+2])#INTEGER.LAST AND ip.Substr[start: index+4, len: 2].Equal[ "\241\236" --MASKUNDERLINE--] DO --this loop picks up all the strikeouts and underlines (eg, doubleUnderline) which are grouped together
IF dy<=0 THEN underline ← CONS[[dy: dy, h: h], underline]
ELSE strikeout ← CONS[[dy: dy, h: h], strikeout];
index ← index+6;
ENDLOOP;
replace ← BuildReplacementForTextStuff[strikeout: strikeout, underline: underline, palette: textPalette, betweenStartUAndMaskU: ip.Substr[start: flushFrom, len: min-flushFrom], defaultColor: defaultTextColor, defaultDSColor: defaultDropshadowTextColor];
Flush[flushTo: 0 --i.e. don't flush--, skipTo: index, insert: replace];
RETURN;
};
beginBody => {
IF min=flushFrom+2 AND ip.Substr[start: min-4, len: 6].Equal[ "\241\235\240n\240j" --STARTUNDERLINE CORRECT {--] THEN {
This block of code handles the mapping of
STARTUNDERLINE CORRECT { => CORRECT { STARTUNDERLINE
newIP ← newIP.Concat["\240n\240j" --CORRECT {--];
flushFrom ← max;
RETURN;
};
};
ENDCASE;
Default action for waitingMaskU. Other cases should RETURN.
Flush[flushTo: max, insert: "\241\235" --STARTUNDERLINE--];
};
ENDCASE => ERROR; --System error!
};
textPalette: TextPalette ~ TextPaletteFromProfile[profile: palette, mapData: mapData];
defaultTextColor: ROPE ~ DefaultColorIPFrag[LIST["1.0"], palette, mapData]; --black, mapped
defaultDropshadowTextColor: ROPE ~ DefaultColorIPFrag[LIST["0.0"], palette, mapData]; --white, mapped, for use over the default dropshadow of black
ipSize: INT ~ ip.Size;
flushFrom: INT ← 0;
type: {waitingStartU, waitingMaskU} ← waitingStartU;
newIP ← NIL;
IPScan.ScanRope[ip: ip, ops: LIST[startunderline, maskunderline, beginBody, endBody], action: PerOp];
Flush[ipSize];
};
MaskUData: TYPE ~ RECORD [dy, h: INTEGER];
OffsetIsPercent: TYPE ~ RECORD [x, y: BOOLFALSE];
TextPalette: TYPE ~ ARRAY Underline OF ARRAY --strikeout: -- BOOL OF TextProp;
Underline: TYPE ~ {none, underline, doubleUnderline};
TextProp: TYPE ~ REF TextPropRep;
TextPropRep: TYPE ~ RECORD [
N.B. that colorization will never put in a MaskUnderline call that was not in the original (other that highlighting). Thus, allowing underline~doubleline and strikeout~TRUE allows all the MaskUnderline calls in the original to come through.
underline: Underline ← doubleUnderline,
strikeout: BOOLTRUE,
dropShadowOffset: Vector2.VEC ← [0,0],
offsetIsPercent: OffsetIsPercent, --True means dropShadowOffset is a percentage of font size, not an actual offset
underlineColor, strikeoutColor, highlightColor, textColor, dropShadowColor: Rope.ROPENIL
];
highlightDY: REAL ← -8.0;
highlightH: REAL ← 35.0;
dropShadowH: REAL ← 35.27778; --number of Viewpoint units(.00001meters) per point(1/72")
BuildReplacementForTextStuff: PROC [strikeout, underline: LIST OF MaskUData, palette: TextPalette, betweenStartUAndMaskU: ROPE, defaultColor, defaultDSColor: ROPE] RETURNS [replace: ROPE] ~ {
betweenStartUAndMaskUText: ROPE ~ ExtractBitmapperColorInfo[betweenStartUAndMaskU];
colorMunged: BOOLFALSE;
doStrike: BOOL ← strikeout#NIL;
doUnder: Underline ← SELECT TRUE FROM --counts the elements in the list=num of underlines
underline=NIL => none,
underline.rest=NIL => underline,
ENDCASE => doubleUnderline;
check: ASSERTION ~ doUnder#none OR doStrike;
toDo: TextProp ← palette[doUnder][doStrike];
out: IO.STREAM ~ IO.ROS[];
estimatedPointSize: REAL ~ IF strikeout#NIL THEN strikeout.first.dy/10.0 ELSE -underline.first.dy/8.0; --the position for either strikeout or underline in Viewpoint units correlates by these formulas with the point size of the font, by observation of Viewpoint interpress masters. Multiply by dropShadowH to get size in Viewpoint units.
doStrike ← MIN[doStrike, toDo.strikeout]; --can't strikeout text that was originally underlined only (in default case, toDo.strikeout=TRUE, the MAX)
doUnder ← MIN[doUnder, toDo.underline]; --can't doubleUnderline text that was originally underlined only (in default case, toDo.underline=doubleunderline, the MAX)
out.PutRope["\241\235" --STARTUNDERLINE--];
IF toDo.highlightColor#NIL THEN {  --Highlight
out.PutRope["\240r\240j" --MAKESIMPLECO {--]; --protects imager variables
out.PutRope[betweenStartUAndMaskUText]; --this sets xy but later gets hidden by the highlight box laid down; xy not munged because under a DOSAVEALL
out.PutRope[toDo.highlightColor]; --Doesn't mung color because under a DOSAVEALL
IPMaster.PutReal[stream: out, val: estimatedPointSize * highlightDY];
IPMaster.PutReal[stream: out, val: estimatedPointSize * highlightH]; --observation shows this gives the correct size box in Viewpoint units
out.PutRope["\241\236\240k\240\351" --MASKUNDERLINE } DOSAVEALL--];
};
IF toDo.dropShadowOffset#[0,0] THEN { --Drop Shadow
out.PutRope["\240r\240j" --MAKESIMPLECO {--]; --protects imager variables
out.PutRope[toDo.dropShadowColor];
IPMaster.PutReal[stream: out, val: IF toDo.offsetIsPercent.x THEN toDo.dropShadowOffset.x*(estimatedPointSize*dropShadowH) ELSE toDo.dropShadowOffset.x];
IPMaster.PutReal[stream: out, val: IF toDo.offsetIsPercent.y THEN toDo.dropShadowOffset.y*(estimatedPointSize*dropShadowH) ELSE toDo.dropShadowOffset.y];
out.PutRope["\213" --SETXYREL--];
out.PutRope[betweenStartUAndMaskUText];
out.PutRope["\240k\240\351" --} DOSAVEALL--];
};
SELECT TRUE FROM   --Text Color & Text stuff
toDo.textColor#NIL => {
out.PutRope[toDo.textColor];
colorMunged ← TRUE;
out.PutRope[betweenStartUAndMaskUText]; --w/o attached Bitmapper color info
};
toDo.textColor=NIL => { --use default color: either white or the current Bitmapper color
out.PutRope[IF toDo.dropShadowOffset=[0,0] THEN defaultColor ELSE defaultDSColor]; --normal black unless a dropshadow, then white so DropShadows default nicely
out.PutRope[betweenStartUAndMaskU]; --includes attached color info (Bitmapper), or no color info
colorMunged ← TRUE;
};
ENDCASE;
IF doStrike THEN {   --Strikeout
SELECT TRUE FROM
toDo.strikeoutColor#NIL => {
out.PutRope[toDo.strikeoutColor];
colorMunged ← TRUE;
};
colorMunged => {
out.PutRope["\017\241\241\250" --1 SETGRAY--];
colorMunged ← FALSE;
};
ENDCASE;
UNTIL strikeout=NIL DO
IPMaster.PutReal[stream: out, val: strikeout.first.dy];
IPMaster.PutReal[stream: out, val: strikeout.first.h];
out.PutRope["\241\236" --MASKUNDERLINE--];
strikeout ← strikeout.rest;
ENDLOOP;
};
IF doUnder > none THEN {  --Underline
SELECT TRUE FROM
toDo.underlineColor#NIL => {
out.PutRope[toDo.underlineColor];
colorMunged ← TRUE;
};
colorMunged => {
out.PutRope["\017\241\241\250" --1 SETGRAY--];
colorMunged ← FALSE;
};
ENDCASE;
UNTIL underline=NIL DO
IPMaster.PutReal[stream: out, val: underline.first.dy];
IPMaster.PutReal[stream: out, val: underline.first.h];
out.PutRope["\241\236" --MASKUNDERLINE--];
underline ← IF doUnder=doubleUnderline THEN underline.rest ELSE NIL; --Only do first one if doUnder=underline
ENDLOOP;
};
IF colorMunged THEN {   --Color Restoration
out.PutRope["\017\241\241\250" --1 SETGRAY--];
colorMunged ← FALSE;
};
RETURN [out.RopeFromROS.Flatten];
};
ExtractBitmapperColorInfo: PROC [ipFrag: ROPE] RETURNS [textOnly: ROPE] ~ { --this is relevent for Bitmapper files, which lays down color info before SHOWing text. This is highly Bitmapper implementation dependent - it expects to see n1 n2 n3 3 MAKEVEC 47 FGET DO 13 ISET <Text...> SHOW. Frame 47 is where BitMapper currently stores the YES ColorModel
IF ipFrag.Fetch[MIN[ipFrag.Length-1, 17--avoids BoundsFault--]]='\223 --ISET-- THEN RETURN [ipFrag.Substr[start: 18] ]
ELSE RETURN [ipFrag];
};
TextPaletteFromProfile: PROC [profile: Profiles.Profile, mapData: ColorizeViewPointBackdoor.MapData] RETURNS [textPalette: TextPalette] ~ {
Do: PROC [strike: BOOL, u: Underline, key: ROPE] ~ {
ENABLE ColorizeViewPoint.Error => { --Map Error to Warning, and abandon palette entry
SIGNAL ColorizeViewPoint.Warning[class, IO.PutFR[format: "Entry %g: in embedded palette is malformed because-\n\t %g", v1: [rope[key]], v2: [rope[explanation]] ]];
GOTO AbandonThisPaletteEntry;
};
SearchFor: PROC [r: ROPE] RETURNS [count: INT ← 0] ~ {
FOR each: LIST OF ROPE ← toks, each.rest UNTIL each=NIL DO
count ← count+1;
IF Rope.Run[s1: each.first, s2: r, case: FALSE]=each.first.Length THEN RETURN [count]; --abbrev. will match; ie, "strike" will match "strikeout"
ENDLOOP;
RETURN [0]; --not found
};
SubColorFromToks: PROC [count: INT] RETURNS [rest: LIST OF ROPE, color: ROPENIL] ~ {--Starting from the "count" element in toks, parses a color which should be enclosed in brackets; returns the rest of the list w/o that color. Eg, for "foo dropShadow[green] bar, returns rest: foo bar, color: <ipFrag for green>
dummy1: LIST OF ROPE ~ LIST[NIL];
dummy2: LIST OF ROPE ~ LIST[NIL];
tail: LIST OF ROPE ← dummy1;
listCount: INT ← 0;
startColor, endColor: BOOLFALSE; --mark when parsing requested color
rest ← dummy2;
FOR each: LIST OF ROPE ← toks, each.rest UNTIL each=NIL DO
listCount ← listCount+1;
SELECT TRUE FROM
listCount<count OR endColor => rest ← (rest.rest ← LIST[each.first]);
listCount=count => LOOP; -- get past, eg, "dropShadow" keyword
listCount>count AND each.first.Equal["]"] => IF ~startColor --"dropshadow []"-- THEN {color ← defaultColor; endColor ← TRUE} ELSE endColor ← TRUE;
listCount=count+1 => IF ~Rope.Equal[each.first, "[" --eg, "dropshadow" alone--] THEN {color ← defaultColor; endColor ← TRUE; rest ← (rest.rest ← LIST[each.first])};
ENDCASE => { --get the subColor
temp: LIST OF ROPE;
levelsExceeded: BOOL;
startColor ← TRUE;
[temp, levelsExceeded] ← ColorizeViewPointBackdoor.GetRecursiveValue[key: each.first, palette: profile, subpaletteList: prefixes, mapData: mapData];
SELECT TRUE FROM
temp=NIL => tail ← (tail.rest ← LIST[each.first]); --add as-is if not in palette
levelsExceeded => ERROR ColorizeViewPoint.Error[class: $MalformedPaletteEntry, explanation: IO.PutFR[format: "%g is part of a recursive color definition beyond allowable levels; ignoring it.", v1: [rope[each.first]]]];
ENDCASE => {FOR each: LIST OF ROPE ← temp, each.rest UNTIL each=NIL DO tail ← (tail.rest ← LIST[each.first]); ENDLOOP}; --add the expanded palette definition to end
};
ENDLOOP;
rest ← dummy2.rest;
IF listCount=count THEN color ← defaultColor; --eg, "dropshadow" at end of line
IF color=NIL THEN
WITH ColorizeViewPointBackdoor.IPFragmentForColorSetting[dummy1.rest, profile] SELECT FROM
color: ROPE => RETURN [rest: rest, color: color];
ENDCASE => ERROR ColorizeViewPoint.Error[$MalformedPaletteEntry, "Constant color required"];
};
count: NAT;
toks: LIST OF ROPE ← ColorizeViewPointBackdoor.GetRecursiveValue[key: key, palette: profile, subpaletteList: prefixes, mapData: mapData, levelsAllowed: 0--no recurse--].value;
textPalette[u][strike] ← NEW[TextPropRep ← []];
IF toks=NIL THEN RETURN; --if no relevent palette entries leave with defaults
textPalette[u][strike].strikeout ← FALSE; --Change defaults a bit
textPalette[u][strike].underline ← none;
IF (count ← SearchFor["Highlight"])#0 THEN
[rest: toks, color: textPalette[u][strike].highlightColor] ← SubColorFromToks[count];
IF (count ← SearchFor["DropShadow"])#0 THEN {
[textPalette[u][strike].offsetIsPercent, textPalette[u][strike].dropShadowOffset, toks] ← SetDropShadowParms[toks: toks, profile: profile]; --looks for eg "(-7%, 9%)"
count ← SearchFor["DropShadow"];--removing dropShad parms may change count
[rest: toks, color: textPalette[u][strike].dropShadowColor] ← SubColorFromToks[count];
};
IF (count ← SearchFor["Strikeout"])#0 THEN {
textPalette[u][strike].strikeout ← TRUE;
[rest: toks, color: textPalette[u][strike].strikeoutColor] ← SubColorFromToks[count];
};
SELECT TRUE FROM
(count ← SearchFor["Underline"])#0 => {
textPalette[u][strike].underline ← underline;
[rest: toks, color: textPalette[u][strike].underlineColor] ← SubColorFromToks[count];
};
(count ← SearchFor["DoubleUnderline"])#0 => {
textPalette[u][strike].underline ← doubleUnderline;
[rest: toks, color: textPalette[u][strike].underlineColor] ← SubColorFromToks[count];
};
ENDCASE => NULL;
IF toks=NIL THEN textPalette[u][strike].textColor ← NIL
ELSE textPalette[u][strike].textColor ← SubColorFromToks[-2].color; --leftover must be considered the text color; a count of -2 gets past looking for brackets etc.
EXITS AbandonThisPaletteEntry => NULL;
};
prefixes: LIST OF ROPE ← Profiles.ListOfTokens[profile: profile, key: "TextPalette", default: NIL];
defaultColor: ROPE ~ DefaultColorIPFrag[LIST["1.0"], profile, mapData]; --black, mapped
prefixes ← ColorizeViewPointBackdoor.SubpaletteSearchList[prefixes, profile]; --adds document-wide prefixes to end
Do[strike: FALSE, u: underline, key: "Underline"];
Do[strike: FALSE, u: doubleUnderline, key: "DoubleUnderline"];
Do[strike: TRUE, u: none, key: "Strikeout"];
Do[strike: TRUE, u: underline, key: "StrikeoutUnderline"];
Do[strike: TRUE, u: doubleUnderline, key: "StrikeoutDoubleUnderline"];
};
DefaultColorIPFrag: PROC [defaultColor: LIST OF ROPE, palette: Profiles.Profile, mapData: ColorizeViewPointBackdoor.MapData] RETURNS [ROPE] ~ {
mappedColor: LIST OF ROPE ← ColorizeViewPointBackdoor.ApplyMappings[toMap: defaultColor, palette: palette, mapData: mapData].mappedList;
WITH ColorizeViewPointBackdoor.IPFragmentForColorSetting[mappedColor, palette] SELECT FROM
color: ROPE => RETURN [color];
ENDCASE => RETURN ["\017\241\241\250" --1 SETGRAY--];
};
SetDropShadowParms: PROC [toks: LIST OF ROPE, profile: Profiles.Profile] RETURNS [offsetIsPercent: OffsetIsPercent, dropShadowOffset: Vector2.VEC ← [0,0], rest: LIST OF ROPE] ~ {
GetOffsetRope: PROC [] RETURNS [offsetRope: LIST OF ROPE] ~ { --looking for, eg, "(-7% 9%)" in the midst of toks; removes it to create rest
dummy1: LIST OF ROPE ~ LIST[NIL]; --to add elements to end of a 2 lists
dummy2: LIST OF ROPE ~ LIST[NIL];
tail: LIST OF ROPE ← dummy1;
count, paren: INT ← 0;
minus, tooMany, tooWeird, parensFound: BOOLFALSE;
rest ← dummy2;
FOR each: LIST OF ROPE ← toks, each.rest UNTIL each=NIL DO
SELECT TRUE FROM
each.first.Equal["("] => {paren ← paren+1; parensFound ← TRUE};
each.first.Equal[")"] => paren ← paren-1;
paren=0 => rest ← (rest.rest ← LIST[each.first]);
tooMany, tooWeird => NULL;
ENDCASE --within the parens-- => {
IF count>2 THEN tooMany ← TRUE;
SELECT each.first.Fetch FROM
'- => minus ← TRUE;
IN ['0..'9], '. => {count ← count+1;
IF count<3 THEN tail ← (tail.rest ← LIST[IF minus THEN Rope.Concat["-", each.first] ELSE each.first]); minus ← FALSE};
IN [IO.NUL .. IO.SP], ',, ';, '\t, '[, '], '{, '} => LOOP;
ENDCASE => tooWeird ← TRUE;
};
ENDLOOP;
rest ← dummy2.rest;
SELECT TRUE FROM
~parensFound => offsetRope ← dropShadowOffsetDefault;
tooMany => {
offsetRope ← dummy1.rest;
SIGNAL ColorizeViewPoint.Warning[$MalformedPaletteEntry, IO.PutFR[format: "Too many numbers between parens for dropShadow def \"%g\" - first 2 numbers being used (%g %g)", v1: [rope[RopeFromList[toks]]], v2: [rope[offsetRope.first]], v3: [rope[offsetRope.rest.first]] ]];
};
count<2 OR tooWeird => {
SIGNAL ColorizeViewPoint.Warning[$MalformedPaletteEntry, IO.PutFR[format: "Strange profile entry \"%g\" - default offset (%g %g) being used", v1: [rope[RopeFromList[toks]]], v2: [rope[dropShadowOffsetDefault.first]], v3: [rope[dropShadowOffsetDefault.rest.first]] ]];
offsetRope ← dropShadowOffsetDefault;
};
ENDCASE => offsetRope ← dummy1.rest;
};
SetParms: PROC [] ~ {
percentIndex: INT;
offsetIsPercent.x ← (percentIndex ← offsetRope.first.Find["%"])#-1;
dropShadowOffset.x ← IF offsetIsPercent.x THEN Convert.RealFromRope[r: offsetRope.first.Substr[len: percentIndex]] * .01 ELSE Convert.RealFromRope[r: offsetRope.first];
offsetIsPercent.y ← (percentIndex ← offsetRope.rest.first.Find["%"])#-1;
dropShadowOffset.y ← IF offsetIsPercent.y THEN Convert.RealFromRope[r: offsetRope.rest.first.Substr[len: percentIndex]] * .01 ELSE Convert.RealFromRope[r: offsetRope.rest.first];
};
dropShadowOffsetDefault: LIST OF ROPE ← Profiles.ListOfTokens[profile: profile, key: "DefaultDropShadowOffset", default: LIST["-5%", "5%"]];
offsetRope: LIST OF ROPE ← GetOffsetRope[];
SetParms[ ! Convert.Error => {
SIGNAL ColorizeViewPoint.Warning[$MalformedPaletteEntry, IO.PutFR[format: "Problems understanding profile entry \"%g\" - default offset (%g %g) being used", v1: [rope[RopeFromList[toks]]], v2: [rope[dropShadowOffsetDefault.first]], v3: [rope[dropShadowOffsetDefault.rest.first]] ]];
offsetRope ← dropShadowOffsetDefault; --better be guaranteed not to cause a Convert error!
RETRY };
];
};
RopeFromList: PROC [list: LIST OF ROPE] RETURNS [rope: ROPENIL] ~ {FOR each: LIST OF ROPE ← list, each.rest UNTIL each=NIL DO rope ← rope.Cat[" ", each.first]; ENDLOOP};
Num: PROC [ip: ROPE, index: INT] RETURNS [n: INTEGER] ~ {
token: IPMaster.Token ~ IPMaster.GetToken[encoding: ip, start: index].token;
RETURN [IF token.type=num THEN token.num ELSE INTEGER.LAST];
};
Initialization
ColorizeViewPointBackdoor.InstallNewColorization[colorization: ColorizeText, setting: ["ColorizeText", "Do colorization of text based on underline and strikeout", TRUE]];
ColorizeViewPointBackdoor.RegisterKeywords[keywordsList: LIST["Underline", "DoubleUnderline", "Strikeout", "StrikeoutUnderline", "StrikeoutDoubleUnderline"]]; --Each Colorization reserves its colorizing keywords.
END.