ui/src/winvbt/WinScrnColorMap.m3


Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
                                                                           
       Created on Tue Jan 17 11:35:36 PST 1995 by najork                   

UNSAFE MODULE WinScrnColorMap;

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 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;

PROCEDURE Read (self: T; VAR res: ARRAY OF ScrnColorMap.Entry)
    RAISES {TrestleComm.Failure} =
  BEGIN
    <* ASSERT FALSE *>  (* not yet implemented *)
  END Read;

PROCEDURE Write (         self: T;
                 READONLY new : ARRAY OF ScrnColorMap.Entry)
    RAISES {ScrnColorMap.Failure, TrestleComm.Failure} =
  BEGIN
    <* ASSERT FALSE *>  (* not yet implemented *)
  END Write;

PROCEDURE NewCube (self: T; d: CARDINAL): ScrnColorMap.Cube
    RAISES {ScrnColorMap.Failure, TrestleComm.Failure} =
  BEGIN
    <* ASSERT FALSE *>  (* not yet implemented *)
  END NewCube;

PROCEDURE FreeCube (self: T; READONLY cb: ScrnColorMap.Cube)
    RAISES {TrestleComm.Failure} =
  BEGIN
    <* ASSERT FALSE *>  (* not yet implemented *)
  END FreeCube;
*************************************************************************** Oracle ***************************************************************************

TYPE
  Oracle = ScrnColorMap.Oracle BRANDED OBJECT
  OVERRIDES
    standard := Standard;
    list     := List;
    lookup   := Lookup;
    new      := NewMap;
  END;

PROCEDURE NewOracle (): ScrnColorMap.Oracle =
  BEGIN
    RETURN NEW (Oracle);
  END NewOracle;

PROCEDURE Standard (self: Oracle): ScrnColorMap.T
    RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN NEW (T);
  END Standard;
----------------------------------------------------------------------------- The spec in ScrnColormap.i3 states:

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 List (<*UNUSED*> self      : Oracle;
                <*UNUSED*> pat       : TEXT;
                <*UNUSED*> maxResults: CARDINAL): REF ARRAY OF TEXT
    RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN NIL
  END List;
----------------------------------------------------------------------------- The spec in ScrnColormap.i3 states:

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 ... -----------------------------------------------------------------------------

PROCEDURE Lookup (<*UNUSED*> self: Oracle;
                  <*UNUSED*> pat : TEXT): ScrnColorMap.T
    RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN NIL
  END Lookup;

PROCEDURE NewMap (           self     : Oracle;
                             nm       : TEXT;
                  <*UNUSED*> preLoaded: BOOLEAN): ScrnColorMap.T
    RAISES {TrestleComm.Failure} =
  BEGIN
    RETURN NEW (T);
  END NewMap;

PROCEDURE InstallDefaultPalette (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.