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 NAT ← NEW[NAT];
length: NAT ← 256;
entries: REF ImagerStdColorDisplay.RGBSequence ← NEW[
ImagerStdColorDisplay.RGBSequence[length] ];
data: LIST OF REF ANY ← NIL;
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.Virtual ← Terminal.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 NAT ← NEW[NAT];
length: NAT ← 256;
entries: REF ImagerStdColorDisplay.RGBSequence ← NEW[
ImagerStdColorDisplay.RGBSequence[length] ];
data: LIST OF REF ANY ← NIL;
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 NAT ← NEW[NAT];
length: NAT ← 256;
entries: REF ImagerStdColorDisplay.RGBSequence ← NEW[
ImagerStdColorDisplay.RGBSequence[length] ];
data: LIST OF REF ANY ← NIL;
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.
ROPE ←
NIL, 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 BOOLEAN ← NEW[BOOLEAN ← pinned]; -- display this pixelmap if true
creationList: LIST OF REF ANY ← LIST[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 INTEGER ← NEW[INTEGER ← x];
refY: REF INTEGER ← NEW[INTEGER ← y];
data: LIST OF REF ANY ← LIST[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.