Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Tue Jan 17 16:14:18 PST 1995 by najork
UNSAFE MODULE----------------------------------------------------------------------------- The spec in ScrnCursor.i3 states:; IMPORT Cursor, Point, Rect, ScrnCursor, ScrnPixmap, Text, TrestleComm, TrestleImpl, VBTClass, WinDef, WinGDI, WinNT, WinScreenType, WinScrnPixmap, WinUser; CONST False = 0; True = 1; TYPE T = ScrnCursor.T BRANDED OBJECT OVERRIDES localize := Localize; unload := Unload; END; WinScrnCursor
If cs
is a ScrnCursor.T
, then cs.id
is an identifier whose
interpretation depends on the screentype that owns cs
. The method
call cs.localize()
returns a raw cursor equal to the one on which
cs
is a handle, and the method call cs.unload()
causes cs
to become anonymous.
However, the X version of localize
(XScrnCrsr.CursorLocalize) always
raises Failure
, and the X version of unload
(XScrnCrsr.CursorUnregister)
is a no-op. For now, we do the same ...
-----------------------------------------------------------------------------
PROCEDURE***************************************************************************Localize (<*UNUSED*> self: T): ScrnCursor.Raw RAISES {ScrnCursor.Failure} = BEGIN RAISE ScrnCursor.Failure; END Localize; PROCEDUREUnload (<*UNUSED*> self: T) = BEGIN END Unload;
TYPE Oracle = ScrnCursor.Oracle BRANDED OBJECT st: WinScreenType.T; OVERRIDES load := Load; list := List; lookup := Lookup; builtIn := BuiltIn; END; PROCEDURE----------------------------------------------------------------------------- The spec in ScrnCursor.i3 states:NewOracle (st: WinScreenType.T): ScrnCursor.Oracle = BEGIN RETURN NEW (Oracle, st := st); END NewOracle; PROCEDURELoad ( self: Oracle; READONLY c : ScrnCursor.Raw; <* UNUSED *> nm : TEXT): ScrnCursor.T = VAR status : WinDef.BOOL; hcursor : WinDef.HCURSOR; iconInfo: WinUser.ICONINFO; col1 : WinDef.COLORREF; col2 : WinDef.COLORREF; col3 : WinDef.COLORREF; andRaw : ScrnPixmap.Raw; colRaw : ScrnPixmap.Raw; BEGIN IF c.plane1 = NIL OR c.plane2 = NIL OR c.plane1.depth # 1 OR c.plane2.depth # 1 OR Rect.IsEmpty (c.plane1.bounds) OR c.plane1.bounds # c.plane2.bounds THEN RETURN ScrnCursor.DontCare; END; WITH st = self.st DO LOCK st.trsl DO (* I assume that we have a color screen, and don't deal with with the "gray" and "bw" fields of "c.color1", ..., "c.color3" *) col1 := WinGDI.RGB (ROUND (255.0 * c.color1.r), ROUND (255.0 * c.color1.g), ROUND (255.0 * c.color1.b)); col2 := WinGDI.RGB (ROUND (255.0 * c.color2.r), ROUND (255.0 * c.color2.g), ROUND (255.0 * c.color2.b)); col3 := WinGDI.RGB (ROUND (255.0 * c.color3.r), ROUND (255.0 * c.color3.g), ROUND (255.0 * c.color3.b)); (* Construct the AND and XOR bitmaps *) andRaw := ScrnPixmap.NewRaw (1, c.plane1.bounds); colRaw := ScrnPixmap.NewRaw (32, c.plane1.bounds); FOR y := c.plane1.bounds.north TO c.plane1.bounds.south - 1 DO FOR x := c.plane1.bounds.west TO c.plane1.bounds.east - 1 DO WITH pt = Point.T {x, y}, p1 = c.plane1.get (pt), p2 = c.plane2.get (pt) DO IF p1 = 0 AND p2 = 0 THEN andRaw.set (pt, 1); colRaw.set (pt, 0); ELSIF p1 = 0 AND p2 = 1 THEN andRaw.set (pt, 0); colRaw.set (pt, col1); ELSIF p1 = 1 AND p2 = 0 THEN andRaw.set (pt, 0); colRaw.set (pt, col2); ELSIF p1 = 1 AND p2 = 1 THEN andRaw.set (pt, 0); colRaw.set (pt, col3); ELSE <* ASSERT FALSE *> END; END; END; END; WITH hbmMask = WinScrnPixmap.PixmapFromRaw(st, andRaw), hbmColor = WinScrnPixmap.PixmapFromRaw(st, colRaw) DO iconInfo := WinUser.ICONINFO { fIcon := False, xHotspot := c.hotspot.h, yHotspot := c.hotspot.v, hbmMask := hbmMask, hbmColor := hbmColor}; hcursor := WinUser.CreateIconIndirect (ADR (iconInfo)); <* ASSERT hcursor # NIL *> status := WinGDI.DeleteObject (hbmMask); <* ASSERT status = True *> status := WinGDI.DeleteObject (hbmColor); <* ASSERT status = True *> RETURN NEW (T, id := LOOPHOLE (hcursor, INTEGER)); END; END; END; END Load;
The method call st.cursor.list(pat, maxResults)
returns the names
of all cursors 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 a single character.
However, the X version (XScrnCrsr.CursorList) always returns NIL. Since this seems to be adequate, we do the same ... -----------------------------------------------------------------------------
PROCEDUREList (<* UNUSED *> self : Oracle; <* UNUSED *> pat : TEXT; <* UNUSED *> maxResults: CARDINAL): REF ARRAY OF TEXT = BEGIN RETURN NIL END List; TYPE NamedCursor = RECORD name: TEXT; crsr: WinNT.LPCTSTR; END; VAR cursors := ARRAY [1 .. 14] OF NamedCursor { NamedCursor {"ARROW", WinUser.IDC_ARROW}, NamedCursor {"IBEAM", WinUser.IDC_IBEAM}, NamedCursor {"WAIT", WinUser.IDC_WAIT}, NamedCursor {"CROSS", WinUser.IDC_CROSS}, NamedCursor {"UPARROW", WinUser.IDC_UPARROW}, NamedCursor {"SIZE", WinUser.IDC_SIZE}, NamedCursor {"ICON", WinUser.IDC_ICON}, NamedCursor {"SIZENWSE", WinUser.IDC_SIZENWSE}, NamedCursor {"SIZENESW", WinUser.IDC_SIZENESW}, NamedCursor {"SIZEWE", WinUser.IDC_SIZEWE}, NamedCursor {"SIZENS", WinUser.IDC_SIZENS}, NamedCursor {"SIZEALL", WinUser.IDC_SIZEALL}, NamedCursor {"NO", WinUser.IDC_NO}, NamedCursor {"APPSTARTING", WinUser.IDC_APPSTARTING}}; PROCEDURELookup (self: Oracle; name: TEXT): ScrnCursor.T RAISES {TrestleComm.Failure} = BEGIN FOR i := FIRST (cursors) TO LAST (cursors) DO IF Text.Equal (name, cursors[i].name) THEN LOCK self.st.trsl DO RETURN LoadCursor (cursors[i].crsr); END; END; END; RETURN NIL; END Lookup; PROCEDUREBuiltIn (self: Oracle; cs: Cursor.Predefined): ScrnCursor.T = BEGIN TRY LOCK self.st.trsl DO CASE cs OF | Cursor.DontCare.cs => RETURN ScrnCursor.DontCare; | Cursor.TextPointer.cs => RETURN LoadCursor (WinUser.IDC_ARROW); | Cursor.NotReady.cs => RETURN LoadCursor (WinUser.IDC_WAIT); END; END; EXCEPT TrestleComm.Failure => RETURN ScrnCursor.DontCare; END; END BuiltIn; PROCEDURELoadCursor (lpszCursor: WinNT.LPCTSTR): ScrnCursor.T RAISES {TrestleComm.Failure} = BEGIN WITH hcursor = WinUser.LoadCursor (NIL, lpszCursor) DO IF hcursor # NIL THEN RETURN NEW (T, id := LOOPHOLE(hcursor, INTEGER)); ELSE RAISE TrestleComm.Failure; END; END; END LoadCursor; PROCEDURESetCursor (cs: ScrnCursor.T) = VAR hcursor: WinDef.HCURSOR; BEGIN (* In xvbt, a value of "ScrnCursor.DontCare" means that the cursor is "undefined", that is, its appearance is the same as that of the parent window (which is always the root window, since xvbt does not build up trees of X windows. For simplicity, I assume that the cursor of the desktop window is always "IDC_ARROW". So, undefining the cursor allociated with a "Child" means setting it to "IDC_ARROW". *) IF cs = ScrnCursor.DontCare THEN hcursor := WinUser.LoadCursor (NIL, WinUser.IDC_ARROW); ELSE hcursor := LOOPHOLE (cs.id, ADDRESS); END; EVAL WinUser.SetCursor (hcursor); END SetCursor; BEGIN END WinScrnCursor.