ImagerStd8BitDisplayImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Frank Crow, April 19, 1984 3:39:45 pm PST
DIRECTORY
Imager    USING [Error, Context],
ImagerBasic   USING [DeviceRectangle, Color, ConstantColor],
ImagerDisplay  USING [DisplayClass, DisplayClassRep, DisplayData, CreateImagerClass],
ImagerStdColorDisplay USING [SetUpMapProc, CachedColorProc, Create, ApplyMask,
          LoadColorMap, LoadColorProc, DoUnderLock, ColorMapData,
          MoveOverlay,
          ColorSequence, PinPixelMap, ReleasePixelMap
         ],
ImagerMasks   USING [Mask],
ImagerPrivate  USING [Class, RegisterDevice],
ColorModels   USING [Calibration],
ConstantColors  USING [ColorToRGB, NameToColor,
         black, white, red, cyan, green, magenta, blue,
         yellow, orange, purple, brown, grey, darkGrey,
         veryLightGrey, lightGrey, veryDarkGrey],
Terminal    USING [ColorMode, Current, SetColor, Virtual],
Atom     USING [GetPropFromList],
Real     USING [FixC],
RealFns    USING [Power];
ImagerStd8BitDisplayImpl: CEDAR MONITOR
IMPORTS Imager, ImagerDisplay, ImagerPrivate, ConstantColors, Terminal, Real, Atom,
   ImagerStdColorDisplay, RealFns
~ BEGIN
This implements an 8-bit-per-pixel color-mapped display with no antialiasing.
DisplayClass: TYPE ~ ImagerDisplay.DisplayClass;
DisplayClassRep: TYPE ~ ImagerDisplay.DisplayClassRep;
DisplayData: TYPE ~ ImagerDisplay.DisplayData;
Color: TYPE ~ ImagerBasic.Color;
ConstantColor: TYPE ~ ImagerBasic.ConstantColor;
Mask: TYPE ~ ImagerMasks.Mask;
on: BOOLEAN ~ TRUE;
off: BOOLEAN ~ FALSE;
bitsPerPixel: NAT ~ 10;
Maximum summed-squares distance allowed in color matching. Determined by trial to allow hits with 2-level color names (eg. "vivid dark bluish green")
colorAccuracy: NAT ~ 8192;
vt: Terminal.Virtual;
mode: Terminal.ColorMode ~ [full: FALSE, bitsPerPixelChannelA: 8, bitsPerPixelChannelB: 2];
std8BitDisplayClass: ImagerDisplay.DisplayClass ~ NEW[ImagerDisplay.DisplayClassRep ← [
displayType: $Std8bpp,
viewUnitsPerPixel: 1,
Create: Create,
ApplyMask: ApplyMask,
DoUnderLock: ImagerStdColorDisplay.DoUnderLock
]];
ColorDisplayError: PUBLIC ERROR [reason: ATOM] ~ CODE;
Sqr: PROCEDURE [number: INT] RETURNS [INT] ~ INLINE { RETURN[number * number]; };
Create: PROC [displayClass: DisplayClass, creationData: REF]
RETURNS [displayData: DisplayData] ~ {
displayData ← ImagerStdColorDisplay.Create[
     vt, mode, displayClass, creationData, bitsPerPixel, SetUpColorMap];
};
ApplyMask: PROC [displayData: DisplayData, color: Color, mask: Mask,
      sTranslate, fTranslate: INTEGER] ~ {
ImagerStdColorDisplay.ApplyMask[displayData, color, mask, sTranslate, fTranslate, CacheColor];
};
SpecialOp: PROC[context: Imager.Context, op: ATOM, data: REF ← NIL] RETURNS[REF] ~ {
SELECT op FROM
$DisplayContext => { -- Pin a pixel map to the color display, replace what was there before.
ImagerStdColorDisplay.PinPixelMap[vt, NARROW[context.data, ImagerDisplay.DisplayData],
           mode ];
};
$UnDisplayContext => ImagerStdColorDisplay.ReleasePixelMap[vt,
            NARROW[context.data, ImagerDisplay.DisplayData]];
$MoveOverlay => ImagerStdColorDisplay.MoveOverlay[vt, data]; -- change DCB offsets
$LoadColorMap => ImagerStdColorDisplay.LoadColorMap[vt, data,
            NARROW[context.data, ImagerDisplay.DisplayData],
            LoadColor ]; -- reload color map and cache it
ENDCASE => Imager.Error[$UnimplementedSpecialOp];
RETURN[ NIL ];
};
SetUpColorMap: ImagerStdColorDisplay.SetUpMapProc ~ {
PROC[displayData: DisplayData]
color: ConstantColor ~ ConstantColors.NameToColor["Very Weak Light Green"];  -- pea green
colorData: REF ImagerStdColorDisplay.ColorMapData ← NARROW[displayData.cachedColorData];
colorMap: REF ImagerStdColorDisplay.ColorSequence ←
              NEW[ImagerStdColorDisplay.ColorSequence[256]];
FOR i: NAT IN [0..256) DO
colorMap[i] ← color;       -- set primary map pea green
ENDLOOP;
Set up 16 standard colors so that complements contrast
colorMap[0] ← ConstantColors.black;    colorMap[255] ← ConstantColors.white;
colorMap[1] ← ConstantColors.red;    colorMap[254] ← ConstantColors.cyan;
colorMap[2] ← ConstantColors.green;    colorMap[253] ← ConstantColors.magenta;
colorMap[3] ← ConstantColors.blue;    colorMap[252] ← ConstantColors.yellow;
colorMap[4] ← ConstantColors.orange;   colorMap[251] ← ConstantColors.purple;
colorMap[5] ← ConstantColors.brown;   colorMap[250] ← ConstantColors.grey;
colorMap[6] ← ConstantColors.darkGrey;  colorMap[249] ← ConstantColors.veryLightGrey;
colorMap[7] ← ConstantColors.lightGrey;  colorMap[248] ← ConstantColors.veryDarkGrey;
colorData.nextEntry ← 8;
colorData.map ← colorMap;        -- plug the map into the colorData record
IF Atom.GetPropFromList[displayData.props, $PixelMapStatus] = $Displayed THEN
FOR i: NAT IN [0..256) DO
LoadColor[colorData.map[i], colorData.colorCalibration, i];
ENDLOOP;
};
LoadColor: ImagerStdColorDisplay.LoadColorProc ~ {
PROC [ color: ConstantColor, colorCalibration: ColorModels.Calibration, mapEntry: [0..256) ]
r, g, b: REAL;
mr, mg, mb: [0..256);
[r, g, b] ← ConstantColors.ColorToRGB[color, colorCalibration];
r ← MIN[1.0, MAX[0.0, r]]; g ← MIN[1.0, MAX[0.0, g]]; b ← MIN[1.0, MAX[0.0, b]]; 
mr ← Real.FixC[255.0 * RealFns.Power[r, .43]]; 
mg ← Real.FixC[255.0 * RealFns.Power[g, .43]]; 
mb ← Real.FixC[255.0 * RealFns.Power[b, .43]];
vt.SetColor[ mapEntry, 3, 255, 255, 255];      -- set 4th map white
vt.SetColor[ mapEntry, 2, 0, 0, 0];        -- set 3rd map black
vt.SetColor[ mapEntry, 1, 255 - mr, 255 - mg, 255 - mb]; -- set inverted color in 2nd map
vt.SetColor[ mapEntry, 0, mr, mg, mb];
};
CacheColor: ImagerStdColorDisplay.CachedColorProc ~ {
PROC [displayData: DisplayData, color: Color]
Check for presence of color in this context's cache. If not there, enter in cache and set the color map if this context currently displayed
colorData: REF ImagerStdColorDisplay.ColorMapData ← NARROW[displayData.cachedColorData];
displayData.cachedColor ← NIL;
WITH color SELECT FROM
constantColor: ConstantColor => {
FOR i: NAT IN [0..colorData.map.length) DO IF color = colorData.map[i] THEN {
colorData.pixelValueList ← LIST[ i ];
displayData.cachedColor ← color;         -- already in colormap
};
ENDLOOP;
IF displayData.cachedColor = NIL THEN FOR i: NAT IN [0..colorData.map.length) DO
IF   constantColor.x = colorData.map[i].x   -- check if identical to a previous color
AND constantColor.y = colorData.map[i].y
AND constantColor.Y = colorData.map[i].Y
THEN {               -- already in colormap
colorData.pixelValueList ← LIST[ i ];
displayData.cachedColor ← color;
};
ENDLOOP;
Not in color map, enter it if there is room
IF (displayData.cachedColor = NIL) AND (colorData.nextEntry < 248) THEN {
colorData.pixelValueList ← LIST[ colorData.nextEntry ];
colorData.map[colorData.nextEntry] ← constantColor;
IF Atom.GetPropFromList[displayData.props, $PixelMapStatus] = $Displayed
THEN LoadColor[constantColor, colorData.colorCalibration, colorData.nextEntry];
colorData.nextEntry ← colorData.nextEntry + 1;
displayData.cachedColor ← color;
};
Failed completely, find closest color
IF displayData.cachedColor = NIL THEN {
minDist, minIndex: INT ← LAST[INT]; -- min. summed-squares distance in CIE space
FOR i: NAT IN [0..colorData.map.length) DO
dist: INT ← Sqr[constantColor.x - INT[colorData.map[i].x]]
   + Sqr[constantColor.y - INT[colorData.map[i].y]]
   + Sqr[constantColor.Y - INT[colorData.map[i].Y]];
IF dist < minDist THEN { minIndex ← i; minDist ← dist; };
ENDLOOP;
IF minDist < colorAccuracy THEN {
colorData.pixelValueList ← LIST[ minIndex ];
displayData.cachedColor ← color;
};
};
};
ENDCASE => Imager.Error[$UnsupportedColorType];
IF displayData.cachedColor = NIL THEN Imager.Error[$CantMatchColor];  -- sorry!
};
Init: PROC[] ~ {
std8BitImagerClass: ImagerPrivate.Class ~ ImagerDisplay.CreateImagerClass[std8BitDisplayClass];  -- pick up Imager class record
std8BitImagerClass.SpecialOp ← SpecialOp;     -- modify procedure bindings
ImagerPrivate.RegisterDevice[std8BitImagerClass];   -- register device class
vt ← Terminal.Current[];
};
Init[];
END.