<> <> <> <<>> 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, ColorToHSV, 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 <> 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; <> colorAccuracy: REAL _ .1; 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: REAL] RETURNS [REAL] ~ 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 $SetColorAccuracy => colorAccuracy _ NARROW[ NARROW[ data, LIST OF REF ANY].first , REF REAL]^; ENDCASE => Imager.Error[$UnimplementedSpecialOp]; RETURN[ NIL ]; }; SetUpColorMap: ImagerStdColorDisplay.SetUpMapProc ~ { <> 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; <> 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 ~ { <> <> mapIndex, quadrant: [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]]; mapIndex _ mapEntry MOD 256; quadrant _ mapEntry / 256; vt.SetColor[ mapIndex, quadrant, mr, mg, mb]; }; CacheColor: ImagerStdColorDisplay.CachedColorProc ~ { <> <> 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; <> 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; }; <> IF displayData.cachedColor = NIL THEN { minIndex: NAT; minDist: REAL _ 2.0; -- max value for min. summed-squares distance in CIE space h, s, v: REAL _ 0; [h, s, v] _ ConstantColors.ColorToHSV[constantColor, colorData.colorCalibration]; FOR i: NAT IN [0..colorData.map.length) DO mapHue, mapSat, mapVal: REAL; dist: REAL; [mapHue, mapSat, mapVal] _ ConstantColors.ColorToHSV[colorData.map[i], colorData.colorCalibration]; dist _ Sqr[h - mapHue] * 2 + Sqr[s - mapSat] + Sqr[v - mapVal]; IF dist < minDist THEN { minIndex _ i; minDist _ dist; }; ENDLOOP; IF minDist < colorAccuracy THEN { colorData.pixelValueList _ LIST[ minIndex ]; displayData.cachedColor _ color; } ELSE Imager.Error[$CantMatchColor]; }; }; ENDCASE => Imager.Error[$UnsupportedColorType]; }; 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.