ImagerColorTestMain.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Authored by Frank Crow
Last Edited by: Crow, August 16, 1984 10:25:30 am PDT
DIRECTORY       
Basics     USING [BITSHIFT],
Rope     USING [ROPE],
Real     USING [FixI, FixC, RoundC],
RealFns    USING [Power],
IO      USING [PutRope, PutF, STREAM, int],
Terminal    USING [Virtual, Current, GetColor, SetColor, WaitForBWVerticalRetrace],
ViewerIO    USING [CreateViewerStreams],
Graphics    USING [Context],
QuickViewer   USING [DrawInViewer, BuildViewer],
ImagerBridge   USING [SetViewFromGraphicsContext],
Imager    USING [Context, Create, ClipRectangle, MaskRectangle, MaskVector,
         SetColor, Pair, SetXY, ShowCharacters, FONT, MakeFont, SetFont,
         SpecialOp],
ImagerBasic   USING [IntRectangle],
ImagerDisplay  USING [DisplayData],
ImagerStdColorDisplay USING [RGBSequence],
ImagerPixelMapsExtras USING [FillConstantTrap, DrawLine, DrawBltLine],
ConstantColors  USING [NameToColor, RGBToColor, ColorToName, HSLToColor],
ImagerColorAIS  USING [GetAISFile, Get3AISFiles, PutAISFile, Put3AISFiles, PutFastAISFile],
ColorNames   USING [HSLToRope];
ImagerColorTestMain: CEDAR PROGRAM
IMPORTS Imager, ConstantColors, ColorNames, IO, Terminal, ViewerIO, QuickViewer, ImagerPixelMapsExtras, Basics, Real, RealFns, ImagerColorAIS
ImagerBridge,
= BEGIN
displayContext: Imager.Context ← NIL;
contexts: ARRAY [0..4) OF Imager.Context ← ALL[NIL];
contextMax: NAT ← 4;
contextCount: NAT ← 0;
in, out: IO.STREAM;         -- I/O to log viewer
nullRectangle: ImagerBasic.IntRectangle ← [0, 0, 0, 0];
activeButton: ATOM;
NameColor: PROC [color: Rope.ROPE] ~ {
Imager.SetColor[displayContext, ConstantColors.NameToColor[color]];
};
RGBColor: PROC [r, g, b: REAL] ~ {
Imager.SetColor[displayContext, ConstantColors.RGBToColor[r, g, b]];
};
HSLToName: PROC [h, s, l: REAL] ~ {
name: Rope.ROPE;
name ← ConstantColors.ColorToName[ConstantColors.HSLToColor[h, s, l]];
IO.PutRope[out, name];
IO.PutF[out, "\n"];
};
HSLToLongName: PROC [h, s, l: REAL, levels: NAT] ~ {
name: Rope.ROPE;
name ← ColorNames.HSLToRope[h, s, l, levels];
IO.PutRope[out, name];
IO.PutF[out, "\n"];
};
Load8BitMap: PROC [] ~ {
start: REF NATNEW[NAT];
length: NAT ← 256;
entries: REF ImagerStdColorDisplay.RGBSequence ← NEW[
               ImagerStdColorDisplay.RGBSequence[length] ];
data: LIST OF REF ANYNIL;
start^ ← 1;
FOR i: NAT IN [0..40) DO              -- greyscale
entries[i + 216].r ← entries[i + 216].g ← entries[i + 216].b ← Real.RoundC[i*6.5];
ENDLOOP;
FOR i: NAT IN [0..216) DO          -- 6 x 6 x 6 color cube
entries[i].r ← Real.RoundC[42.5 * (i/36 + 1)];
entries[i].g ← Real.RoundC[42.5 * ((i/6) MOD 6 + 1)];
entries[i].b ← Real.RoundC[42.5 * (i MOD 6 + 1)];
ENDLOOP;
data ← CONS[start, data];
data ← CONS[entries, data];
[] ← Imager.SpecialOp[displayContext, $LoadColorMap, data];
};
Rotate8BitMap: PROC [duration: NAT] ~ {  -- rotates color map without moving zeroth entry
entries: REF ImagerStdColorDisplay.RGBSequence ← NEW[
               ImagerStdColorDisplay.RGBSequence[256] ];
vt: Terminal.VirtualTerminal.Current[];
vt.WaitForBWVerticalRetrace[]; -- await vt selection and top of scan (to control update rate)
FOR i: NAT IN [0..256) DO          -- 6 x 6 x 6 color cube
[entries[i].r, entries[i].g, entries[i].b] ← Terminal.GetColor[ vt, i];
ENDLOOP;
FOR i: NAT IN [0..duration*60) DO
color: RECORD[ r, g, b: [0..256) ] ← [ entries[1].r, entries[1].g, entries[1].b ];
FOR j: NAT IN [2..256) DO entries[j-1] ← entries[j]; ENDLOOP;
entries[255] ← [ color.r, color.g, color.b ];
FOR i: NAT IN [0..256) DO
Terminal.SetColor[ vt, i, 0, entries[i].r, entries[i].g, entries[i].b];
ENDLOOP;
ENDLOOP;
};
LoadGrey8BitMap: PROC [] ~ {
start: REF NATNEW[NAT];
length: NAT ← 256;
entries: REF ImagerStdColorDisplay.RGBSequence ← NEW[
               ImagerStdColorDisplay.RGBSequence[length] ];
data: LIST OF REF ANYNIL;
start^ ← 0;
FOR i: NAT IN [0..256) DO          -- greyscale
j: NAT ← Real.FixC[RealFns.Power[i/256.0, .43] * 256.0];
entries[i].r ← j;
entries[i].g ← j;
entries[i].b ← j;
ENDLOOP;
data ← CONS[start, data];
data ← CONS[entries, data];
[] ← Imager.SpecialOp[displayContext, $LoadColorMap, data];
};
Show8BitMap: PROC [] ~ {
displayData: ImagerDisplay.DisplayData ← NARROW[displayContext.data,
               ImagerDisplay.DisplayData];
firstBottom: INTEGER ← displayData[0].sSize + displayData[0].sMin - 80;
firstTop: INTEGER ← firstBottom + 9;
firstLeft: INTEGER ← (displayData[0].fSize - 320) / 2 + displayData[0].fMin;
firstRight: INTEGER ← firstLeft + 10;
FOR i: NAT IN [0..256) DO
top: NAT ← firstTop + 10 * (i / 32);
bottom: NAT ← firstBottom + 10 * (i / 32);
left: NAT ← firstLeft + 10 * (i MOD 32);
right: NAT ← firstRight + 10 * (i MOD 32);
FillTrap[top, bottom, left, left, right, right, i];
ENDLOOP;
};
Load8BitRampMap: PROC [r1, g1, b1, r2, g2, b2, exponent: REAL] ~ {
start: REF NATNEW[NAT];
length: NAT ← 256;
entries: REF ImagerStdColorDisplay.RGBSequence ← NEW[
               ImagerStdColorDisplay.RGBSequence[length] ];
data: LIST OF REF ANYNIL;
start^ ← 0;
r1 ← MAX[0.0, MIN[1.0, r1]]; r2 ← MAX[0.0, MIN[1.0, r2]];
g1 ← MAX[0.0, MIN[1.0, g1]]; g2 ← MAX[0.0, MIN[1.0, g2]];
b1 ← MAX[0.0, MIN[1.0, b1]]; b2 ← MAX[0.0, MIN[1.0, b2]];
FOR i: NAT IN [0..256) DO          -- linear ramp
jr: NAT ← Real.FixC[RealFns.Power[r1 + i/255.0 * (r2 - r1), exponent] * 255.0]; -- linearize
jg: NAT ← Real.FixC[RealFns.Power[g1 + i/255.0 * (g2 - g1), exponent] * 255.0];
jb: NAT ← Real.FixC[RealFns.Power[b1 + i/255.0 * (b2 - b1), exponent] * 255.0];
entries[i].r ← jr;
entries[i].g ← jg;
entries[i].b ← jb;
ENDLOOP;
data ← CONS[start, data];
data ← CONS[entries, data];
[] ← Imager.SpecialOp[displayContext, $LoadColorMap, data];
};
ClipRectangle: PROC [x, y, w, h: REAL] ~ {
Imager.ClipRectangle[displayContext, x, y, w, h];
NameColor["Black"];
FillRectangle[0.0, 0.0, .6, .45];    -- clear within clipper
};
FillRectangle: PROC [x, y, w, h: REAL] ~ {
Imager.MaskRectangle[displayContext, x, y, w, h];
};
FillTrap: PROC [top, bottom, leftTop, leftBot, rightTop, rightBot: INTEGER, color: NAT] ~ {
displayData: ImagerDisplay.DisplayData ← NARROW[displayContext.data,
               ImagerDisplay.DisplayData];
IF rightTop > displayData[0].fSize + displayData[0].fMin
THEN rightTop ← displayData[0].fSize + displayData[0].fMin;
IF rightBot > displayData[0].fSize + displayData[0].fMin
THEN rightTop ← displayData[0].fSize + displayData[0].fMin;
IF leftTop < displayData[0].fMin THEN rightTop ← displayData[0].fMin;
IF leftBot < displayData[0].fMin THEN rightTop ← displayData[0].fMin;
IF top > displayData[0].sSize + displayData[0].sMin
THEN top ← displayData[0].sSize + displayData[0].sMin;
IF bottom < displayData[0].sMin THEN bottom ← displayData[0].sMin;
ImagerPixelMapsExtras.FillConstantTrap[displayData[0],
         top, bottom, leftTop, leftBot, rightTop, rightBot, color];
};
DrawLine: PROC [pt1, pt2: Imager.Pair, width: REAL] ~ {
Imager.MaskVector[displayContext, pt1, pt2, width];
};
LineTest: PROC[color: CARDINAL, length, times: NAT] ~ {
ax, ay, bx, by, xOffset, yOffset: INTEGER;
displayData: ImagerDisplay.DisplayData ← NARROW[displayContext.data,
               ImagerDisplay.DisplayData];
logBitsPerPixel: NAT ← displayData[0].refRep.lgBitsPerPixel;
mapLength: NAT ← Basics.BITSHIFT[1, Basics.BITSHIFT[1, logBitsPerPixel]];
xMax: NAT ← displayData[0].fSize; yMax: NAT ← displayData[0].sSize;
IF length > yMax THEN length ← yMax;
xOffset ← (xMax - length) / 2; yOffset ← (yMax - length) / 2;
FOR i: NAT IN [0..times) DO
FOR j: NAT IN [0..length] DO
ax ← j + xOffset;    ay ← length + yOffset;
bx ← length + xOffset;  by ← length - j + yOffset;
color ← (color MOD mapLength) + 1;
ImagerPixelMapsExtras.DrawLine[displayData[0], [ax, ay], [bx, by], color];
ENDLOOP;
FOR j: NAT IN [0..length] DO
ax ← length + xOffset;  ay ← length - j + yOffset;
bx ← length - j + xOffset; by ← 0 + yOffset;
color ← (color MOD mapLength) + 1;
ImagerPixelMapsExtras.DrawLine[displayData[0], [ax, ay], [bx, by], color];
ENDLOOP;
FOR j: NAT IN [0..length] DO
ax ← length - j + xOffset; ay ← 0 + yOffset;
bx ← 0 + xOffset;    by ← j + yOffset;
color ← (color MOD mapLength) + 1;
ImagerPixelMapsExtras.DrawLine[displayData[0], [ax, ay], [bx, by], color];
ENDLOOP;
FOR j: NAT IN [0..length] DO
ax ← 0 + xOffset;    ay ← j + yOffset;
bx ← j + xOffset;    by ← length + yOffset;
color ← (color MOD mapLength) + 1;
ImagerPixelMapsExtras.DrawLine[displayData[0], [ax, ay], [bx, by], color];
ENDLOOP;
ENDLOOP;
};
BltLineTest: PROC[color: CARDINAL, length, times: NAT] ~ {
ax, ay, bx, by, xOffset, yOffset: INTEGER;
displayData: ImagerDisplay.DisplayData ← NARROW[displayContext.data,
               ImagerDisplay.DisplayData];
logBitsPerPixel: NAT ← displayData[0].refRep.lgBitsPerPixel;
mapLength: NAT ← Basics.BITSHIFT[1, Basics.BITSHIFT[1, logBitsPerPixel]];
xMax: NAT ← displayData[0].fSize; yMax: NAT ← displayData[0].sSize;
IF length > yMax THEN length ← yMax;
xOffset ← (xMax - length) / 2; yOffset ← (yMax - length) / 2;
FOR i: NAT IN [0..times) DO
FOR j: NAT IN [0..length] DO
ax ← j + xOffset;    ay ← length + yOffset;
bx ← length + xOffset;  by ← length - j + yOffset;
color ← (color MOD mapLength) + 1;
ImagerPixelMapsExtras.DrawBltLine[displayData[0], [ax, ay], [bx, by], color, [xor, null]];
ENDLOOP;
FOR j: NAT IN [0..length] DO
ax ← length + xOffset;  ay ← length - j + yOffset;
bx ← length - j + xOffset; by ← 0 + yOffset;
color ← (color MOD mapLength) + 1;
ImagerPixelMapsExtras.DrawBltLine[displayData[0], [ax, ay], [bx, by], color, [xor, null]];
ENDLOOP;
FOR j: NAT IN [0..length] DO
ax ← length - j + xOffset; ay ← 0 + yOffset;
bx ← 0 + xOffset;    by ← j + yOffset;
color ← (color MOD mapLength) + 1;
ImagerPixelMapsExtras.DrawBltLine[displayData[0], [ax, ay], [bx, by], color, [xor, null]];
ENDLOOP;
FOR j: NAT IN [0..length] DO
ax ← 0 + xOffset;    ay ← j + yOffset;
bx ← j + xOffset;    by ← length + yOffset;
color ← (color MOD mapLength) + 1;
ImagerPixelMapsExtras.DrawBltLine[displayData[0], [ax, ay], [bx, by], color, [xor, null]];
ENDLOOP;
ENDLOOP;
};
ShowRope: PROC[x, y: REAL, rope: Rope.ROPE, fontRope: Rope.ROPENIL, size: REAL ← .008] ~ {
font: Imager.FONT;
IF fontRope = NIL THEN fontRope ← "Xerox/Pressfonts/TimesRoman/MRR";
font ← Imager.MakeFont[fontRope, size];
Imager.SetFont[displayContext, font];
Imager.SetXY[displayContext, [x, y]];
Imager.ShowCharacters[displayContext, rope, ];
};
SetDevice: PROC[deviceType: ATOM, box, box2: ImagerBasic.IntRectangle, pinned: BOOLEAN] ~{
IF box = nullRectangle THEN displayContext ← Imager.Create[deviceType]
ELSE {
refBox: REF ImagerBasic.IntRectangle ← NEW[ImagerBasic.IntRectangle];
refBox2: REF ImagerBasic.IntRectangle ← NEW[ImagerBasic.IntRectangle];
refPinned: REF BOOLEANNEW[BOOLEAN ← pinned];  -- display this pixelmap if true
creationList: LIST OF REF ANYLIST[refBox, refPinned];
refBox.x ← box.x; refBox.y ← box.y; refBox.w ← box.w; refBox.h ← box.h;
IF box2.w > 0 AND box2.h > 0 THEN {
refBox2.x ← box2.x; refBox2.y ← box2.y; refBox2.w ← box2.w; refBox2.h ← box2.h;
creationList ← LIST[refBox, refPinned, refBox2];
};
displayContext ← Imager.Create[deviceType, creationList];
};
contexts[contextCount] ← displayContext;
contextCount ← contextCount + 1;
IF contextCount = contextMax THEN contextCount ← contextMax - 1;
NameColor["White"];
FillRectangle[0.0, 0.0, .6, .45];    -- clear screen
};
RecoverContext: PROC[contextNumber: NAT] ~ {
displayContext ← contexts[contextNumber];
};
PinMap: PROC[] ~ {
[] ← Imager.SpecialOp[displayContext, $DisplayContext, NIL];
};
UnPinMap: PROC[] ~ {
[] ← Imager.SpecialOp[displayContext, $UnDisplayContext, NIL];
};
PinOverlay: PROC[] ~ {
[] ← Imager.SpecialOp[displayContext, $OverlayContext, NIL];
};
MoveOverlayTo: PROC[x, y: NAT] ~ {
refX: REF INTEGERNEW[INTEGER ← x];
refY: REF INTEGERNEW[INTEGER ← y];
data: LIST OF REF ANYLIST[refX, refY];
[] ← Imager.SpecialOp[displayContext, $MoveOverlay, data];
};
SwitchBuffers: PROC[] ~ {
[] ← Imager.SpecialOp[displayContext, $SwitchBuffers, NIL];
};
GetAISFile: PUBLIC PROC[fileName: Rope.ROPE, xOffSet, yOffSet: INTEGER ← 0] ~ {
ImagerColorAIS.GetAISFile[displayContext, fileName, xOffSet, yOffSet];
};
Get3AISFiles: PUBLIC PROC[redFile, greenFile, blueFile: Rope.ROPE,
         xOffSet, yOffSet: INTEGER ← 0] ~ {
ImagerColorAIS.Get3AISFiles[displayContext, redFile, greenFile, blueFile, xOffSet, yOffSet];
};
PutAISFile: PUBLIC PROC[fileName: Rope.ROPE] ~ {
ImagerColorAIS.PutAISFile[displayContext, fileName];
};
PutFastAISFile: PUBLIC PROC[fileName: Rope.ROPE] ~ {
ImagerColorAIS.PutFastAISFile[displayContext, fileName];
};
Put3AISFiles: PUBLIC PROC[redFile, greenFile, blueFile: Rope.ROPE] ~ {
ImagerColorAIS.Put3AISFiles[displayContext, redFile, greenFile, blueFile];
};
DrawX: PROC[x, y, size: REAL] ~ {
DoDrawX: PROC [dc: Graphics.Context] ~ {
DrawLine[[x, y], [x+size, y+size], size/10.0];
DrawLine[[x+size, y], [x, y+size], size/10.0];
};
QuickViewer.DrawInViewer[DoDrawX];  -- ask the viewer procs to call you back
};
MenuHit: PROCEDURE[command: ATOM, x, y: REAL] = { 
SELECT command FROM
$Button => activeButton ← NIL;
$MoveDCB => { activeButton ← $MoveDCB; IO.PutF[out, "Button received\n"]; };
$Boxes, $Circles, $Exes, $Octagons => drawMode ← command;
$LeftButton, $LeftHeld => { pointList ← CONS[ [x, y], pointList];
         SELECT drawMode FROM
         $Exes  => DrawX[pointList.first, size, black];
         $Boxes => DrawBox[pointList.first, size, black];
         $Circles => DrawCircle[pointList.first, size, black];
         $Octagons => DrawOct[pointList.first, size, black];
           ENDCASE;
        };
$MiddleButton => DrawX[[x, y], size, black];
$RightButton => DrawCircle[[x, y], size, black];
$MiddleHeld  => DrawX[[x, y], size, white];
$RightHeld  => IF activeButton = $MoveDCB THEN {
displayData: ImagerDisplay.DisplayData ← NARROW[contexts[0].data,
               ImagerDisplay.DisplayData];
displayData[0].sOrigin ← 50 + Real.FixI[-y];
displayData[0].fOrigin ← 100 + Real.FixI[x];
displayContext ← contexts[0];
PinMap[];
};
$LeftHeld  => IF activeButton = $MoveDCB THEN {
displayData: ImagerDisplay.DisplayData ← NARROW[contexts[1].data,
               ImagerDisplay.DisplayData];
displayData[0].sOrigin ← 50 + Real.FixI[-y];
displayData[0].fOrigin ← 100 + Real.FixI[x];
displayContext ← contexts[1];
PinOverlay[];
IO.PutF[out, "x = %g, y = %g\n",
        IO.int[displayData[0].fOrigin], IO.int[displayData[0].sOrigin]];
};
ENDCASE;
};
ReDraw:  PROCEDURE [dc: Graphics.Context] = {
};
ShutDown: PROCEDURE [] = {
IO.PutF[out, "Imager Color Test over -- Bye\n"];        -- say goodbye
};
Init: PROCEDURE [] = {
QuickViewer.BuildViewer[LIST[$Button, $MoveDCB],
        ReDraw, ShutDown, MenuHit, "ImagerColorTest"];
[in, out] ← ViewerIO.CreateViewerStreams["ImagerColorTest.log"]; -- initialize i/o viewer
};
END.