NectarineColorsImpl.mesa
Copyright Ó 1987, 1988 by Xerox Corporation. All rights reserved.
Giordano Bruno Beretta, June 24, 1987 9:16:35 am PDT
gbb October 14, 1988 11:46:24 am PDT
Jean-Marc Frailong December 12, 1988 12:04:27 pm PST
Inference engine for the colour registries and colour blending.
WARNING: Because of the mapping from layers to ChipNDale numbers, it is assumed that only one technology at the time is used (caches in global variables).
Inference engine [registry-1 = Imager, registry-2 = ChipNDale]:
Rule 1: if registry-1/cmos-b defines named colour then Decide [rule 6, registered colour], else Decide [rule 2, named colour].
Rule 2: if registry-1/ChipNDale defines named colour then Decide [rule 7, registered colour], else Decide [rule 5, named colour].
Rule 3: if registry-1/cmos-b defines named colour then Decide [rule 10, registered colour], else Decide [rule 4, named colour].
Rule 4: if registry-1/ChipNDale defines named colour then Decide [rule 10, registered colour], else Decide [NIL, BLACK].
Rule 5: if registry-2 defines named colour then Decide [rule 8, registered colour], else Decide [rule 11, name].
Rule 6: if named colour can inherit a constant color then Decide [NIL, constant color] else Decide [rule 2, registered colour].
Rule 7: if named colour can inherit a constant color then Decide [NIL, constant color] else Decide [rule 5, registered colour].
Rule 8: if named colour can inherit a constant color then Decide [NIL, constant color] else Decide [rule 11, registered colour].
Rule 9: if colour has an escape value then Decide [NIL, escape color] else Decide [Rule 1, registered colour].
Rule 10: if named colour can inherit a constant color then Decide [NIL, constant color] else Decide [NIL, BLACK].
Rule 11: Decide [NIL, undefined colour]
Rule 12: if layer is in the extended color map or was previously determined then Decide [NIL, this color] else Decide [Rule 9, any colour].
DIRECTORY
Args USING [Arg, ArgsGet, Error, NArgs],
Atom USING [GetPName],
CD USING [Layer, LayerKey],
CDColorsExtras USING [ColorNotRegistered, InitialColor, RegisteredColor],
Checksum USING [ComputeChecksum],
Commander USING [CommandProc, Register],
CommandTool USING [NextArgument],
FS USING [ComponentPositions, Error, ExpandName, StreamOpen, tText],
FSExtras USING [GetWDir],
Imager USING [black, Error],
ImagerColor USING [ColorFromRGB, ColorOperator, ColorRep, ConstantColor, Find, NarrowToOpConstantColor, OpConstantColor, RGB, SpecialColor],
ImagerColorFns USING [CMY, CMYK, CMYFromRGB, HSLFromRGB, NewColorOperatorCMYK],
ImagerColorPrivate USING [RGBFromColor],
ImagerInterpress USING [DeclareColor, Ref],
IO USING [atom, card, Close, EndOf, EndOfStream, Error, GetAtom, GetCard, GetCedarTokenRope, GetIndex, GetInt, GetLength, GetLineRope, int, PutF, PutFR, PutRope, RIS, real, rope, SetIndex, STREAM, TokenKind],
MessageWindow USING [Append, Blink, Clear],
NamedColors USING [HSLToRope],
NectarineColors,
Real USING [Float, InlineRoundC, Round],
RealFns USING [AlmostZero],
RefTab USING [Create, EachPairAction, EqualProc, Erase, Fetch, GetSize, HashProc, Insert, Pairs, Ref],
Rope USING [Cat, Equal, Fetch, IsEmpty, ROPE, Substr],
RuntimeError USING [UNCAUGHT],
SymTab USING [Ref, Create, GetSize, Fetch, Store, Val],
TerminalIO USING [PutF, PutRope],
UserProfile USING [Boolean, Token],
ViewerOps USING [BlinkDisplay];
NectarineColorsImpl: CEDAR PROGRAM
IMPORTS Args, Atom, CD, CDColorsExtras, Checksum, Commander, CommandTool, FS, FSExtras, Imager, ImagerColor, ImagerColorFns, ImagerColorPrivate, ImagerInterpress, IO, MessageWindow, NamedColors, Real, RealFns, RefTab, Rope, RuntimeError, SymTab, TerminalIO, UserProfile, ViewerOps
EXPORTS NectarineColors ~ BEGIN
OPEN NectarineColors, Real, RealFns;
ROPE: TYPE ~ Rope.ROPE;
RGB: TYPE ~ ImagerColor.RGB;
CMYK: TYPE ~ ImagerColorFns.CMYK;
cmyk255: ImagerColor.ColorOperator ~ ImagerColorFns.NewColorOperatorCMYK [255];
colSubDef: PUBLIC BOOLTRUE;  -- default for colour substitution
traceColourInferences: PUBLIC BOOLFALSE;
obeyToChipNDale: BOOLFALSE;
magicNumber: CARDINAL ~ 557; -- or 997
debug: BOOLTRUE;
break: SIGNAL ~ CODE;  -- for debugging
argError, lastWDir: ROPE;
currentlyUsedLayers: Bitset;
currentlyUsedLayerNames: SymTab.Ref ← SymTab.Create [magicNumber];
Basic palette
aqua, black, blue, brown, colourBlack, cyan, doubleYellow, green, grey, lightMagenta, lightYellow, lime, magenta, orange, pink, red, turquise, ultraviolet, undefColour, violet, white, yellow: Color;
blackRGB, blueRGB, cyanRGB, doubleYellowRGB, greenRGB, magentaRGB, redRGB, yellowRGB: RGB;
blackBlack, orableBackground: PUBLIC Color;
unColour: PUBLIC RGB;
Cached colours:
cyanCMYK: Color ~ ColorFromCMYK [[1.0, 0.0, 0.0, 0.0]];
magentaCMYK: Color ~ ColorFromCMYK [[0.0, 1.0, 0.0, 0.0]];
yellowCMYK: Color ~ ColorFromCMYK [[0.0, 0.0, 1.0, 0.0]];
blackCMYK: Color ~ ColorFromCMYK [[0.0, 0.0, 0.0, 1.0]];
blueCMYK: Color ~ ColorFromCMYK [[1.0, 1.0, 0.0, 0.0]];
redCMYK: Color ~ ColorFromCMYK [[0.0, 1.0, 1.0, 0.0]];
greenCMYK: Color ~ ColorFromCMYK [[1.0, 0.0, 1.0, 0.0]];
greenishBlackCMYK: Color ~ ColorFromCMYK [[1.0, 0.0, 1.0, 1.0]];
greyCMYK: Color ~ ColorFromCMYK [[0.0, 0.0, 0.0, 0.5]];
UseSimpleColours: PUBLIC PROC [] ~ BEGIN
Set the colors to the values obtained by simply speading the hues.
undefColour ← NIL;
unColour ← [0.0, 0.0, 0.0];
blackRGB ← [0.0, 0.0, 0.0];
blackBlack ← blackCMYK;
colourBlack ← Imager.black;
grey ← greyCMYK;
white ← ImagerColor.ColorFromRGB [rgb: [R: 1, G: 1, B: 1]];
red ← redCMYK;
green ← greenCMYK;
blueRGB ← [0.0, 0.0, 1.0];
cyan ← cyanCMYK;
magentaRGB ← [1.0, 0.0, 1.0];
magenta ← magentaCMYK;
lightMagenta ← ImagerColor.ColorFromRGB [[5.0/7.0, 0.0, 5.0/7.0]];
doubleYellowRGB ← [2.0, 2.0, 0.0];
doubleYellow ← ImagerColor.ColorFromRGB [doubleYellowRGB];
lightYellow ← ImagerColor.ColorFromRGB [[13.0/14.0, 13.0/14.0, 10.0/21.0]];
yellow ← yellowCMYK;
violet ← ImagerColor.ColorFromRGB [rgb: [R: 0.45, G: 0.25, B: 0.75]];
brown ← ImagerColor.ColorFromRGB [rgb: [R: 0.64, G: 0.2752, B: 0.16]];
orange ← ImagerColor.ColorFromRGB [rgb: [R: 0.64, G: 0.2752, B: 0.16]]; -- we prefer our orange
lime ← ImagerColor.ColorFromRGB [rgb: [R: 0.39, G: 0.75, B: 0.75]];
turquise ← ImagerColor.ColorFromRGB [rgb: [R: 0.42, G: 0.7, B: 0.92]];
aqua ← ImagerColor.ColorFromRGB [rgb: [R: 0.42, G: 0.92, B: 0.55]];
ultraviolet ← ImagerColor.ColorFromRGB [rgb: [R: 0.13, G: 0, B: 0.33]];
pink ← ImagerColor.ColorFromRGB [rgb: [R: 0.9, G: 0.45, B: 0.55]]; -- we need a bit more red and less green in it
orableBackground ← CDColorsExtras.InitialColor [];
black ← blackCMYK;
blue ← blueCMYK
END; -- UseSimpleColours
UseSqueezedColours: PUBLIC PROC [] ~ BEGIN
Set the colors to the values obtained by simply speading the hues.
"-- [x, y], Y" means that we computed CalibratedColorFns.XYZFromChromaticity [[x, y], Y]
undefColour ← NIL;
unColour ← [0.0, 0.0, 0.0];
blackRGB ← [0.0, 0.0, 0.0];
blackBlack ← blackCMYK;
colourBlack ← Imager.black;
grey ← greyCMYK;
white ← ImagerColor.ColorFromRGB [rgb: [R: 1, G: 1, B: 1]];
redRGB ← [R: 0.916726, G: 2.183968e-2, B: 2.917295e-2]; -- [0.59, 0.335], 5.31
red ← ImagerColor.ColorFromRGB [redRGB];
greenRGB ← [R: -0.2129092, G: 1.04013, B: 0.1963416]; -- [0.25, 0.525], 17.53
green ← ImagerColor.ColorFromRGB [greenRGB];
blueRGB ← [R: 1.158857e-2, G: 8.760574e-2, B: 0.2601715]; -- [0.2, 0.2], 2.16
cyanRGB ← [R: -0.2437036, G: 1.042247, B: 1.25352];  -- [0.2, 0.3], 19.69
cyanRGB ← [R: 0.0, G: 1.285951, B: 1.497224];
cyan ← ImagerColor.ColorFromRGB [cyanRGB];
magentaRGB ← [R: 0.5401293, G: 0.1748126, B: 0.7118298]; -- [0.29, 0.21], 7.47
magenta ← ImagerColor.ColorFromRGB [rgb: magentaRGB];
lightMagenta ← ImagerColor.ColorFromRGB [[5.0/7.0*magentaRGB.R, 0.0, 5.0/7.0*magentaRGB.B]];
yellowRGB ← [R: 1.495448, G: 0.8532933, B: -0.0296737]; -- [0.47, 0.48], 22.83
yellow ← ImagerColor.ColorFromRGB [rgb: yellowRGB];
doubleYellowRGB ← [2*yellowRGB.R, 2*yellowRGB.G, 2*yellowRGB.B];
lightYellow ← ImagerColor.ColorFromRGB [[13.0/14.0*yellowRGB.R, 13.0/14.0*yellowRGB.G, 10.0/21.0*yellowRGB.B]];
violet ← ImagerColor.ColorFromRGB [rgb: [R: 0.45, G: 0.25, B: 0.75]];
brown ← ImagerColor.ColorFromRGB [rgb: [R: 0.64, G: 0.2752, B: 0.16]];
orange ← ImagerColor.ColorFromRGB [rgb: [R: 0.64, G: 0.2752, B: 0.16]]; -- we prefer our orange
lime ← ImagerColor.ColorFromRGB [rgb: [R: 0.39, G: 0.75, B: 0.75]];
turquise ← ImagerColor.ColorFromRGB [rgb: [R: 0.42, G: 0.7, B: 0.92]];
aqua ← ImagerColor.ColorFromRGB [rgb: [R: 0.42, G: 0.92, B: 0.55]];
ultraviolet ← ImagerColor.ColorFromRGB [rgb: [R: 0.13, G: 0, B: 0.33]];
pink ← ImagerColor.ColorFromRGB [rgb: [R: 0.9, G: 0.45, B: 0.55]]; -- we need a bit more red and less green in it
orableBackground ← CDColorsExtras.InitialColor [];
black ← ImagerColor.ColorFromRGB [blackRGB];
blue ← ImagerColor.ColorFromRGB [blueRGB];
doubleYellow ← ImagerColor.ColorFromRGB [doubleYellowRGB]
END; -- UseSqueezedColours
Colouring single layers
layerColorTable: ARRAY CD.Layer OF Color; -- must be set for each task
Rule: TYPE ~ PROC [layer: ATOM, colour: REF ANY] RETURNS [next: Rule, sameLayer: ATOM, newColour: Color];
decided: Rule ~ NIL;
r1, r2, esc: Color ← NIL; -- to monitor the contents of the registries
layerNumberHack: CD.Layer; -- cd registry uses number instead of name
LayerColour: PUBLIC PROC [l: CD.Layer] RETURNS [Color] ~ BEGIN
RETURN [layerColorTable[l]]
END; -- LayerColour
MakeConstant: PROC [any: REF ANY] RETURNS [c: Color] ~ BEGIN
Recurses down the inheritance hierarchy until a constant colour is found. If at the end there is no constant colour, the Imager blinks the screen and raises Error. I catch the error, reproduce the blinking, and recover.
cc: ImagerColor.ConstantColor ~ NARROW [any];
TRUSTED BEGIN
c ← LOOPHOLE [ImagerColor.NarrowToOpConstantColor [cc ! Imager.Error => {c ← NIL; ViewerOps.BlinkDisplay; CONTINUE}]]
END
END; -- MakeConstant
ColourName: PROC [c: Color] RETURNS [ROPE] ~ BEGIN
Can handle nil and named colours.
IF (c = NIL) THEN RETURN ["---"];
IF (ISTYPE [c, ImagerColor.SpecialColor]) THEN BEGIN
sc: ImagerColor.SpecialColor ~ NARROW [c, ImagerColor.SpecialColor];
RETURN [sc.name]
END;
RETURN [NamedColors.HSLToRope [ImagerColorFns.HSLFromRGB[RGBFromColour[c]],3]]
END; -- ColourName
Decide: PROC [rule: Rule, l: ATOM, c: Color] RETURNS [Color] ~ BEGIN
WHILE (rule # decided) DO [rule, l, c] ← rule [l, c] ENDLOOP;
InferenceStatus [l, "NIL", "has been inferred"];
RETURN [c]
END; -- Decide
InferenceStatus: PROC [object: ATOM, rule, status: ROPE] ~ BEGIN
msg: ROPE ~ Atom.GetPName[object].Cat [". Deciding rule ", rule, ": ", status];
MessageWindow.Clear; MessageWindow.Append [msg];
IF traceColourInferences THEN TerminalIO.PutF ["%g\n", IO.rope [msg]]
END; -- InferenceStatus
InferenceResult: PROC [object: ATOM, colour: Color] ~ BEGIN
rgb: RGB ~ RGBFromColour [colour];
cmyk: CMYK ~ CMYKFromRGB [rgb];
TerminalIO.PutF ["%l%g.%l ", IO.rope ["b"], IO.atom [object], IO.rope ["B"]];
TerminalIO.PutF ["CNS: (registry 1: %g; registry 2: %g) inferred: %g\n",
IO.rope [ColourName [r1]],
IO.rope [ColourName [r2]],
IO.rope [ColourName [colour]]];
TerminalIO.PutF ["CMYK: [%g, %g, %g, %g]\n",
IO.real [cmyk.C],
IO.real [cmyk.M],
IO.real [cmyk.Y],
IO.real [cmyk.K]];
TerminalIO.PutF ["RGB: [%g, %g, %g]\n",
IO.real [rgb.R],
IO.real [rgb.G],
IO.real [rgb.B]]
END; -- InferenceResult
One: Rule ~ BEGIN
InferenceStatus [layer, "One", "registry-1/cmos-b"];
r1 ← newColour ← ImagerColor.Find [Rope.Cat ["Xerox/Research/ChipNDale/CMosB/", Atom.GetPName [layer]]];
IF (newColour # NIL) THEN RETURN [Six, layer, newColour]
ELSE RETURN [Two, layer, newColour]
END; -- One
Two: Rule ~ BEGIN
InferenceStatus [layer, "Two", "registry-1/chipndale"];
r1 ← newColour ← ImagerColor.Find [Rope.Cat ["Xerox/Research/ChipNDale/CD/", Atom.GetPName [layer]]];
IF (newColour # NIL) THEN RETURN [Seven, layer, newColour]
ELSE RETURN [Five, layer, newColour]
END; -- Two
Three: Rule ~ BEGIN
InferenceStatus [layer, "Three", "registry-1/cmos-b"];
r1 ← newColour ← ImagerColor.Find [Rope.Cat ["Xerox/Research/ChipNDale/CMosB/", Atom.GetPName [layer]]];
IF (newColour # NIL) THEN RETURN [Ten, layer, newColour]
ELSE RETURN [Four, layer, newColour]
END; -- Three
Four: Rule ~ BEGIN
InferenceStatus [layer, "Four", "registry-1/chipndale"];
r1 ← newColour ← ImagerColor.Find [Rope.Cat ["Xerox/Research/ChipNDale/CD/", Atom.GetPName [layer]]];
IF (newColour # NIL) THEN RETURN [Ten, layer, newColour]
ELSE RETURN [NIL, layer, blackBlack]
END; -- Four
Five: Rule ~ BEGIN
InferenceStatus [layer, "Five", "registry-2"];
r2 ← newColour ← CDColorsExtras.RegisteredColor [layerNumberHack ! CDColorsExtras.ColorNotRegistered => {newColour ← NIL; CONTINUE}];
IF (newColour # NIL) THEN RETURN [Eight, layer, newColour]
ELSE RETURN [Eleven, layer, newColour]
END; -- Five
Six: Rule ~ BEGIN
InferenceStatus [layer, "Six", "constant inheritance"];
newColour ← MakeConstant [colour];
IF (newColour # NIL) THEN RETURN [NIL, layer, newColour]
ELSE RETURN [Two, layer, newColour]
END; -- Six
Seven: Rule ~ BEGIN
InferenceStatus [layer, "Seven", "constant inheritance"];
newColour ← MakeConstant [colour];
IF (newColour # NIL) THEN RETURN [NIL, layer, newColour]
ELSE RETURN [Five, layer, newColour]
END; -- Seven
Eight: Rule ~ BEGIN
InferenceStatus [layer, "Eight", "constant inheritance"];
newColour ← MakeConstant [colour];
IF (newColour # NIL) THEN RETURN [NIL, layer, newColour]
ELSE RETURN [Eleven, layer, newColour]
END; -- Eight
Nine: Rule ~ BEGIN
Spread out hues & make "more subtractive".
InferenceStatus [layer, "Nine", "escape value"];
esc ← newColour ← SELECT layer FROM
$nwel => lightYellow,
$met => cyan,
$met2 => lightMagenta,
In ChipNdale 23 cut (cut-2) was always black (blue), but in rel. 24 was displayed black (blue) and printed blue (green).
$cut, $comment => blackBlack,
$cut2 => blue,
$gate => doubleYellow,
$xneutral => blackBlack, $xred => red, $xyellow => yellow, $xgreen => green, $xcyan => cyan, $xviolet => violet, $xmagenta => magenta, $xwhite => white, $xbrown => brown, $xorange => orange, $xlime => lime, $xturquise => turquise, $xaqua => aqua, $xultraviolet => ultraviolet, $xpink => pink, $xsmoke => grey, $xblue => blue,
ENDCASE => NIL;
IF (newColour # NIL) THEN RETURN [NIL, layer, newColour]
ELSE RETURN [One, layer, newColour]
END; -- Nine
Ten: Rule ~ BEGIN
InferenceStatus [layer, "Ten", "constant inheritance"];
newColour ← MakeConstant [colour];
IF (newColour # NIL) THEN RETURN [NIL, layer, newColour]
ELSE RETURN [NIL, layer, blackBlack]
END; -- Ten
Eleven: Rule ~ BEGIN
InferenceStatus [layer, "Eleven", "no colour"];
RETURN [NIL, layer, undefColour]
END; -- Eleven
Twelve: Rule ~ BEGIN
Look up in extended color map.
InferenceStatus [layer, "Twelve", "discriminable value"];
IF (currentColourMap = NIL) THEN RETURN [Nine, layer, newColour];
FOR i: CARDINAL IN [0 .. currentColourMap.size) DO
IF (currentColourMap[i].layers.GetSize = 1) THEN BEGIN
fetched: ATOM; found: BOOL; val: SymTab.Val;
[found, val] ← currentColourMap[i].layers.Fetch [Atom.GetPName [layer]];
fetched ← NARROW [val, ATOM];
IF found AND (fetched = layer) THEN BEGIN
newColour ← ColorFromRGB [currentColourMap[i].colour, currentColourMap[i].index];
IF (newColour = NIL) THEN ERROR;
RETURN [NIL, layer, newColour]
END-- found it
END-- entry is for a single layer
ENDLOOP;
RETURN [Nine, layer, newColour]
END; -- Twelve
SetLayerColourTable: PUBLIC PROC RETURNS [ok: BOOLTRUE] ~ BEGIN
The reason this prodedure is so complex is that at the time it was last revised, ChipNDale no longer allowed clients to get the contastant colours for the layers. An alternate source for these colours is the colour registry. Unfortunately, at the time of this writing, ChipNDale does not load the colour registry before it starts. Furthermore, ChipNdale duplicates the code and state of the colour registry, so that colour rendition depends on the load state, rendering useless Nectarine's loading of the colour registry. All this towaboo has cost a month and a half of wated work.
Original code in this procedure: Spread out hues & make "more subtractive" using the HSL colour model.
Infer undefined colour first, because it is the default of last resort if all rules fail.
r1 ← undefColour;
IF (undefColour = NIL) THEN undefColour ← Decide [Three, $UndefLayer, NIL];
IF traceColourInferences THEN InferenceResult [$UndefLayer, undefColour];
ok ← (r1 # NIL);
FOR i: CD.Layer IN CD.Layer DO
layer: ATOM ~ CD.LayerKey [i];
IF (layer = NIL) OR (layerColorTable[i] # NIL) THEN LOOP;
IF DoLineArt[] THEN BEGIN
IF UseProcessColors[] THEN SELECT layer FROM
$met => layerColorTable[i] ← cyanCMYK;
$met2 => layerColorTable[i] ← magentaCMYK;
$ndif, $pdif => layerColorTable[i] ← greenCMYK;
$pol => layerColorTable[i] ← redCMYK;
$cut, $cut2 => layerColorTable[i] ← blackCMYK;
ENDCASE => layerColorTable[i] ← NIL
ELSE SELECT layer FROM
$met =>  -- cyan separation for C28 blue
layerColorTable[i] ← cyanCMYK;
$met2 =>  -- yellow separation for M35/2 magenta
layerColorTable[i] ← yellowCMYK;
$ndif, $pdif => -- black separation for GT4 green
layerColorTable[i] ← IF UserProfile.Boolean ["Nectarine.ContinuousTone", FALSE] THEN greenCMYK ELSE blackCMYK;
$pol =>  -- magenta separation for RT6 red
layerColorTable[i] ← magentaCMYK;
$cut, $cut2 => -- cyan, black, & magenta separations for black
layerColorTable[i] ← greenishBlackCMYK;
ENDCASE => layerColorTable[i] ← NIL;
ok ← TRUE;LOOP
END;
IF SubColours[] THEN BEGIN
usedColour: Color;
layerNumberHack ← i;
usedColour ← IF obeyToChipNDale THEN Decide [One, layer, NIL] ELSE Decide [Twelve, layer, NIL];
IF traceColourInferences THEN InferenceResult [layer, usedColour];
IF (r1 = NIL) THEN ok ← FALSE;
IF (r2 # NIL) AND traceColourInferences THEN BEGIN
MessageWindow.Clear;
MessageWindow.Append [IO.PutFR ["Substituting color %g for %g\n", IO.rope [ColourName [usedColour]], IO.rope [ColourName [r2]]]]
END;
IF (usedColour = NIL) THEN break;
layerColorTable[i] ← usedColour
END
ELSE BEGIN
IF (layerColorTable[i] # NIL) THEN LOOP;
layerColorTable[i] ← CDColorsExtras.RegisteredColor [i ! CDColorsExtras.ColorNotRegistered => {layerColorTable[i] ← undefColour; ok ← FALSE; CONTINUE}];
IF (layerColorTable[i] = undefColour) THEN TerminalIO.PutF ["\nNo color is available from ChipNDale for layer %g\n",IO.atom [layer]];
IF (layerColorTable[i] = NIL) THEN break;
END
ENDLOOP
END; -- SetLayerColourTable
ResetLayerColourTable: PUBLIC PROC RETURNS [ok: BOOLTRUE] ~ BEGIN
Must be called whenever the user profile entry for the colour substitution changes.
IF NOT DoLineArt[] THEN UseSimpleColours;
FOR i: CD.Layer IN CD.Layer DO
layerColorTable[i] ← NIL; currentlyUsedLayers[i] ← FALSE
ENDLOOP;
blendedColourTable.Erase; ok ← SetLayerColourTable []
END; -- ResetLayerColourTable
Colouring intersecting layers: Colour blending stuff that used to be in NectarineImpl
Data is global
blendedColourTable: RefTab.Ref ~ RefTab.Create [magicNumber, Match, Hash];
EachCTEntry: TYPE ~ PROC [colour: Color, layers: LIST OF ATOM];
colourCacheSize: CARDINAL ~ 256;
ColourCacheRep: TYPE ~ ARRAY [1 .. colourCacheSize] OF Color ← ALL [NIL];
colourCache: REF ColourCacheRep ← NEW [ColourCacheRep];
ColourTile: PUBLIC PROC [old: Blend, l: CD.Layer] RETURNS [new: Blend] ~ BEGIN
Adds a new layer to the set of layers intersecting in a tile.
Sets up a blending record for a tile. Must be fast as a bullet.
key: BlendKey ~ NEW [Bitset ← old.flavours];
key[l] ← TRUE;
new ← NARROW [blendedColourTable.Fetch[key].val, Blend];
IF (new = NIL) THEN BEGIN
copy: Blend ← NEW [BlendRec ← [flavours: old.flavours]];
copy.count ← SUCC [old.count];
copy.flavours[l] ← TRUE; copy.used ← TRUE;
new ← copy;
IF NOT blendedColourTable.Insert [key, copy] THEN ERROR;
Record this layer as being currently used, for the usage of pre-blended colour from a colour map.
currentlyUsedLayers[l] ← TRUE
END
ELSE BEGIN
new.used ← TRUE;
IF NOT blendedColourTable.Replace [key, new] THEN ERROR
END
END; -- ColourTile
BlendColourForATile: RefTab.EachPairAction ~ BEGIN
Takes the layers covering a tile and blend an RBG-colour out of them.
[key: Key, val: Value] RETURNS [quit: BOOLEANFALSE]
components: Blend ~ NARROW [val];
n: REAL ← Float [components.count];
comp: PACKED ARRAY CD.Layer OF BOOLEAN ← components.flavours;
mix, v: RGB ← unColour;
IF (components.blend # NIL) THEN RETURN [FALSE]; -- caching across sessions
SELECT n FROM
0 => ERROR; -- should never have been allocated
1 => IF (currentColourMap = NIL) THEN BEGIN
i: CD.Layer ← 0;
WHILE NOT comp[i] DO i ← SUCC [i] ENDLOOP;
components.blend ← LayerColour [i];
IF (components.blend = NIL) THEN ERROR;
RETURN [FALSE]
END;
ENDCASE => NULL; -- the normal case
If there is more than a layer, I first look the blend up in the colour map if it exists. Otherwise a colour is blended from the layer colours.
IF (currentColourMap # NIL) THEN BEGIN
fetched: ATOM; val: SymTab.Val; found, allFound: BOOL;
Sequentially examine all entries of the colour map.
FOR i: CARDINAL IN [0 .. currentColourMap.size) DO
If the i-th entry in the colour map is for a different number of layers, then the entry does not apply.
IF (currentColourMap[i].layers.GetSize # components.count) THEN LOOP;
allFound ← TRUE;
FOR k: CD.Layer IN CD.Layer DO
IF comp[k] THEN BEGIN
layer: ATOM ~ CD.LayerKey [k];
[found, val] ← currentColourMap[i].layers.Fetch [Atom.GetPName [layer]];
fetched ← NARROW [val, ATOM];
IF (NOT found) OR (fetched # layer) THEN {allFound ← FALSE; LOOP}
END
ENDLOOP;
IF allFound THEN BEGIN
components.index ← currentColourMap[i].index;
components.blend ← ColorFromRGB [currentColourMap[i].colour, currentColourMap[i].index];
RETURN [FALSE]
END
ENDLOOP;
IF traceColourInferences THEN BEGIN
TerminalIO.PutRope ["\nThere is no colour for"];
FOR k: CD.Layer IN CD.Layer DO
IF comp[k] THEN TerminalIO.PutF [" %g", IO.atom [CD.LayerKey [k]]]
ENDLOOP;
TerminalIO.PutRope ["\n"]
END
END;
We are here either because there is no colour map or because the colour map did not contain a blend for the particular intersection combination.
BEGIN
poly, diff, met, met2, cut, cut2, well: CD.Layer ← 0;
IF (n = 1) THEN BEGIN
i: CD.Layer ← 0;
WHILE NOT comp[i] DO i ← SUCC [i] ENDLOOP;
components.blend ← LayerColour [i];
IF (components.blend = NIL) THEN ERROR;
RETURN [FALSE]
END;
Find exception layers.
FOR i: CD.Layer IN CD.Layer DO
IF comp[i] THEN SELECT CD.LayerKey [i] FROM
$pol => poly ← i;
$ndif, $pdif => diff ← i;
$met => met ← i;
$met2 => met2 ← i;
$nwel => well ← i;
$cut, $comment => cut ← i;
$cut2 => {cut ← i; cut2 ← i};
ENDCASE => NULL
ENDLOOP;
Cuts always win.
IF (cut # 0) THEN components.blend ← LayerColour [cut]
ELSE BEGIN-- Assume: all other colours have the same weight.
IF (poly # 0) AND (diff # 0) THEN BEGIN-- Handle gates.
Reinitialize mix by yellow and eliminate poly and diff. Since gates are very important, they are given double weight.
mix ← doubleYellowRGB;
comp[poly] ← comp[diff] ← FALSE
END;
IF (poly # 0) AND (met # 0) AND (diff = 0) THEN BEGIN
Handle metal over poly.
mix ← magentaRGB; n ← n - 1.0;
comp[poly] ← comp[met] ← FALSE
END;
FOR i: CD.Layer IN CD.Layer DO-- Compute mean colour.
IF comp[i] THEN BEGIN
IF CD.LayerKey[i] = $nwel THEN LOOP; -- ignore wells under material
v ← RGBFromColour [layerColorTable[i]];
mix.R ← mix.R + v.R; mix.G ← mix.G + v.G; mix.B ← mix.B + v.B
END
ENDLOOP;
IF (well # 0) THEN BEGIN-- make wells transparent
n ← n - 1.0
Wells are now ignored if they are under material. To change them back to being transparent, take out the LOOP statement from the above FOR loop and de-comment the following two lines:
mix.R ← mix.R - 5.0/7.0; mix.G ← mix.G - 5.0/7.0; n ← n - 5.0/7.0;
mix.B ← mix.B - (3.0/7.0 * 2.0/7.0) -- take out well lightener
END;
IF (met2 # 0) AND (well # 0) AND (n > 2) THEN BEGIN -- make metal-2 transparent
mix.R ← mix.R - 4.0/7.0; mix.B ← mix.B - 4.0/7.0; n ← n - 4.0/7.0
END;
mix.R ← mix.R / n; mix.G ← mix.G / n; mix.B ← mix.B / n;
components.blend ← ColorFromRGB [mix, 0];
components.index ← 1; components.used ← TRUE
END; -- not a contact
There are a lot of caches around, and there might be an order problem during laundry. If the following happens, you can probably abort and retry:
IF (components.blend = NIL) THEN break;
END;
RETURN [FALSE]
END; -- BlendColourForATile
BlendTileColours: PUBLIC PROC ~ BEGIN
The logarithm of the number of colours is two, that of the rectangles is six.
[] ← blendedColourTable.Pairs [BlendColourForATile];
END; -- BlendTileColours
Hash: RefTab.HashProc ~ BEGIN
PROC [key: Key] RETURNS [CARDINAL]
TRUSTED BEGIN
RETURN [Checksum.ComputeChecksum [0, SIZE [BlendKey], LOOPHOLE [key]]]
END
END; -- Hash
Match: RefTab.EqualProc ~ BEGIN
PROC [key1, key2: Key] RETURNS [BOOL]
k1: BlendKey ~ NARROW [key1]; k2: BlendKey ~ NARROW [key2];
RETURN [(k1^ = k2^)]
END; -- Match
NumberOfColours: PUBLIC PROC RETURNS [INT] ~ BEGIN
Number of different combinations of layers. This is the number of colours that the following procedure would declare in the Interpress master.
n: CARD ← 0;
IF DoLineArt[] THEN RETURN [4];
IF SubColours[] THEN BEGIN
FOR index: CARDINAL IN [1 .. colourCacheSize] DO
IF (colourCache[index] # NIL) THEN n ← n.SUCC
ENDLOOP;
RETURN [n]
END
ELSE BEGIN
FOR c: CD.Layer IN CD.Layer DO
IF (layerColorTable[c] # NIL) THEN n ← n.SUCC;
ENDLOOP;
RETURN [n]
END
RETURN [blendedColourTable.GetSize []]
END; -- NumberOfColours
DeclareColours: PUBLIC PROC [master: ImagerInterpress.Ref] ~ BEGIN
Declares colours in the preamble.
PerDiscriminableColour: RefTab.EachPairAction ~ BEGIN
blendRec: Blend ~ NARROW [val];
IF (blendRec.blend # NIL) AND (blendRec.index >= 0) THEN
master.DeclareColor [blendRec.blend];
RETURN [FALSE]
END; -- PerDiscriminableColour
master.DeclareColor [blackCMYK];
IF DoLineArt[] THEN BEGIN
master.DeclareColor [cyanCMYK]; master.DeclareColor [magentaCMYK];
master.DeclareColor [greenCMYK];
IF UseProcessColors[] THEN master.DeclareColor [redCMYK]
ELSE BEGIN
master.DeclareColor [yellowCMYK]; master.DeclareColor [greenishBlackCMYK]
END;
RETURN
END;
IF SubColours[] THEN FOR index: CARDINAL IN [1 .. colourCacheSize] DO
IF (colourCache[index] # NIL) THEN master.DeclareColor [colourCache[index]]
ENDLOOP
ELSE FOR c: CD.Layer IN CD.Layer DO
IF (layerColorTable[c] # NIL) THEN master.DeclareColor [layerColorTable[c]]
ENDLOOP
END; -- DeclareColours
IthColour: PUBLIC PROC [i: INT] RETURNS [Color] ~ BEGIN
Returns the i-th color.
RETURN [colourCache[i.ABS]]
END; -- IthColour
ListColourStatistics: PUBLIC PROC [numberOfTiles: CARD] ~ BEGIN
Lists the statistics on the colour table.
totalArea: REAL ← 0.0; -- It is the way it is because of numerical stability.
ComputeArea: RefTab.EachPairAction ~ BEGIN
data: Blend ~ NARROW [val];
totalArea ← totalArea + Float [data.area]
END; -- ComputeArea
ListEntry: RefTab.EachPairAction ~ BEGIN
data: Blend ~ NARROW [val];
cmyk: CMYK ~ CMYKFromRGB [RGBFromColour [data.blend]];
IF NOT data.used THEN RETURN;
IF totalArea = 0.0 THEN totalArea ← 1.0;
TerminalIO.PutF ["%g\t%g\t%g\t\t%g\t\t%g\t",
IO.real [cmyk.C],
IO.real [cmyk.M],
IO.real [cmyk.Y],
IO.real [cmyk.K],
IO.real [Float[data.area] / totalArea]];
FOR i: CD.Layer IN CD.Layer DO
IF data.flavours[i] THEN TerminalIO.PutF [" %g", IO.atom [CD.LayerKey[i]]]
ENDLOOP;
TerminalIO.PutF ["\t-- %g --\n", IO.rope [ColourName[data.blend]]]
END; -- ListEntry
TerminalIO.PutF ["Statistical data gathered by Nectarine:\n\tSize of color table: %g; number of tiles: %g\n\tColor (CMYK), relative area and layers\n", IO.int [blendedColourTable.GetSize[]], IO.int [numberOfTiles]];
[] ← blendedColourTable.Pairs [ComputeArea];
IF debug THEN BEGIN
[] ← blendedColourTable.Pairs [ListEntry];
TerminalIO.PutRope ["Colors with null area were intermediate.\n"]
END
END; -- ListColourStatistics
ResetColourStatistics: PUBLIC PROC ~ BEGIN
We initialize only the area so as to cache colour blendings across sessions.
ResetArea: RefTab.EachPairAction ~ {rec: Blend ~ NARROW [val]; rec.area ← 0};
[] ← blendedColourTable.Pairs [ResetArea]
END; -- ResetColourStatistics
Colouring intersecting layers: Colour blending with the MetaPalette
The problem here is that the ChipNDale layers are allocated when a technology is initilized. Therefore, the mapping from a layer key to a layer number is not known a priory. The trick is to keep the last extended color map global and to maintain a symbol table to map a layer into it's most recent number. Color blending must then be performed in two steps: first the last extended color map is re-enumerated with the current layer symbol table, then the old blending algorithm is applied.
1. Writing colour maps
ExpandBlendedColourTable: PROC [action: EachCTEntry] ~ BEGIN
Was exported by NectarineBackdoor.
DoEntry: RefTab.EachPairAction ~ BEGIN
data: Blend ~ NARROW [val]; layers: LIST OF ATOM;
FOR l: CD.Layer IN CD.Layer DO
IF data.flavours[l] THEN layers ← CONS [CD.LayerKey[l], layers];
ENDLOOP;
action [data.blend, layers]
END; -- DoEntry
[] ← blendedColourTable.Pairs [DoEntry];
END; -- ExpandBlendedColourTable
WriteMap: PUBLIC PROC [fileName: ROPE, msg: IO.STREAMNIL] ~ BEGIN
Dumps the table of blended colours into an extended color map file.
file: IO.STREAM; i: CARDINAL ← 0;
WriteColor: EachCTEntry ~ BEGIN
PROC [colour: Color, layers: LIST OF ATOM]
rgb: RGB ~ RGBFromColour [colour];
file.PutF ["%g\t%g\t%g\t%g",
IO.card [i],
IO.card [Round [255.0 * rgb.R]],
IO.card [Round [255.0 * rgb.G]],
IO.card [Round [255.0 * rgb.B]]];
FOR l: LIST OF ATOM ← layers, l.rest WHILE (l # NIL) DO
file.PutF [" %g", IO.atom [l.first]]
ENDLOOP;
file.PutRope ["\n"]; i ← i.SUCC
END; -- WriteColor
file ← FS.StreamOpen [fileName: fileName,
accessOptions: create,
keep: 3,
createByteCount: 5000,
fileType: FS.tText,
extendFileProc: NIL];
file.PutRope ["ColorMap\nonesAreWhite\nBitsPerPixel 8\n"];
ExpandBlendedColourTable [WriteColor];
IF (msg # NIL) THEN msg.PutF ["\nRename pippo ← %g\n", IO.rope [fileName]];
file.Close []; ImportantMessage [fileName]
END; -- WriteMap
WriteMapCommand: Commander.CommandProc ~ BEGIN
PROC [cmd: Handle] RETURNS [result: REFNIL, msg: ROPENIL]
fn: Args.Arg; cp: FS.ComponentPositions; pippo: BOOL;
name: ROPE ← "New.ColorMap";
lastWDir ← cmd.command.Substr [0, FS.ExpandName[cmd.command].cp.base.start-1];
IF (NumberOfColours[] = 0) THEN RETURN [$Failure, "Process some layout first (e.g. NectarineTest, VTIRules)."];
IF (Args.NArgs [cmd] # 0) THEN BEGIN
[fn] ← Args.ArgsGet [cmd, "-a%s" ! Args.Error => {argError ← reason; GOTO failure}];
IF fn.ok THEN name ← fn.rope
END;
[name, cp, pippo] ← FS.ExpandName [name, WDir []];
IF (cp.ext.length = 0) THEN name ← name.Cat [".ColorMap"];
WriteMap [name, cmd.out];
EXITS
failure => RETURN [$Failure, argError]
END; -- WriteMapCommand
2. Reading colour maps
ColourMapEntry: TYPE ~ RECORD [colour: RGB, index: INT, layers: SymTab.Ref];
ColourMapRep: TYPE ~ RECORD [SEQUENCE size: CARDINAL OF ColourMapEntry];
currentColourMap: REF ColourMapRep; -- cache
ReadMap: PUBLIC PROC [fileName: ROPE] ~ BEGIN
Loads the table of blended colours from an extended color map file. The file must have been written either by this module or by the MetaPalette; there is no consistency check.
rec, file: IO.STREAM; token: ROPE; firstToken: IO.TokenKind;
size, i: CARDINAL ← 0; rgb: RGB; cp: FS.ComponentPositions;
[fileName, cp, ] ← FS.ExpandName [fileName, WDir []];
IF (cp.ext.length = 0) THEN fileName ← fileName.Cat [".ColorMap"];
file ← FS.StreamOpen [fileName: fileName,
wDir: WDir [],
extendFileProc: NIL
! FS.Error => GOTO noFile];
DO
rec ← IO.RIS [file.GetLineRope [! IO.EndOfStream => {EXIT}; IO.Error => {break}], rec];
[tokenKind: firstToken, token: token] ← rec.GetCedarTokenRope [! IO.EndOfStream => {EXIT}];
IF ((firstToken = tokenDECIMAL) OR ((firstToken = tokenSINGLE) AND (token.Fetch [] = '-))) THEN size ← size.SUCC
ENDLOOP;
file.SetIndex [0]; currentColourMap ← NEW [ColourMapRep[size]]; blendedColourTable.Erase;
FOR i: CARDINAL IN [1 .. colourCacheSize] DO colourCache[i] ← NIL ENDLOOP;
DO
rec ← IO.RIS [file.GetLineRope [! IO.EndOfStream => {EXIT}], rec];
currentColourMap[i].index ← rec.GetInt [! IO.EndOfStream, IO.Error => {LOOP}]; -- header
[tokenKind: firstToken, token: token] ← rec.GetCedarTokenRope [! IO.EndOfStream => {LOOP}]; -- there are empty lines
IF ((firstToken = tokenSINGLE) AND (token.Fetch [] = '-)) THEN
[firstToken, token] ← rec.GetCedarTokenRope [];
IF NOT (firstToken = tokenDECIMAL) THEN LOOP;
rgb ← [Float [rec.GetCard[]] / 255.0,
Float [rec.GetCard[]] / 255.0,
Float [rec.GetCard[]] / 255.0];
IF (AlmostZero [rgb.R, -9]) AND (AlmostZero [rgb.G, -9]) AND (AlmostZero [rgb.B, -9]) THEN currentColourMap[i].colour ← [0, 0, 0]
currentColourMap[i].colour ← rgb;
IF (currentColourMap[i].index > 0) AND (currentColourMap[i].index <= colourCacheSize) THEN [] ← ColorFromRGB [rgb, currentColourMap[i].index];
currentColourMap[i].layers ← SymTab.Create [7];
DO-- find all layers to which this entry concerns
IF (rec.GetIndex < rec.GetLength) THEN BEGIN
layer: ATOM ← rec.GetAtom;
[] ← currentColourMap[i].layers.Store [key: Atom.GetPName [layer], val: layer]
END
ELSE EXIT
ENDLOOP;
IF file.EndOf [] THEN EXIT;
i ← i.SUCC; IF (i > size) THEN break
ENDLOOP;
file.Close; rec.Close;
[] ← ResetLayerColourTable []; BlendTileColours;
TerminalIO.PutRope [fileName.Cat[" loaded.\n"]]
EXITS
noFile => ImportantMessage [fileName.Cat[" not found. Check pseudo-servers."]]
END; -- ReadMap
ReadMapCommand: Commander.CommandProc ~ BEGIN
PROC [cmd: Handle] RETURNS [result: REFNIL, msg: ROPENIL]
fn: Args.Arg; name: ROPE ← "Discriminable.ColorMap";
lastWDir ← cmd.command.Substr [0, FS.ExpandName[cmd.command].cp.base.start-1];
IF (Args.NArgs [cmd] # 0) THEN BEGIN
[fn] ← Args.ArgsGet [cmd, "-a%s" ! Args.Error => {argError ← reason; GOTO failure}];
IF fn.ok THEN name ← fn.rope
END;
ReadMap [name];
EXITS
failure => RETURN [$Failure, argError]
END; -- ReadMapCommand
ReadMapCommand: Commander.CommandProc ~ BEGIN
PROC [cmd: Handle] RETURNS [result: REFNIL, msg: ROPENIL]
name: ROPE ← CommandTool.NextArgument [cmd];
lastWDir ← cmd.command.Substr [0, FS.ExpandName[cmd.command].cp.base.start-1];
IF name.IsEmpty THEN name ← "[DATools7.0]<Nectarine>Discriminable.ColorMap";
ReadMap [name]
END; -- ReadMapCommand
Varia
RgbKey: TYPE ~ REF RGB;
colourCache: RefTab.Ref ← RefTab.Create [59, SameColour, RgbHash];
RgbHash: PROC [k: RefTab.Key] RETURNS [CARDINAL] ~ BEGIN
PROC [Key] RETURNS [CARDINAL]
TRUSTED {RETURN [Checksum.ComputeChecksum [0, SIZE [RGB], LOOPHOLE [k]]]}
END; -- RgbHash
SameColour: PROC [key1, key2: RefTab.Key] RETURNS [BOOL] ~ BEGIN
RefTab.EqualProc
k1: RgbKey ~ NARROW [key1]; k2: RgbKey = NARROW [key2];
RETURN [(k1^ = k2^)]
END; -- SameColour
RGBFromColour: PROC [c: Color] RETURNS [rgb: RGB] ~ BEGIN
Assume that LayerColour had previously been called.
WITH c SELECT FROM
constant: ImagerColor.ConstantColor => rgb ← ImagerColorPrivate.RGBFromColor [constant];
ENDCASE => rgb ← unColour;
RETURN [rgb]
END; -- RGBFromColour
CMYKFromRGB: PROC [rgb: RGB] RETURNS [CMYK] ~ BEGIN
Converts from RGB to CMYK.
IF (AlmostZero [rgb.R, -9]) AND (AlmostZero [rgb.G, -9]) AND (AlmostZero [rgb.B, -9]) THEN RETURN [[0.0, 0.0, 0.0, 1.0]]
ELSE BEGIN
cmy: ImagerColorFns.CMY ~ ImagerColorFns.CMYFromRGB [rgb];
min: REAL ~ MIN [cmy.C, cmy.M, cmy.Y];
RETURN [[cmy.C - min, cmy.M - min, cmy.Y - min, min]]
END
END; -- CMYKFromRGB
ColorFromRGB: PROC [rgb: RGB, hint: INTEGER ← 0] RETURNS [Color] ~ BEGIN
colour: Color ← NIL;
IF (hint # 0) AND (hint <= colourCacheSize) THEN colour ← colourCache[hint.ABS];
IF (colour # NIL) THEN RETURN [colour];
IF UserProfile.Boolean [key: "Nectarine.ContinuousTone", default: FALSE] THEN
colour ← ImagerColor.ColorFromRGB [rgb]
ELSE colour ← IF (AlmostZero [rgb.R, -9]) AND (AlmostZero [rgb.G, -9]) AND (AlmostZero [rgb.B, -9]) THEN blackCMYK ELSE ColorFromCMYK [CMYKFromRGB [rgb]];
IF (hint # 0) AND (hint <= colourCacheSize) THEN colourCache[hint.ABS] ← colour;
RETURN [colour]
END; -- ColorFromRGB
SampleFromReal: PROC [r: REAL] RETURNS [CARDINAL] ~ BEGIN
RETURN [InlineRoundC [MIN[MAX[r, 0.0], 1.0] * 255]];
END; -- SampleFromReal
ColorFromCMYK: PROC [cmyk: CMYK] RETURNS [ImagerColor.OpConstantColor] ~ BEGIN
colour: ImagerColor.OpConstantColor ~ NEW [ImagerColor.ColorRep.constant.op[4]];
colour.colorOperator ← cmyk255;
colour.pixel[0] ← SampleFromReal [cmyk.C];
colour.pixel[1] ← SampleFromReal [cmyk.M];
colour.pixel[2] ← SampleFromReal [cmyk.Y];
colour.pixel[3] ← SampleFromReal [cmyk.K];
RETURN [colour];
END; -- ColorFromCMYK
ImportantMessage: PROC [msg: ROPE] ~ BEGIN
Writes a message in the ChipNDale terminal viewer and in the Message Window at the top of the LF screen and makes it blink.
TerminalIO.PutRope [msg]; TerminalIO.PutRope ["\n"];
MessageWindow.Clear []; MessageWindow.Append [msg]; MessageWindow.Blink []
END; -- ImportantMessage
doc: ROPE ~ "explains why a color is selected.\nUsage: NQuery CD.Layer\n\tExample: ← CMosB.met\n\t6\n\tNQuery 6";
QueryRule: Commander.CommandProc ~ BEGIN
PROC [cmd: Handle] RETURNS [result: REFNIL, msg: ROPENIL]
Explains why a color is selected.
layer: ROPE ~ CommandTool.NextArgument [cmd];
layerName: ATOM; layerColour: Color;
prevTraceValue: BOOL ~ traceColourInferences;
lastWDir ← cmd.command.Substr [0, FS.ExpandName[cmd.command].cp.base.start-1];
IF layer.IsEmpty THEN layerNumberHack ← CD.Layer.LAST
ELSE layerNumberHack ← IO.GetInt [IO.RIS [layer] ! RuntimeError.UNCAUGHT => {result ← $Failure; msg ← doc; CONTINUE}];
IF (result = $Failure) THEN RETURN;
layerName ← CD.LayerKey [layerNumberHack];
traceColourInferences ← TRUE;
IF (layerName = NIL) THEN layerColour ← Decide [Three, $UndefLayer, NIL]
ELSE layerColour ← IF obeyToChipNDale THEN Decide [One, layerName, NIL] ELSE Decide [Twelve, layerName, NIL];
InferenceResult [layerName, layerColour];
traceColourInferences ← prevTraceValue
END; -- QueryRule
ChangeColours: Commander.CommandProc ~ BEGIN
PROC [cmd: Handle] RETURNS [result: REFNIL, msg: ROPENIL]
Recrerates the colors used in the past.
a, b: Args.Arg; what: INTEGER ← 0;
colours: ROPE ← "[DATools7.0]<Nectarine>Discriminable.ColorMap";
lastWDir ← cmd.command.Substr [0, FS.ExpandName[cmd.command].cp.base.start-1];
IF (Args.NArgs [cmd] # 0) THEN BEGIN
[a, b] ← Args.ArgsGet [cmd, "-a[i-b[s" ! Args.Error => {argError ← reason; GOTO failure}];
IF a.ok THEN what ← a.int; IF b.ok THEN colours ← b.rope
END;
obeyToChipNDale ← FALSE; UseSimpleColours;
SELECT what FROM
0 => ReadMap [colours];
1 => obeyToChipNDale ← TRUE;
2 => NULL;
3 => UseSqueezedColours;
ENDCASE => ERROR;
IF (what # 0) THEN BEGIN
currentColourMap ← NIL; colourCache ← NEW [ColourCacheRep];
[] ← ResetLayerColourTable []
END;
EXITS
failure => RETURN [$Failure, argError]
END; -- ChangeColours
UseProcessColors: PROC RETURNS [BOOL] ~ INLINE BEGIN
RETURN [UserProfile.Boolean [key: "Nectarine.ProcessColors", default: TRUE]]
END; -- UseProcessColors
DoLineArt: PROC RETURNS [BOOL] ~ INLINE BEGIN
RETURN [UserProfile.Boolean [key: "Nectarine.LineArt", default: FALSE]]
END; -- DoLineArt
SubColours: PROC RETURNS [BOOL] ~ INLINE BEGIN
RETURN [UserProfile.Boolean [key: "Nectarine.SubstituteColors", default: colSubDef]]
END; -- SubColours
WDir: PROC RETURNS [wDir: ROPE] ~ BEGIN
Guarantees that the working directory is not the root.
wDir ← FSExtras.GetWDir [];
IF wDir.Equal ["[]<>"] AND (NOT lastWDir.IsEmpty) THEN wDir ← lastWDir;
IF wDir.Equal ["[]<>"] THEN wDir ← "[]<>7.0>DATools>"
END; -- WDir
Initial code to tune colours
document: TiogaAccess.Writer = TiogaAccess.Create [];
vanillaLook: TiogaAccess.Looks = ALL [FALSE];
vanillaChar: TiogaAccess.TiogaChar = [0, 0C, vanillaLook, $lead3, FALSE, FALSE, 0, NIL];
symbolLook, charLook, labelLook: TiogaAccess.Looks ← vanillaLook;
InitDocument: PROC ~ BEGIN
Causes document to be printed in landscape format. Must hang on root node.
rootCharacter: TiogaAccess.TiogaChar ← vanillaChar; -- 1st char written
rootCharacter.endOfNode ← TRUE;
rootCharacter.deltaLevel ← 1;
rootCharacter.propList ← Atom.PutPropOnList [propList: rootCharacter.propList,
prop: $Postfix,
val: TiogaAccess.GetInternalProp [$Postfix, "11 in pageWidth 8.5 in pageLength"]];
TiogaAccess.Put [document, rootCharacter]
END;
WriteChar: PROC [c: CHAR, l: TiogaAccess.Looks ← charLook] ~ BEGIN
tc: TiogaAccess.TiogaChar ← vanillaChar;
tc.char ← c; tc.looks ← l; TiogaAccess.Put [document, tc]
END; -- WriteChar
WriteTab: PROC [] ~ BEGIN
tab: CHAR = 'I - 100B;
WriteChar [tab]
END; -- WriteTab
PutRope: PROC [r: Rope.ROPE, l: TiogaAccess.Looks ← labelLook] ~ BEGIN
PutChar: Rope.ActionType ~ {WriteChar [c, l]};
[] ← Rope.Map [base: r, action: PutChar]
END; -- PutRope
WriteEOL: PROC ~ BEGIN
tc: TiogaAccess.TiogaChar ← vanillaChar;
tc.endOfNode ← TRUE; TiogaAccess.Put [document, tc]
END; -- WriteEOL
WriteNewPage: PROC ~ BEGIN
tc: TiogaAccess.TiogaChar ← vanillaChar;
tc.endOfNode ← TRUE; tc.format ← $pageBreak;
TiogaAccess.Put [document, tc]
END; -- WriteNewPage
WriteBigLead: PROC ~ BEGIN
tc: TiogaAccess.TiogaChar ← vanillaChar;
tc.endOfNode ← TRUE; tc.format ← $lead3;
TiogaAccess.Put [document, tc]; TiogaAccess.Put [document, tc]
END; -- WriteBigLead
WriteReal: PROC [n: REAL] ~ BEGIN
buffer: REF TEXTNEW [TEXT];
buffer ← Convert.AppendReal [to: buffer, from: n, precision: 3];
WriteTab [];
FOR i: NAT IN [0 .. buffer.length) DO WriteChar [buffer[i]] ENDLOOP
END; -- WriteReal
FindAllColours: Commander.CommandProc ~ BEGIN
Find all currently defined colours and write them into a Tioga document.
vt: Terminal.Virtual ~ Terminal.Current [];
prevTech: CD.Technology ← NIL;
InitDocument [];
FOR layer: CD.Layer IN CD.Layer DO
tech: CD.Technology ~ CD.LayerTechnology[layer];
key: ATOMCD.LayerKey [layer];
rgb: RGB ~ RGBFromColor [LayerColour [layer]];
hsl: HSL ~ HSLFromRGB [rgb];
IF (key # NIL) THEN BEGIN
IF (tech # prevTech) THEN BEGIN
prevTech ← tech; WriteBigLead [];
IF (tech # NIL) THEN PutRope [tech.name]
ELSE PutRope ["Unnamed Technology"];
WriteEOL []
END;
IF (tech # NIL) THEN {PutRope [tech.name, charLook]; WriteChar ['.]};
PutRope [Atom.GetPName [key]]; WriteTab [];
PutRope ["R, G, B: "];
WriteReal [rgb.R]; WriteReal [rgb.G]; WriteReal [rgb.B];
WriteTab []; PutRope ["H, S, L: "];
WriteReal [hsl.H]; WriteReal [hsl.S]; WriteReal [hsl.L];
WriteEOL []
END;
ENDLOOP;
IF (Terminal.GetColorBitmapState [vt] = displayed) THEN BEGIN
ir, ig, ib: Terminal.ColorValue;
norm: REAL ~ 1.0 / Float [LAST[Terminal.ColorValue]];
WriteBigLead [];
PutRope ["Contents of the ColorMap (r, g, b):"]; WriteEOL [];
FOR i: Terminal.ChannelValue IN Terminal.ChannelValue DO
[ir, ig, ib] ← Terminal.GetColor [vt, i];
WriteReal [Float[ir] * norm]; WriteReal [Float[ig] * norm]; WriteReal [Float[ib] * norm];
WriteEOL []
ENDLOOP
END;
TiogaAccess.WriteFile [document, "[]<>Users>Beretta.pa>CD>NectarineTune.tioga"];
TerminalIO.PutRope ["[]<>Users>Beretta.pa>CD>NectarineTune.tioga created.\n"]
END; -- FindAllColours
symbolLook ['l] ← TRUE; symbolLook ['m] ← TRUE;
labelLook ['l] ← TRUE; labelLook ['b] ← TRUE;
charLook ['l] ← TRUE;
Initialization
IF NOT DoLineArt[] THEN UseSimpleColours;
IF SubColours [] THEN ReadMap [UserProfile.Token ["Nectarine.Palette", "[DATools7.0]<Nectarine>Discriminable.ColorMap"]];
Commander.Register [key: "NQuery", proc: QueryRule, doc: doc];
Commander.Register [key: "NWriteColors", proc: WriteMapCommand, doc: "Writes the colors used by Nectarine in a file using the extended color map format.\nSwitch a: file name."];
Commander.Register [key: "NReadColors", proc: ReadMapCommand, doc: "Loads the table of blended colours from a extended color map file.\nSwitch a: file name."];
Commander.Register [key: "NOldColors", proc: ChangeColours, doc: "Do not use (recrerates the colors used in the past). Switch a:\n\t1: obey to ChipNDale\n\t2: simple colors\n\t3: compressed colors\nno switch: used balanced colors.\nSwitch b overrides the default extended color map."]
END.
gbb October 27, 1987 1:19:04 pm PST
Clean-up.
changes to: OPEN, black, blackBlack, blackRGB, UseSimpleColours, LayerColour, SetLayerColourTable, RGBFromColour, UseSimpleColours, Commander.
gbb November 2, 1987 3:46:08 pm PST
Changed to start inferring from rule 9 instead of 1.
changes to: Five, Eight, Nine, Eleven: new rule of last resort, SetLayerColourTable
gbb November 25, 1987 5:12:19 pm PST
Merged colour blending from NectarineImpl into NectarineHyperRegistryImpl and renamed it into NectarineColourImpl.
changes to: DIRECTORY, NectarineColorsImpl, IMPORTS, EXPORTS, OPEN, DeclareColours, PerColour (local of DeclareColours), EachCTEntry, NumberOfColours, ListColourStatistics, ResetColourStatistics
gbb November 27, 1987 5:05:47 pm PST
Allow for colours to be read from a colour map.
changes to: DIRECTORY, IMPORTS, OPEN, aqua, blackRGB, blackBlack, unColour, Rule, ResetLayerColourTable, blendedColourTable, EachCTEntry, ColourTile, BlendColourForATile, BlendTileColours, NumberOfColours, DeclareColours, ListColourStatistics, ResetColourStatistics, ExpandBlendedColourTable, DoEntry (local of ExpandBlendedColourTable), WriteMap, WriteColor (local of WriteMap), ColourMapEntry, ColourMapRep, currentColourMap, ReadMap, ReadMapCommand, Commander, Commander, Commander
gbb November 30, 1987 6:23:16 pm PST
Added Rule 12 to look first of all in the colour map.
changes to: layerColorTable, layerColorSymTable, Twelve, SetLayerColourTable, BlendColourForATile, ReadMap
gbb December 4, 1987 12:23:23 pm PST
Wells are now ignored if they are under material.
changes to: BlendColourForATile, ListEntry (local of ListColourStatistics)
gbb December 5, 1987 10:56:47 am PST
The balanced color map is loaded by default.
changes to: initialization.
gbb December 31, 1987 4:04:39 pm PST
New user profile option Nectarine.ContinuousTone: BOOLFALSE. Set to TRUE when separations are created by an electronic color scanner or by photographic halftoning.
changes to: LayerColour, InferenceResult, BlendColourForATile, ListEntry (local of ListColourStatistics), CMYKFromRGB, ColorFromRGB
gbb January 5, 1988 6:18:09 pm PST
Introduced line art.
changes to: LayerColour, SetLayerColourTable, SubColours, WDir, IF, IF
gbb January 9, 1988 4:00:46 pm PST
Re-implemented high resolution high speed halftoning.
changes to: LayerColour, Twelve, BlendColourForATile, ColourMapEntry, ReadMap.
gbb January 28, 1988 3:02:01 pm PST
More speed and less space by tuning cache hits.
changes to: unColour, cyanCMYK, magentaCMYK, yellowCMYK, blackCMYK, blueCMYK, greenCMYK, greenishBlackCMYK, greyCMYK, UseSimpleColours, UseSqueezedColours, Twelve, SetLayerColourTable, EachCTEntry, colourCacheSize, ColourCacheRep, colourCache, BlendColourForATile, DeclareColours, ColourMapEntry, ReadMap, RGBFromColour, ColorFromRGB
gbb February 8, 1988 1:04:22 pm PST
Changed UCR algorithm to produce smaller and faster Interpress masters.
changes to: DIRECTORY, IMPORTS, OPEN, NumberOfColours, CMYKFromRGB, ColorFromRGB
gbb February 10, 1988 9:56:47 pm PST
Added user profile option for color palette.
changes to: DIRECTORY, IF
gbb February 18, 1988 11:18:29 am PST
Added user profile option to generate line art to be printed with process colors.
changes to: blueCMYK, redCMYK, UseSimpleColours, SetLayerColourTable, UseProcessColors, DoLineArt
gbb October 14, 1988 11:45:48 am PDT
New color model operator using 8 instead of 10 bits per color.
changes to: DIRECTORY, cmyk, RGBFromColour, ColorFromRGB, SampleFromReal, ColorFromCMYK