Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Tue Jan 17 11:35:36 PST 1995 by najork
UNSAFE MODULE*************************************************************************** Oracle ***************************************************************************; IMPORT Ctypes, Math, ScrnColorMap, WinDef, WinGDI, WinUser; CONST Gamma = 1.1D0; GammaInverse = 1.0D0 / Gamma; TYPE T = ScrnColorMap.T BRANDED OBJECT OVERRIDES fromRGB := FromRGB; read := Read; write := Write; new := NewCube; free := FreeCube; END; PROCEDURE WinScrnColorMap FromRGB (<*UNUSED*> self: T; rgb : ScrnColorMap.RGB; <*UNUSED*> mode: ScrnColorMap.Mode ): ScrnColorMap.Pixel (** RAISES {ScrnColorMap.Failure} **) = BEGIN (* This is an extremely naive implementation; it only utilizes the colors that come with the standard Windows palette. Using "WinGDI.RGB" causes dithering, and two shades of red in the solitaire cards. *) WITH r = ROUND (Math.pow(FLOAT(rgb.r,LONGREAL), GammaInverse) * 255.0D0), g = ROUND (Math.pow(FLOAT(rgb.g,LONGREAL), GammaInverse) * 255.0D0), b = ROUND (Math.pow(FLOAT(rgb.b,LONGREAL), GammaInverse) * 255.0D0) DO RETURN WinGDI.PALETTERGB (r, g, b); END; END FromRGB; PROCEDURERead (<*UNUSED*> self: T; <*UNUSED*> VAR res: ARRAY OF ScrnColorMap.Entry) = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END Read; PROCEDUREWrite (<*UNUSED*> self: T; <*UNUSED*> READONLY new : ARRAY OF ScrnColorMap.Entry) (** RAISES {ScrnColorMap.Failure} **) = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END Write; PROCEDURENewCube (<*UNUSED*> self: T; <*UNUSED*> d: CARDINAL): ScrnColorMap.Cube (** RAISES {ScrnColorMap.Failure} **) = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END NewCube; PROCEDUREFreeCube (<*UNUSED*> self: T; <*UNUSED*> READONLY cb: ScrnColorMap.Cube) = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END FreeCube;
TYPE Oracle = ScrnColorMap.Oracle BRANDED OBJECT OVERRIDES standard := Standard; list := List; lookup := Lookup; new := NewMap; END; PROCEDURE----------------------------------------------------------------------------- The spec in ScrnColormap.i3 states:NewOracle (): ScrnColorMap.Oracle = BEGIN RETURN NEW (Oracle); END NewOracle; PROCEDUREStandard (<*UNUSED*> self: Oracle): ScrnColorMap.T = VAR t := NEW (T); BEGIN t.depth := 8; t.readOnly := FALSE; t.ramp.base := 0; t.ramp.last [ScrnColorMap.Primary.Red] := 255; t.ramp.mult [ScrnColorMap.Primary.Red] := 16_000001; t.ramp.last [ScrnColorMap.Primary.Green] := 255; t.ramp.mult [ScrnColorMap.Primary.Green] := 16_000100; t.ramp.last [ScrnColorMap.Primary.Blue] := 255; t.ramp.mult [ScrnColorMap.Primary.Blue] := 16_010000; RETURN t; END Standard;
The method call st.cmap.list(pat, maxResults)
returns the names of
colormaps owned by st
that match the pattern pat
. The list of
results may be truncated to length maxResults
. A *
matches any
number of characters and a ?
matches any single character.
However, the X version (XScrnCmap.ColorMapList) always returns NIL. Since this seems to be adequate, we do the same ... -----------------------------------------------------------------------------
PROCEDURE----------------------------------------------------------------------------- The spec in ScrnColormap.i3 states:List (<*UNUSED*> self : Oracle; <*UNUSED*> pat : TEXT; <*UNUSED*> maxResults: CARDINAL): REF ARRAY OF TEXT = BEGIN RETURN NIL END List;
The method call st.cmap.lookup(name)
returns the colormap owned by
st
with the given name, or NIL
if no colormap has this name.
However, the X version (XScrnCmap.ColorMapLookup always returns NIL. Since this seems to be adequate, we do the same ... -----------------------------------------------------------------------------
PROCEDURELookup (<*UNUSED*> self: Oracle; <*UNUSED*> pat : TEXT): ScrnColorMap.T = BEGIN RETURN NIL END Lookup; PROCEDURENewMap (<*UNUSED*> self : Oracle; <*UNUSED*> nm : TEXT; <*UNUSED*> preLoaded: BOOLEAN): ScrnColorMap.T = BEGIN RETURN NEW (T); END NewMap; CONST MaxPalEntries = 1024; (*** for 8x8x8 cube ***** NPalEntries = 512; PalValues = ARRAY [0..7] OF [0..255] { 0, 36, 72, 108, 145, 182, 219, 255 }; *************************) (*** for 6x6x6 cube *****) NPalEntries = 216; PalValues = ARRAY [0..5] OF [0..255] { 0, 51, 102, 153, 204, 255 }; (*** for 5x5x5 cube ***** NPalEntries = 125; PalValues = ARRAY [0..4] OF [0..255] { 0, 64, 128, 192, 255 }; *************************) VAR defaultPal: WinDef.HPALETTE := NIL; defaultPalette: RECORD palVersion : WinDef.WORD; palNumEntries: WinDef.WORD; palPalEntry : ARRAY [1 .. MaxPalEntries] OF WinGDI.PALETTEENTRY; END; PROCEDUREDefaultPalette (): WinDef.HPALETTE = (* Create a logical palette *) VAR n_colors: INTEGER; BEGIN IF (defaultPal = NIL) THEN n_colors := NumDeviceColors (); IF (64 < n_colors) AND (n_colors <= MaxPalEntries) THEN MatchCurrentPalette (); ELSE InitDefaultPalette (); END; defaultPal := WinGDI.CreatePalette (LOOPHOLE (ADR(defaultPalette), WinGDI.LPLOGPALETTE)); <* ASSERT defaultPal # NIL *> END; RETURN defaultPal; END DefaultPalette; PROCEDUREInitDefaultPalette () = (* Fill the colors of a color cube into the "defaultPalette" record. *) VAR i := 1; BEGIN defaultPalette.palVersion := 16_300; (* Windows version number *) defaultPalette.palNumEntries := NPalEntries; WITH pe = defaultPalette.palPalEntry DO FOR r := FIRST (PalValues) TO LAST (PalValues) DO FOR g := FIRST (PalValues) TO LAST (PalValues) DO FOR b := FIRST (PalValues) TO LAST (PalValues) DO pe[i] := WinGDI.PALETTEENTRY { PalValues[r], PalValues[g], PalValues[b], WinGDI.PC_NOCOLLAPSE}; INC (i); END; END; END; END; END InitDefaultPalette; PROCEDUREMatchCurrentPalette () = VAR hwnd := WinUser.GetDesktopWindow (); hdc := WinUser.GetDC (hwnd); status : INTEGER; BEGIN defaultPalette.palVersion := 16_300; (* Windows version number *) defaultPalette.palNumEntries := 0; (* enumerate the solid pens to find the "real" colors that are available *) EVAL WinGDI.EnumObjects (hdc, WinGDI.OBJ_PEN, EnumColors, 0); status := WinUser.ReleaseDC (hwnd, hdc); <*ASSERT status # 0 *> IF defaultPalette.palNumEntries <= 0 THEN (* we didn't find any solid colors... *) InitDefaultPalette (); END; END MatchCurrentPalette; <*CALLBACK*> PROCEDUREEnumColors (a1: WinDef.LPVOID; <*UNUSED*>a2: WinDef.LPARAM): Ctypes.int = VAR pen : WinGDI.LPLOGPEN := a1; r,g,b: WinDef.BYTE; BEGIN IF (pen # NIL) AND (pen.lopnStyle = WinGDI.PS_SOLID) THEN WITH cnt = defaultPalette.palNumEntries, pe = defaultPalette.palPalEntry DO IF (cnt >= MaxPalEntries) THEN RETURN 0; (* bail out *) END; r := WinGDI.GetRValue (pen.lopnColor); g := WinGDI.GetGValue (pen.lopnColor); b := WinGDI.GetBValue (pen.lopnColor); INC (cnt); pe [cnt] := WinGDI.PALETTEENTRY {r, g, b, WinGDI.PC_NOCOLLAPSE}; END; END; RETURN 1; END EnumColors; PROCEDURENumDeviceColors (): INTEGER = VAR hwnd := WinUser.GetDesktopWindow (); hdc := WinUser.GetDC (hwnd); cnt := WinGDI.GetDeviceCaps (hdc, WinGDI.NUMCOLORS); status := WinUser.ReleaseDC (hwnd, hdc); BEGIN <* ASSERT status # 0 *> RETURN cnt; END NumDeviceColors; BEGIN END WinScrnColorMap.