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 ScrnColorMap, TrestleComm, VBT, VBTRep, WinDef, WinGDI, WinTrestle, WinUser; CONST False = 0; True = 1; TYPE T = ScrnColorMap.T BRANDED OBJECT OVERRIDES fromRGB := FromRGB; read := Read; write := Write; new := NewCube; free := FreeCube; END; PROCEDURE WinScrnColorMap FromRGB (self: T; rgb : ScrnColorMap.RGB; mode: ScrnColorMap.Mode ): ScrnColorMap.Pixel RAISES {ScrnColorMap.Failure, TrestleComm.Failure} = BEGIN (* This is an extremely naive implementation; it only utilizes the colors that come with the standard Windows palette. *) WITH r = ROUND (rgb.r * 255.0), g = ROUND (rgb.g * 255.0), b = ROUND (rgb.b * 255.0) DO RETURN WinGDI.PALETTERGB (r, g, b); END; END FromRGB; PROCEDURERead (self: T; VAR res: ARRAY OF ScrnColorMap.Entry) RAISES {TrestleComm.Failure} = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END Read; PROCEDUREWrite ( self: T; READONLY new : ARRAY OF ScrnColorMap.Entry) RAISES {ScrnColorMap.Failure, TrestleComm.Failure} = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END Write; PROCEDURENewCube (self: T; d: CARDINAL): ScrnColorMap.Cube RAISES {ScrnColorMap.Failure, TrestleComm.Failure} = BEGIN <* ASSERT FALSE *> (* not yet implemented *) END NewCube; PROCEDUREFreeCube (self: T; READONLY cb: ScrnColorMap.Cube) RAISES {TrestleComm.Failure} = 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 (self: Oracle): ScrnColorMap.T RAISES {TrestleComm.Failure} = BEGIN RETURN NEW (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 RAISES {TrestleComm.Failure} = 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 RAISES {TrestleComm.Failure} = BEGIN RETURN NIL END Lookup; PROCEDURENewMap ( self : Oracle; nm : TEXT; <*UNUSED*> preLoaded: BOOLEAN): ScrnColorMap.T RAISES {TrestleComm.Failure} = BEGIN RETURN NEW (T); END NewMap; PROCEDUREInstallDefaultPalette (v: VBT.T) = TYPE DefaultPalette = RECORD palVersion : WinDef.WORD := 16_300; (* Windows version number *) palNumEntries: WinDef.WORD := 216; (* = 6^3 *) palPalEntry : ARRAY [1 .. 216] OF WinGDI.PALETTEENTRY; END; VAR ur : WinTrestle.Child := v.upRef; pal : DefaultPalette; i := 1; numCols: INTEGER; status : WinDef.BOOL; oldPal : WinDef.HPALETTE; BEGIN (* Fill the colors of a 6x6x6 color cube into the "pal" record. *) FOR r := 0 TO 5 DO FOR g := 0 TO 5 DO FOR b := 0 TO 5 DO pal.palPalEntry[i] := WinGDI.PALETTEENTRY { peRed := r * 51, peGreen := g * 51, peBlue := b * 51, peFlags := WinGDI.PC_NOCOLLAPSE}; INC (i); END; END; END; (* Create a logical palette, select it into the device context, and realize it. *) ur.hpal := WinGDI.CreatePalette (LOOPHOLE (ADR(pal), WinGDI.LPLOGPALETTE)); <* ASSERT ur.hpal # NIL *> oldPal := WinGDI.SelectPalette (ur.hdc, ur.hpal, False); <* ASSERT oldPal # NIL *> numCols := WinGDI.RealizePalette (ur.hdc); <* ASSERT numCols # WinGDI.GDI_ERROR *> END InstallDefaultPalette; BEGIN END WinScrnColorMap.