NectarineTune.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Giordano Bruno Beretta, July 18, 1986 11:32:03 am PDT
gbb July 18, 1986 4:33:08 pm PDT
To tune-up Nectarine
DIRECTORY
Atom USING [GetPName, PutPropOnList],
CD USING [Layer, LayerKey, LayerTechnology, Technology],
CDColors USING [ColorTable, DisplayMode, DisplayType, globalColors],
Commander USING [CommandProc, Register],
Convert USING [AppendReal],
Imager USING [Color, ConstantColor],
ImagerColor USING [ColorFromRGB, HSL, HSLFromRGB, RGB],
ImagerColorPrivate USING [ComponentFromColor],
PrincOpsUtils USING [],
Real USING [Float],
Rope USING [ActionType, Map, ROPE],
Terminal USING [ChannelValue, ColorValue, Current, GetColor, GetColorBitmapState, Virtual],
TerminalIO USING [WriteRope],
TiogaAccess USING [Create, GetInternalProp, Looks, Put, TiogaChar, WriteFile, Writer];
NectarineTune: CEDAR PROGRAM
IMPORTS Atom, CD, CDColors, Commander, Convert, ImagerColor, ImagerColorPrivate, Real, Rope, Terminal, TerminalIO, TiogaAccess
~ BEGIN
OPEN Imager, ImagerColor, ImagerColorPrivate, Real;
break: SIGNAL = CODE; -- for debugging
Blend: TYPE ~ REF BlendRec;
BlendRec: TYPE ~ RECORD [count: CD.Layer ← 0,
flavours: PACKED ARRAY CD.Layer OF BOOLEAN ← ALL[FALSE]];
Color Blending
The Probably Controversial Code
BlendColours:
PROC [components: Blend]
RETURNS [blended: Color] ~
BEGIN
Takes the layers covering a tile and blend an RBG-colour out of them.
BlendRec: TYPE ~ RECORD [count: CD.Layer ← 0,
flavours: PACKED ARRAY CD.Layer OF BOOLEAN ← ALL[FALSE]];
n: INT ← components.count;
comp: PACKED ARRAY CD.Layer OF BOOLEAN ← components.flavours;
mix: RGB ← [0, 0, 0];
SELECT n
FROM
0 => ERROR; -- should never have been allocated
1 =>
BEGIN
i: CD.Layer ← 0;
WHILE NOT comp[i] DO i ← SUCC [i] ENDLOOP;
blended ← LayerColour [i]
END;
ENDCASE =>
BEGIN
poly, diff, well: CD.Layer ← 0;
hasCut: BOOL ← FALSE;
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;
$cut, $cut2 => hasCut ← TRUE;
$nwel => well ← i;
ENDCASE => NULL;
ENDLOOP;
Cuts always win.
IF hasCut THEN blended ← ColorFromRGB [[0, 0, 0]]
ELSE
BEGIN
Handle gates.
IF (poly # 0)
AND (diff # 0)
THEN
BEGIN
Reinitialize mix by yellow and eliminate poly and diff.
mix ← [1, 1, 0]; n ← PRED [n];
comp[poly] ← comp[diff] ← FALSE
END;
Compute mean colour.
FOR i:
CD.Layer
IN
CD.Layer
DO
Assume: all colours except black have the same weight.
IF comp[i]
THEN
BEGIN
v: ImagerColor.RGB ~ RGBFromColor [LayerColour[i]];
IF (i = well) AND (i # 0) THEN NULL; -- not yet decided
mix.R ← mix.R + v.R; mix.G ← mix.G + v.G; mix.B ← mix.B + v.B
END
ENDLOOP;
mix.R ← mix.R / n; mix.G ← mix.G / n; mix.B ← mix.B / n;
blended ← ColorFromRGB [mix]
END
END;
RETURN [blended]
END; -- BlendColours
Conversions
RGBFromColor:
PROC [c: Color]
RETURNS [rgb:
RGB] ~
INLINE
BEGIN
Assume that LayerColour had previously been called.
WITH c
SELECT FROM
constant: ConstantColor =>
BEGIN
rgb.R ← ComponentFromColor [constant, $Red];
rgb.G ← ComponentFromColor [constant, $Green];
rgb.B ← ComponentFromColor [constant, $Blue]
END;
ENDCASE => rgb ← [0.0, 0.0, 0.0];
RETURN [rgb]
END; -- RGBFromColor
LayerColour:
PROC [l:
CD.Layer]
RETURNS [Color] ~
BEGIN
Ensure that only one colour representation is used.
original: Color ~ CDColors.globalColors[bit8][normal].cols[l];
RETURN [original]
END; -- LayerColour
I/O
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
WriteRope:
PROC [r: Rope.
ROPE, l: TiogaAccess.Looks ← labelLook] ~
BEGIN
PutChar: Rope.ActionType ~ {WriteChar [c, l]};
[] ← Rope.Map [base: r, action: PutChar]
END; -- WriteRope
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 TEXT ← NEW [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
Main
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: ATOM ← CD.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 WriteRope [tech.name]
ELSE WriteRope ["Unnamed Technology"];
WriteEOL []
END;
IF (tech # NIL) THEN {WriteRope [tech.name, charLook]; WriteChar ['.]};
WriteRope [Atom.GetPName [key]]; WriteTab [];
WriteRope ["R, G, B: "];
WriteReal [rgb.R]; WriteReal [rgb.G]; WriteReal [rgb.B];
WriteTab []; WriteRope ["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 [];
WriteRope ["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.WriteRope ["[]<>Users>Beretta.pa>CD>NectarineTune.tioga created.\n"]
END; -- FindAllColours
Initialisations
symbolLook ['l] ← TRUE; symbolLook ['m] ← TRUE;
labelLook ['l] ← TRUE; labelLook ['b] ← TRUE;
charLook ['l] ← TRUE;
Commander.Register [key: "Nectar", proc: FindAllColours, doc: "To tune-up Nectarine"]
END.