Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Tue Jan 17 16:51:19 PST 1995 by najork
UNSAFE MODULE----------------------------------------------------------------------------- The spec in ScrnPixmap.i3 states:; IMPORT Axis, Palette, Pixmap, Point, Rect, ScrnPixmap, TrestleImpl, VBTRep, WinDef, WinGDI, WinScreenType, WinScreenTypePrivate, WinUser; IMPORT Ctypes, Fmt, IO; CONST True = 1; <* PRAGMA LL *> EXCEPTION FatalError; <* FATAL FatalError *> TYPE T = ScrnPixmap.T BRANDED OBJECT st: WinScreenType.T; OVERRIDES localize := Localize; unload := Unload; free := Free; END; PROCEDURE WinScrnPixmap Localize (self: T; READONLY rect: Rect.T): ScrnPixmap.Raw = VAR id := self.id; st := self.st; hwnd : WinDef.HWND; hdc : WinDef.HDC; hbmp : WinDef.HBITMAP; status: INTEGER; res : ScrnPixmap.Raw; bmi : WinGDI.BITMAPINFO; pixels: REF ARRAY OF WinGDI.RGBQUAD; k : INTEGER; r : Rect.T; BEGIN IF id = SolidPixmap THEN RETURN rawSolid END; r := Rect.Meet(rect, self.bounds); IF Rect.IsEmpty (r) THEN RETURN NIL END; IF id < 0 THEN id := SolidPixmap - id; st := st.bits; END; LOCK st.trsl DO WITH pmr = st.pmtable[id] DO <* ASSERT pmr.domain = self.bounds *> (* ... if that's true, can we do away with pmr.domain? *) hbmp := pmr.hbmp; END; END; (* Examine the depth *) hwnd := WinUser.GetDesktopWindow (); <* ASSERT hwnd # NIL *> hdc := WinUser.GetDC (hwnd); <* ASSERT hdc # NIL *> WITH height = Rect.VerSize (self.bounds), width = Rect.HorSize (self.bounds), bmih = bmi.bmiHeader DO bmi.bmiHeader.biSize := BYTESIZE(WinGDI.BITMAPINFOHEADER); bmi.bmiHeader.biBitCount := 0; status := WinGDI.GetDIBits (hdc, hbmp, 0, (* start at scan line 0 *) height, (* copy "height" lines *) NIL, (* ... that is, don't copy *) ADR (bmi), (* ... just fill in bmi *) WinGDI.DIB_RGB_COLORS); <* ASSERT status = True *> <* ASSERT bmih.biWidth = width *> <* ASSERT bmih.biHeight = height *> IF bmih.biBitCount = 1 THEN res := ScrnPixmap.NewRaw (1, r); ELSE res := ScrnPixmap.NewRaw (BITSIZE (WinDef.COLORREF), r); END; bmih.biBitCount := 32; bmih.biCompression := WinGDI.BI_RGB; pixels := NEW (REF ARRAY OF WinGDI.RGBQUAD, height * width); status := WinGDI.GetDIBits (hdc, hbmp, 0, (* start at scan line 0 *) height, (* copy "height" lines *) ADR(pixels[0]),(* into "pixels" *) ADR (bmi), WinGDI.DIB_RGB_COLORS); <* ASSERT status = height *> <* ASSERT bmih.biBitCount = BITSIZE (WinDef.COLORREF) *> <* ASSERT bmih.biWidth = Rect.HorSize (self.bounds) *> <* ASSERT bmih.biHeight = Rect.VerSize (self.bounds) *> END; (* Copy "pixels" into "res" *) k := 0; FOR v := self.bounds.south - 1 TO self.bounds.north BY -1 DO FOR h := self.bounds.west TO self.bounds.east - 1 DO WITH pt = Point.T {h, v} DO IF Rect.Member (pt, r) THEN IF res.depth = 1 THEN IF pixels[k] = WinGDI.RGBQUAD {0, 0, 0, 0} THEN res.set (pt, 0); ELSE res.set (pt, 1); END; ELSE WITH p = pixels[k], col = WinGDI.RGB (p.rgbRed, p.rgbGreen, p.rgbBlue) DO res.set (pt, col); END; END; END; INC (k); END; END; END; status := WinUser.ReleaseDC (hwnd, hdc); <* ASSERT status = True *> RETURN res; END Localize;
The method call pm.unload()
causes pm
to become anonymous.
The X version (XScrnPxmp.Unregister) doesn't do anything. So, we do the same. -----------------------------------------------------------------------------
PROCEDURE***************************************************************************Unload (<*UNUSED*> self: T) = BEGIN (* do nothing *) END Unload; PROCEDUREFree (self: T) = VAR id := self.id; st := self.st; status : WinDef.BOOL; BEGIN IF id = SolidPixmap THEN RETURN; END; IF id < 0 THEN id := SolidPixmap - id; st := st.bits; END; LOCK st.trsl DO WITH z = st.pmtable[id] DO z.domain.north := st.pmfree; st.pmfree := id; IF z.hbmp # NIL THEN status := WinGDI.DeleteObject (z.hbmp); <* ASSERT status = True *> z.hbmp := NIL; END; END; END; END Free;
TYPE Oracle = ScrnPixmap.Oracle BRANDED OBJECT st: WinScreenType.T; OVERRIDES load := Load; list := List; lookup := Lookup; builtIn := BuiltIn; END; PROCEDURE----------------------------------------------------------------------------- The spec in ScrnPixmap.i3 states:Load ( self: Oracle; READONLY pm : ScrnPixmap.Raw; <*UNUSED*> nm : TEXT := NIL): ScrnPixmap.T = BEGIN WITH st = self.st DO LOCK st.trsl DO IF pm.depth # 1 AND pm.depth # st.depth THEN RAISE FatalError; END; RETURN NewPixmap (st, PixmapFromRaw (st, pm), pm.bounds, pm.depth); END; END; END Load; PROCEDUREDumpPixmap (pm: ScrnPixmap.T) = BEGIN WITH st = NARROW (pm, T).st DO IO.Put ("WinPixmap.T {\n"); IO.Put (" id := " & Fmt.Int (pm.id) & "\n"); IO.Put (" depth := " & Fmt.Int (pm.depth) & "\n"); IO.Put (" bounds := " & Fmt_Rect(pm.bounds) & "\n"); IF st = st.bits THEN IO.Put (" st := a monochrome screen type\n"); ELSE IO.Put (" st := a color screen type\n"); END; END; END DumpPixmap; PROCEDUREDumpPixmapRecord (pmr: PixmapRecord) = VAR bitmap: WinGDI.BITMAP; sz : Ctypes.int; BEGIN IO.Put ("WinScrnPixmap.PixmapRecord{\n"); IO.Put (" hbmp := " & Fmt_Addr (pmr.hbmp) & "\n"); IO.Put (" domain := " & Fmt_Rect (pmr.domain) & "\n"); IO.Put ("}\n"); sz := WinGDI.GetObject(pmr.hbmp, BYTESIZE (bitmap), ADR(bitmap)); IF sz = 0 THEN IO.Put ("could not get dimensions of bitmap!\n"); ELSE IO.Put ("bmWidth = " & Fmt.Int(bitmap.bmWidth)); IO.Put ("bmHeight = " & Fmt.Int(bitmap.bmHeight)); END; END DumpPixmapRecord; PROCEDUREDumpRaw (pm: ScrnPixmap.Raw) = VAR dom := pm.bounds; BEGIN IO.Put ("ScrnPixmap.Raw: \n"); IO.Put (" depth = " & Fmt.Int (pm.depth) & "\n"); IO.Put (" bounds = {" & Fmt_Rect (dom) & "\n"); IO.Put (" bitsPerPixel = " & Fmt.Int (pm.bitsPerPixel) & "\n"); IO.Put (" wordsPerRow = " & Fmt.Int (pm.wordsPerRow) & "\n"); IO.Put (" One row of pixels from the middle:\n"); IF pm.pixelOrder = ScrnPixmap.ByteOrder.MSBFirst THEN IO.Put (" byteOrder = MSBFirst\n"); ELSE IO.Put (" byteOrder = LSBFirst\n"); END; IO.Put (" westRounded = " & Fmt.Int (pm.westRounded) & "\n"); FOR v := dom.north TO MIN (dom.north + 19, dom.south - 1) DO IO.Put(" row " & Fmt.Pad (Fmt.Int(v),2) & ": "); FOR h := dom.west TO MIN (dom.west + 19, dom.east - 1) DO IO.Put(Fmt.Pad(Fmt.Int(pm.get(Point.T{h,v}), base := 16),2,'0') & " "); END; IO.Put ("\n"); END; END DumpRaw; PROCEDUREFmt_Rect (r: Rect.T): TEXT = BEGIN RETURN "Rect.T{" & Fmt.Int(r.west) & "," & Fmt.Int(r.east) & "," & Fmt.Int(r.north) & "," & Fmt.Int(r.south) & "}"; END Fmt_Rect; PROCEDUREFmt_Addr (a: ADDRESS): TEXT = BEGIN WITH i = LOOPHOLE (a, INTEGER) DO RETURN Fmt.Int (i, base := 16); END; END Fmt_Addr;
The method call st.pixmap.list(pat, maxResults)
returns the names
of all pixmaps 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.
The X version (XScrnPxmp.PixmapList), however, simply always returns NIL. For now, I do the same ... -----------------------------------------------------------------------------
PROCEDURE----------------------------------------------------------------------------- The spec in ScrnPixmap.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.pixmap.lookup(name)
return the pixmap with the
given name, or NIL
if no pixmap has this name.
The X version (XScrnPxmp.PixmapLookup), however, simply always returns NIL. For now, I do the same ... -----------------------------------------------------------------------------
PROCEDURE*************************************************************************** Exported procedures ***************************************************************************Lookup (<*UNUSED*> self: Oracle; <*UNUSED*> name: TEXT): ScrnPixmap.T = BEGIN RETURN NIL; END Lookup; PROCEDUREBuiltIn (self: Oracle; pm: Pixmap.Predefined): ScrnPixmap.T = BEGIN IF self.st.bits # self.st THEN RETURN Palette.ResolvePixmap (self.st.bits, Pixmap.T {pm}); END; CASE pm OF | Pixmap.Solid.pm => WITH res = Load (self, rawSolid) DO res.id := SolidPixmap; RETURN res; END; | Pixmap.Gray.pm => RETURN Load (self, rawGray); | Pixmap.Empty.pm => RETURN Load (self, rawEmpty); ELSE RAISE FatalError; END; END BuiltIn;
PROCEDURENewOracle (st : WinScreenType.T): ScrnPixmap.Oracle = BEGIN RETURN NEW (Oracle, st := st); END NewOracle; PROCEDUREPixmapDomain (st: WinScreenType.T; pmId: INTEGER): Rect.T = BEGIN IF pmId = SolidPixmap THEN RETURN rawSolid.bounds END; IF pmId < 0 THEN pmId := SolidPixmap - pmId; st := st.bits; END; IF pmId < NUMBER (st.pmtable^) THEN RETURN st.pmtable[pmId].domain; ELSE RETURN Rect.Empty; END; END PixmapDomain;
* The xvbt version of this function is quite a hack: The actual image data
* of a ScrnPixmap.Raw
is stored in a field pixels
. It just so happens
* that the memory layout of pixels
is identical to the layout expected by
* the data
field of an X.XImage
record. So, the xvbt version simply
* creates an XImage, loopholes the pixels
field into the data
field,
* then creates an X.Pixmap
, paints the X.XImage
onto the X.Pixmap
,
* and returns the X pixmap.
*
* The Windows version currently deals only with monochrome bitmaps
* (which makes sense, since I didn't implement colors yet either)
PROCEDURE*************************************************************************** Private procedures ***************************************************************************PixmapFromRaw (st: WinScreenType.T; pm: ScrnPixmap.Raw): WinDef.HBITMAP = <* LL.sup = st.trsl *> PROCEDURE ConvertMonochrome (pm: ScrnPixmap.Raw): WinDef.HBITMAP = TYPE WinWord = Ctypes.unsigned_short; Bit = BITS 1 FOR [0..1]; Byte = BITS 8 FOR ARRAY [0..7] OF Bit; TwoByte = BITS 16 FOR ARRAY [0..1] OF Byte; CONST WinWordSize = BITSIZE (WinWord); BEGIN WITH pix_width = pm.bounds.east - pm.bounds.west, pix_height = pm.bounds.south - pm.bounds.north, word_width = (pix_width - 1) DIV WinWordSize + 1, words = NEW (REF ARRAY OF WinWord, word_width * pix_height) DO (* first, let's blank the array *) FOR i := 0 TO word_width * pix_height - 1 DO words[i] := 0; END; (* Next, let's transfer the bits from pm.pixels to bits *) FOR v := 0 TO pix_height - 1 DO FOR h := 0 TO pix_width - 1 DO WITH pt = Point.T{pm.bounds.west + h, pm.bounds.north + v}, word = v * word_width + h DIV WinWordSize, byte = (h MOD WinWordSize) DIV 8, bit = 7 - h MOD 8 DO LOOPHOLE (words[word], TwoByte)[byte][bit] := pm.get(pt); END; END; END; WITH res = WinGDI.CreateBitmap (pm.bounds.east - pm.bounds.west, pm.bounds.south - pm.bounds.north, 1, 1, ADR(words[0])) DO <* ASSERT res # NIL *> RETURN res; END; END; END ConvertMonochrome; PROCEDURE ConvertColor (st: WinScreenType.T; pm: ScrnPixmap.Raw): WinDef.HBITMAP = VAR hwnd : WinDef.HWND; hdc : WinDef.HDC; hbmp : WinDef.HBITMAP; pixels : REF ARRAY OF WinGDI.RGBQUAD; k : INTEGER; status : WinDef.BOOL; bmi : WinGDI.BITMAPINFO; BEGIN hwnd := WinUser.GetDesktopWindow (); <* ASSERT hwnd # NIL *> hdc := WinUser.GetDC (hwnd); <* ASSERT hdc # NIL *> pixels := NEW (REF ARRAY OF WinGDI.RGBQUAD, (pm.bounds.south - pm.bounds.north) * (pm.bounds.east - pm.bounds.west)); k := 0; FOR i := pm.bounds.south - 1 TO pm.bounds.north BY -1 DO FOR j := pm.bounds.west TO pm.bounds.east - 1 DO WITH pixel = pm.get(Point.T{j,i}), red = WinGDI.GetRValue (pixel), green = WinGDI.GetGValue (pixel), blue = WinGDI.GetBValue (pixel) DO pixels[k] := WinGDI.RGBQUAD {blue, green, red, 0}; END; INC (k); END; END; WITH bmih = bmi.bmiHeader DO bmih.biSize := BYTESIZE(WinGDI.BITMAPINFOHEADER); bmih.biWidth := pm.bounds.east - pm.bounds.west; (* Windows NT bug: According to the doc, a negative value for biHeight indicates a top-down bitmap, that is, a bitmap that starts in the upper-left corner. However, if I actually pass a negative value, the bitmap comes out solid black most of the time (although at some point, it came out ok ...) *) bmih.biHeight := pm.bounds.south - pm.bounds.north; bmih.biPlanes := 1; (* always 1 *) bmih.biBitCount := 32; bmih.biCompression := WinGDI.BI_RGB; bmih.biSizeImage := 0; (* 0 is valid only for BI_RGB *) bmih.biXPelsPerMeter := ROUND (st.res[Axis.T.Hor] * 1000.0); bmih.biYPelsPerMeter := ROUND (st.res[Axis.T.Ver] * 1000.0); bmih.biClrUsed := 0; (* bitmap uses all the colors *) bmih.biClrImportant := 0; (* all colors are important *) hbmp := WinGDI.CreateDIBitmap (hdc, ADR(bmih), WinGDI.CBM_INIT, LOOPHOLE (ADR (pixels[0]), WinDef.LPVOID), ADR (bmi), WinGDI.DIB_RGB_COLORS); END; status := WinUser.ReleaseDC (hwnd, hdc); <* ASSERT status = True *> RETURN hbmp; END ConvertColor; BEGIN IF Rect.IsEmpty (pm.bounds) THEN RETURN NIL ; ELSIF pm.depth = 1 AND pm.bitsPerPixel = 1 THEN RETURN ConvertMonochrome (pm); ELSE RETURN ConvertColor (st, pm); END; END PixmapFromRaw;
PROCEDURENewPixmap ( st : WinScreenType.T; hbmp : WinDef.HBITMAP; READONLY domain: Rect.T; depth : INTEGER): ScrnPixmap.T = <* LL.sup = st.trsl *> VAR id, slot: INTEGER; BEGIN IF depth = 1 THEN st := st.bits END; IF (st.pmfree >= 0) THEN slot := st.pmfree; st.pmfree := st.pmtable[slot].domain.north; ELSE slot := st.pmcount; IF (slot = NUMBER (st.pmtable^)) THEN ExpandPixmapTable (st); END; END; IF st.bits = st THEN id := SolidPixmap - slot; ELSE id := slot; END; st.pmtable[slot] := PixmapRecord {hbmp, domain}; INC(st.pmcount); RETURN NEW (T, st := st, id := id, depth := depth, bounds := Rect.Sub (domain, Rect.NorthWest (domain))); (* Simply passing "domain" screws things up. This sounds like a bug somewhere in my code. *) END NewPixmap; PROCEDUREExpandPixmapTable (st: WinScreenType.T) = VAR n := NUMBER (st.pmtable^); new := NEW (REF ARRAY OF PixmapRecord, n+n); BEGIN SUBARRAY (new^, 0, n) := st.pmtable^; st.pmtable := new; END ExpandPixmapTable; VAR rawSolid, rawGray, rawEmpty: ScrnPixmap.Raw; PROCEDUREInitPredefRaws () = BEGIN WITH r = Rect.FromSize (8, 8) DO rawSolid := ScrnPixmap.NewRaw (1, r); rawEmpty := ScrnPixmap.NewRaw (1, r); rawGray := ScrnPixmap.NewRaw (1, r); FOR x := r.west TO r.east - 1 DO FOR y := r.north TO r.south - 1 DO WITH p = Point.T {x, y} DO rawSolid.set (p, 1); rawEmpty.set (p, 0); rawGray.set (p, (x + y) MOD 2); END; END; END; END; END InitPredefRaws; BEGIN InitPredefRaws(); END WinScrnPixmap.