DIRECTORY
ColorizeViewPoint, ColorizeViewPointBackdoor, ColorizeViewPointSweep, Convert, IO, IPMaster, IPScan, Profiles, Real, Rope;


ColorizeViewPointBitmapsImpl: CEDAR PROGRAM
IMPORTS ColorizeViewPoint, ColorizeViewPointBackdoor, ColorizeViewPointSweep, Convert, IO, IPMaster, IPScan, Profiles, Real, Rope
~ BEGIN

ROPE: TYPE ~ Rope.ROPE;
MapData: TYPE ~ ColorizeViewPointBackdoor.MapData;
SampledColorIPFragments: TYPE ~ ColorizeViewPointBackdoor.SampledColorIPFragments;
SampledColorTransformSet: TYPE ~ ColorizeViewPointSweep.SampledColorTransformSet;
nullTransformSet: SampledColorTransformSet ~ ColorizeViewPointSweep.nullTransformSet;

PixelArrayStats: TYPE ~ RECORD [
rectFrag: ROPE _ NIL,
ts: SampledColorTransformSet _ nullTransformSet --sampled color transform data
];
NumRec: TYPE ~ RECORD [
nums: SELECT type: * FROM
int => [i: ARRAY [0..1] OF INT],
real => [r: ARRAY [0..1] OF REAL],
ENDCASE
];
Colors: TYPE ~ RECORD [
foreground, background: REF _ NIL  --hold the ip fragments defining the colors
];
nilColors: Colors ~ [];
AbnormalBitmap: ERROR ~ CODE;  --only used internally

ColorizeBitmaps: ColorizeViewPointBackdoor.Colorization ~ { --prev. version used Xerox Map color operator, which only allows constant colors.  This uses MaskPixel, which allows for sampledcolors and makesampledblacks; it creates a mask out of the pixelarray and presses the current color thru.  For the background color, set the background color and do a maskrectangle; for the foreground (1 bits), set the foreground color and maskpixel.
EachBitmap: IPScan.ScanProc ~ {
ENABLE AbnormalBitmap => {  --apparently not from Free-Hand; flush and go on
newIP _ newIP.Cat[ip.Substr[flushedTo, max]];
flushedTo _ max;
GOTO Ignore;
};
SELECT op FROM
maskpixel --used by Free-Hand Drawing-- => IF ~punt AND ip.Substr[min-4, 4].Equal["\240x\240j"--DOSAVESIMPLEBODY {--] THEN {
colorFrags: Colors;
paStats: PixelArrayStats;
colorFrags _ IF overrideColors#nilColors THEN overrideColors ELSE GetColorIPFrags[palette, mapData, Rope.Concat["Bitmap", Convert.RopeFromInt[(count _ count+1)]], defaultColors]; --override always wins if it's not nil
IF colorFrags.foreground=NIL AND colorFrags.background=NIL THEN --no color change for this bitmap--RETURN;
paStats _ GetPAStats[ip.Substr[min, max-min]];
newIP _ Rope.Concat[newIP, ip.Substr[flushedTo, min-flushedTo]];--to beginning of the p.a., within the DOSAVESIMPLEBODY
IF colorFrags.background#NIL THEN WITH colorFrags.background SELECT FROM
ipFrag: ROPE --constant color-- => newIP _ Rope.Cat[newIP, ipFrag, paStats.rectFrag]; --insert color, then maskrectangle
ipFrag: REF SampledColorIPFragments --sweep color; must construct sweep-- => newIP _ Rope.Cat[newIP, ipFrag.beforeTransform, ColorizeViewPointSweep.ConstructSweepTransform[ts: paStats.ts, sc: ipFrag], ipFrag.afterTransform, paStats.rectFrag]; --insert sweep color, then maskrect
ENDCASE => ERROR; --system error
IF colorFrags.foreground#NIL THEN WITH colorFrags.foreground SELECT FROM
ipFrag: ROPE --constant color-- => newIP _ Rope.Concat[newIP, ipFrag]; --insert color so maskpixel uses that as it's color
ipFrag: REF SampledColorIPFragments --sweep color; must construct sweep-- => newIP _ Rope.Cat[newIP, ipFrag.beforeTransform, ColorizeViewPointSweep.ConstructSweepTransform[ts: paStats.ts, sc: ipFrag], ipFrag.afterTransform];
ENDCASE => ERROR; --system error
flushedTo _ min; --flushed up to the p.a., with 2 colors inserted
};
ENDCASE => ERROR; --system error!
EXITS Ignore => RETURN;
}; 
flushedTo, count: INT _ 0;
overrideColors: Colors _ GetColorIPFrags[palette, mapData, "BitmapALL"]; --"BitmapALL" overrides all other commands.  This allows, eg, BW mapping to work on all bitmaps, without having to provide a new definition for each bitmap
defaultColors: Colors _ IF overrideColors=nilColors THEN GetColorIPFrags[palette, mapData, "Bitmap"] ELSE nilColors; --"Bitmap" in the palette specifies the default colors; if any bitmap has no definition, the default colors apply
IPScan.ScanRope[ip: ip, ops: LIST[maskpixel], action: EachBitmap];
newIP _ newIP.Concat[ip.Substr[flushedTo]];
};

GetPAStats: PROC [paFrag: ROPE] RETURNS [paStats: PixelArrayStats] ~ {
paEnd, transEnd, scaleEnd, pixelsW, pixelsH: INT _ 0;
scaleW, scaleH: REAL;
translateFrag, scale2Frag: ROPE;
IF (paEnd _ paFrag.Find["\241\302" --MAKEPIXELARRAY--]+2)=1--(-1+2)-- THEN ERROR AbnormalBitmap;
IF (transEnd _ paFrag.Find["\240\242\240\250" --TRANSLATE CONCATT--]+2)=1--(-1+2)-- THEN ERROR AbnormalBitmap;
IF (scaleEnd _ paFrag.Find["\240\246\240\250" --SCALE2 CONCATT--]+2)=1--(-1+2)-- THEN ERROR AbnormalBitmap;
translateFrag _ paFrag.Substr[paEnd, transEnd-paEnd];
scale2Frag _ paFrag.Substr[transEnd+2--after CONCATT--, scaleEnd-(transEnd+2)];
WITH tmp: GetNums[translateFrag] SELECT FROM
int => {paStats.ts.offset.x _ tmp.i[0]; paStats.ts.offset.y _ tmp.i[1]}; --auto convert to Real
real => {paStats.ts.offset.x _ tmp.r[0]; paStats.ts.offset.y _ tmp.r[1]};
ENDCASE => ERROR;  --system error
WITH tmp: GetNums[scale2Frag] SELECT FROM
real => {scaleW _ tmp.r[0]; scaleH _ tmp.r[1]};
int => {scaleW _ tmp.i[0]; scaleH _ tmp.i[1]};   --auto convert to Real
ENDCASE => ERROR;  --system error
WITH tmp: GetNums[paFrag] SELECT FROM
int => {pixelsH _ tmp.i[0]; pixelsW _ tmp.i[1]};  --h comes before w in pixel array spec
real => ERROR AbnormalBitmap;  --can't have Real pixel array size descriptors
ENDCASE => ERROR;  --system error
paStats.ts.width.x _ pixelsW*scaleW;
paStats.ts.height.y _ pixelsH*scaleH;
paStats.rectFrag _ MakeRectangle[ColorizeViewPointBackdoor.AltRound[paStats.ts.offset.x], ColorizeViewPointBackdoor.AltRound[paStats.ts.offset.y], ColorizeViewPointBackdoor.AltRound[paStats.ts.width.x], ColorizeViewPointBackdoor.AltRound[paStats.ts.height.y]]; 
};

GetNums: PROC [frag: ROPE] RETURNS [NumRec] ~ { --finds 2 nums at beginning of frag
start: INT _ 0;
tmpI: int NumRec;
tmpR: real NumRec;
returnInt, returnReal: BOOL _ FALSE;
FOR j: NAT IN [0..1] DO  --find x, then find y
SELECT frag.Fetch[start] FROM
<= '\177 --using 2 byte short number encoding, biased by 4000-- => {
tmpI.i[j] _ IPMaster.IntFromSequenceData[text: Rope.ToRefText[frag], start: start, len: 2]-4000;
start _ start+2;
returnInt _ TRUE;
};
'\302 --using multi-byte seqInteger encoding, # bytes found in next byte-- => {
bytes: NAT _ ORD[frag.Fetch[start+1]]; --#bytes which follow
IF bytes>4 THEN ERROR AbnormalBitmap; --would overflow INT boundaries
tmpI.i[j] _ IPMaster.IntFromSequenceData[text: Rope.ToRefText[frag], start: start+2, len: bytes];
start _ start+2+bytes;
returnInt _ TRUE;
};
'\304 --seqRational encoding, # bytes found in next byte (divide evenly between x and y (return REALs)-- => {
numer, denom: REAL _ 0.0;
bytes: NAT _ ORD[frag.Fetch[start+1]]; --#bytes which follow
IF bytes>8 OR (bytes MOD 2)#0 THEN ERROR AbnormalBitmap; -->8 overflows INT; must be even # of bytes
numer _ IPMaster.RealFromSequenceData[text: Rope.ToRefText[frag], start: start+2, len: bytes/2];
denom _ IPMaster.RealFromSequenceData[text: Rope.ToRefText[frag], start: start+2+(bytes/2), len: bytes/2];
tmpR.r[j] _ numer/denom;
start _ start+2+bytes;
returnReal _ TRUE;
};
ENDCASE => ERROR AbnormalBitmap;  --apparently not a VP Free-Hand bitmap
ENDLOOP;
IF returnInt AND returnReal THEN ERROR AbnormalBitmap; --can't have one real and one int num
RETURN [IF returnInt THEN tmpI ELSE tmpR];
};

MakeRectangle: PROC [x, y, w, h: INT] RETURNS [rect: ROPE] ~ {
fragStream: IO.STREAM ~ IO.ROS[];
IPMaster.PutInt[stream: fragStream, n: x];
IPMaster.PutInt[stream: fragStream, n: y];
IPMaster.PutInt[stream: fragStream, n: w];
IPMaster.PutInt[stream: fragStream, n: h];
IPMaster.PutOp[stream: fragStream, op: maskrectangle];
rect _ IO.RopeFromROS[self: fragStream];
};

BadColorDef: ERROR [explanation: ROPE] ~ CODE;
GetColorIPFrags: PROC [palette: Profiles.Profile, mapData: MapData, key: ROPE, defaultColors: Colors _ nilColors] RETURNS [colorFrags: Colors] ~ { --look up "key (ie, "Bitmap", "Bitmap<count>", etc.); returns ipFrags for the foreground and the background colors
ParseBitmapColors: PROC [list: LIST OF ROPE, palette: Profiles.Profile] RETURNS [colorFrags: Colors] ~ {
AddToEnd: PROC [list: LIST OF ROPE, add: ROPE] RETURNS [LIST OF ROPE] ~ {
IF list=NIL THEN RETURN [LIST[add]] ELSE RETURN [CONS[list.first, AddToEnd[list.rest, add]]]};
color: LIST OF ROPE _ NIL;
colCnt: INT _ 1;
amperFound: BOOL _ FALSE;
FOR each: LIST OF ROPE _ list, each.rest UNTIL each=NIL DO
SELECT each.first.Fetch FROM
 '& => {
amperFound _ TRUE;
IF (colCnt _ colCnt+1)>2 THEN ERROR BadColorDef[explanation: "More than 2 colors found."];
IF color=NIL THEN ERROR BadColorDef[explanation: "First color (foreground) not found."];
colorFrags.foreground _ ColorizeViewPointBackdoor.IPFragmentForColorSetting[color, palette];
color _ NIL;
};
ENDCASE => color _ AddToEnd[color, each.first];
ENDLOOP;
IF color=NIL AND amperFound THEN ERROR BadColorDef[explanation: "Second color (background) not found."];
IF amperFound THEN colorFrags.background _ ColorizeViewPointBackdoor.IPFragmentForColorSetting[color, palette]
ELSE colorFrags.foreground _ ColorizeViewPointBackdoor.IPFragmentForColorSetting[color, palette];
};
levelsExceeded: BOOL;
toks: LIST OF ROPE _ NIL;
prefixes: LIST OF ROPE ~ Profiles.ListOfTokens[profile: palette, key: "BitmapPalette", default: NIL]; --can have a separate palette just for Bitmaps
[toks, levelsExceeded] _ ColorizeViewPointBackdoor.GetRecursiveValue[key: key, palette: palette, subpaletteList: ColorizeViewPointBackdoor.SubpaletteSearchList[prefixesIn: prefixes, profile: palette], mapData: mapData];
SELECT TRUE FROM
toks=NIL => RETURN [defaultColors];
levelsExceeded => {
SIGNAL ColorizeViewPoint.Warning[class: $MalformedPaletteEntry, explanation: IO.PutFR[format: "%g is part of a recursive color definition beyond allowable levels; ignoring it.", v1: [rope[key]]]];
RETURN [defaultColors];
};
ENDCASE => {
colorFrags _ ParseBitmapColors[toks, palette !
BadColorDef => {
SIGNAL ColorizeViewPoint.Warning[class: $MalformedPaletteEntry, explanation: Rope.Cat[IO.PutFR[format: "Problem with custom color entry \"%g\":\n", v1: [rope[key]]], explanation, ".\nUsing default values for that bitmap."]];
colorFrags _ defaultColors;
CONTINUE};
];
RETURN;
};
};

ColorizeViewPointBackdoor.InstallNewColorization[colorization: ColorizeBitmaps, setting: [key: "ColorizeBitmaps", description: "Colors bitmaps from the ViewPoint Free-Hand Drawing or Art & Photo programs according to custom commands \"BitmapN: blackReplace & whiteReplace\", where N is the bitmap # in the order laid down.  \"Bitmap: blackReplace & whiteReplace\" gives default coloring for bitmaps; \"BitmapALL: bR & wR\" overrides all other bitmap coloring commands", default: TRUE]];

END.


Ð
ColorizeViewPointBitmapsImpl.mesa
Copyright Ó 1990 by Xerox Corporation.  All rights reserved.
Bob Coleman, September 13, 1990 11:15 am PDT

[ip: ROPE, palette: Profiles.Profile, checkSystemSetting: ColorizeViewPoint.CheckSystemSettingProc, mapData: MapData] RETURNS [newIP: ROPE]
[min: INT, max: INT, op: IPMaster.Op _ nil, seq: IPScan.Seq _ nil, num: INTEGER _ 0, punt: BOOL _ FALSE] (min points to the first token in the set, max points AFTER the last)
�Êt•NewlineDelimiter

™š
œ!™!Icode™<K™,K™—š
Ïk	˜	KšœO�œ)˜zK˜—K˜KšÐlnœ�œ
�˜+Kš�œP�œ(˜�
šœ�˜K˜K•StartOfExpansion} -- [ip: ROPE, palette: Profiles.Profile, checkSystemSetting: ColorizeViewPoint.CheckSystemSettingProc] RETURNS [newIP: ROPE]š�œ�œ�œ
˜Kšœ	�œ%˜2Kšœ�œ5˜RKšœ�œ3˜QKš
œU˜UK˜šœ�œ�œ˜ Kšœ
�œ�˜Kšœ0Ïc˜NK˜—šœ�œ�œ˜šœ�œ	�˜Kšœ�œ�œ
�œ˜ Kšœ�œ�œ
�œ˜"Kš
�˜—K˜—šœ�œ�œ˜Kšœ�œ�œŸ+˜NK˜—K˜KšÏnœ�œ�œŸ˜5K˜š œ-Ÿú˜¶KšÐckb�¡™‹
–l -- [min: INT, max: INT, op: IPMaster.Op _ nil, seq: IPScan.Seq _ nil, num: INTEGER _ 0, punt: BOOL _ FALSE]š 
œ˜Kš
¡®
™®
š�œŸ0˜LKš
œ-˜-K˜Kš�œ˜K˜—š�œ�˜š
œ
Ÿœ�œ�œ'Ÿ¡Ÿœ�œ˜|Kš
œ˜Kš
œ˜Kšœ
�œ�œ�œrŸ&˜Ù
Kš
�œ�œ
�œ�œ
�œ
Ÿ#�œ
˜jKš
œ.˜.Kšœ@Ÿ'¡˜wš�œ�œ
�œ
�œ�œ
�˜HKšœ�œ
Ÿœ7Ÿ"˜xKšœ�œŸ%œª
Ÿ#˜–Kš�œ�œŸ˜ —š�œ�œ
�œ
�œ�œ
�˜HKšœ�œ
Ÿœ(Ÿ3˜zKšœ�œŸ%œ—
˜à
Kš�œ�œŸ˜ —KšœŸ0˜AK˜—Kš�œ�œŸ˜!—Kš�œ�œ
˜Kš
œ˜—Kšœ�œ˜K–A[profile: 
Profiles.Profile, key: 
ROPE, default: 
ROPE _ NIL]šœIŸ›
˜ä
K–A[profile: 
Profiles.Profile, key: 
ROPE, default: 
ROPE _ NIL]šœ�œ�œ-�œŸq˜æ
Kšœ�œ!˜BKš
œ+˜+K˜K˜—–^[colorization: 
ColorizeViewPointBackdoor.Colorization, setting: 
ColorizeViewPoint.Setting]š 
œ�œ
�œ�œ˜FK–>[s1: 
ROPE, s2: 
ROPE, pos1: 
INT _ 0, case: 
BOOL _ TRUE]šœ-�œ˜5Kšœ�œ
˜Kšœ�˜ Kš�œ!Ÿ¡ŸœŸ
œ
�œ
�œ˜`Kš�œ,Ÿ¡ŸœŸ
œ
�œ
�œ˜nKš�œ,Ÿ¡ŸœŸ
œ
�œ
�œ˜kKš
œ5˜5Kšœ%Ÿ¡Ÿœ˜Oš�œ�œ
�˜,KšœIŸ˜_Kš
œI˜IKš�œ�œŸ˜!—š�œ�œ
�˜)Kš
œ/˜/Kšœ1Ÿ˜GKš�œ�œŸ˜!—š�œ�œ
�˜%Kšœ2Ÿ&˜XKšœ�œŸ.˜MKš�œ�œŸ˜!—K–[REAL]š
œ$˜$K–[REAL]š
œ%˜%Kš
œ…˜…K˜K˜—š	 œ�œ�œ�œŸ#˜SKšœ�œ˜K˜K˜Kšœ�œ�œ
˜$š�œ�œ
�œ�Ÿ˜.š�œ�˜šœ	Ÿ6œ˜DKš
œ`˜`K˜Kšœ�œ
˜K˜—šœŸDœ˜OKšœ�œ�œŸ˜<Kš�œ	�œ
�œŸ˜EKš
œa˜aK˜Kšœ�œ
˜K˜—šœŸ`œ˜mKšœ�œ˜Kšœ�œ�œŸ˜<Kš�œ	�œ�œ�œ
�œŸ+˜dKš
œ`˜`Kš
œj˜jKš
œ˜K˜Kšœ
�œ
˜K˜—Kš�œ�œŸ&˜H—Kš�œ
˜—Kš	�œ�œ�œ
�œŸ%˜\Kš�œ�œ
�œ�œ˜*K˜K˜—š
 
œ�œ�œ�œ�œ˜>Kš	œ�œ
�œ�œ
�œ˜!K–[r: 
ROPE]š
œ*˜*K–[r: 
ROPE]š
œ*˜*K–[r: 
ROPE]š
œ*˜*K–[r: 
ROPE]š
œ*˜*K–%[stream: 
STREAM, op: 
IPMaster.Op]˜6K–&[self: 
STREAM, close: 
BOOL _ TRUE]šœ�œ˜(K˜K˜—K–9[prefixesIn: 
LIST OF ROPE, profile: 
Profiles.Profile]š œ�œ�œ�œ
˜.š	 œ�œ4�œ%�œŸr˜…š œ�œ�œ
�œ
�œ�œ˜hš œ�œ�œ
�œ
�œ�œ�œ�œ
�œ
�œ˜IKš�œ�œ
�œ
�œ�œ�œ
�œ�œ)˜^—Kšœ�œ
�œ
�œ�˜Kšœ�œ˜Kšœ�œ�œ
˜š
�œ�œ
�œ
�œ�œ�œ
�˜:š�œ�˜š
œ˜Kšœ
�œ
˜Kš�œ�œ
�œ7˜ZK–2[def: 
LIST OF ROPE, palette: 
Profiles.Profile]š�œ�œ
�œ
�œA˜XKš
œ\˜\Kšœ�œ
˜K˜—Kš�œ(˜/—Kš�œ
˜—K–2[def: 
LIST OF ROPE, palette: 
Profiles.Profile]š
�œ�œ
�œ�œ
�œB˜hKš�œ�œ\˜nKš�œ]˜aK˜—Kšœ�œ
˜Kš	œ�œ
�œ
�œ�œ
˜Kš
œ
�œ
�œ
�œJ�œŸ.˜”
Kš
œÛ
˜Û
š�œ
�œ
�˜Kšœ�œ�œ˜#š
œ˜Kš�œG�œu˜Ä
Kš�œ�
˜K˜—š�œ˜š
œ.˜.š
œ˜Kš�œP�œˆ
˜à
Kš
œ˜Kš�œ˜
—Kš
œ˜—Kš�œ
˜K˜——K˜K˜—Kšœß�œ˜æK˜—Kš�œ
˜J˜—…—)à8$