Syntax10.Scn.FntqBalloonElemsAlloc#Syntax10.Scn.Fnt"SRCCOPY" dest = source "SRCPAINT" dest = source OR dest "SRCAND" dest = source AND dest "SRCINVERT" dest = source XOR dest "SRCERASE" dest = source AND (NOT dest) "NOTSRCCOPY" dest = NOT source "NOTSRCERASE" dest = (NOT src) AND (NOT dest) "MERGECOPY" dest = source AND pattern "MERGEPAINT" dest = (NOT source) OR dest "PATCOPY" dest = pattern "PATPAINT" dest = DPSnoo "PATINVERT" dest = pattern XOR dest "DSTINVERT" dest = NOT dest "BLACKNESS" dest = BLACK "WHITENESS" dest = WHITE Syntax10i.Scn.FntA ZParcElemsAlloc  с Zu   Syntax10b.Scn.FntB* Z / Y)+9MarkElemsAllocb <vwz  m' _ ` K  cg u fJ  _i e rOm?MODULE Display;  IMPORT SYSTEM, Win32; CONST black* = 0 (* Win32.Backg *); white* = 15 (* Win32.Foreg *); replace* = 0; paint* = 1; invert* = 2; (* GDI ROP codes *) (* PATAND = 0A000C9H; PATPAINT = 0FA0089H; (* changed ! *) *)  SRCCOPY = 0CC0020H; (* dest = source *) SRCPAINT = 0EE0086H; (* dest = source OR dest *) SRCAND = 8800C6H; (* dest = source AND dest *) SRCINVERT = 660046H; (* dest = source XOR dest *) SRCERASE = 440328H; (* dest = source AND (NOT dest) *) NOTSRCCOPY = 330008H; (* dest = (NOT source) *) NOTSRCERASE = 1100A6H; (* dest = (NOT src) AND (NOT dest) *) MERGECOPY = 0C000CAH; (* dest = (source AND pattern) *) MERGEPAINT = 0BB0226H; (* dest = (NOT source) OR dest *) PATCOPY = 0F00021H; (* dest = pattern *) PATPAINT = 0FB0A09H; (* dest = DPSnoo *) PATINVERT = 5A0049H; (* dest = pattern XOR dest *) DSTINVERT = 550009H; (* dest = (NOT dest) *) BLACKNESS = 42H; (* dest = BLACK *) WHITENESS = 0FF0062H; (* dest = WHITE *)  (* PatBlt, rop may be PATCOPY Copies the specified pattern into the destination bitmap. PATINVERT Combines the colors of the specified pattern with the colors of the destination rectangle by using the Boolean OR operator. DSTINVERT Inverts the destination rectangle. BLACKNESS Fills the destination rectangle using the color associated with index 0 in the physical palette. (This color is black for the default physical palette.) WHITENESS Fills the destination rectangle using the color associated with index 1 in the physical palette. (This color is white for the default physical palette.) *) (* BitBlt, rop may be BLACKNESS Fills the destination rectangle using the color associated with index 0 in the physical palette. (This color is black for the default physical palette.) DSTINVERT Inverts the destination rectangle. MERGECOPY Merges the colors of the source rectangle with the specified pattern by using the Boolean AND operator. MERGEPAINT Merges the colors of the inverted source rectangle with the colors of the destination rectangle by using the Boolean OR operator. NOTSRCCOPY Copies the inverted source rectangle to the destination. NOTSRCERASE Combines the colors of the source and destination rectangles by using the Boolean OR operator and then inverts the resultant color. PATCOPY Copies the specified pattern into the destination bitmap. PATINVERT Combines the colors of the specified pattern with the colors of the destination rectangle by using the Boolean XOR operator. PATPAINT Combines the colors of the pattern with the colors of the inverted source rectangle by using the Boolean OR operator. The result of this operation is combined with the colors of the destination rectangle by using the Boolean OR operator. SRCAND Combines the colors of the source and destination rectangles by using the Boolean AND operator. SRCCOPY Copies the source rectangle directly to the destination rectangle. SRCERASE Combines the inverted colors of the destination rectangle with the colors of the source rectangle by using the Boolean AND operator. SRCINVERT Combines the colors of the source and destination rectangles by using the Boolean XOR operator. SRCPAINT Combines the colors of the source and destination rectangles by using the Boolean OR operator. WHITENESS Fills the destination rectangle using the color associated with index 1 in the physical palette. (This color is white for the default physical palette.) *)  TYPE Frame* = POINTER TO FrameDesc; FrameMsg* = RECORD END ; Handler* = PROCEDURE (f: Frame; VAR msg: FrameMsg); FrameDesc* = RECORD dsc*, next*: Frame; X*, Y*, W*, H*: INTEGER; handle*: Handler; END ; Pattern* = LONGINT (* = Win32.PatternPtr *); Font* = POINTER TO Bytes (* = Win32.Font *); Bytes* = RECORD END (* = Win32.Bytes *); COLORREF = Win32.COLORREF; (* Rect = RECORD left, top, right, bottom: LONGINT; END ; *) VAR Unit*: LONGINT; Left*, ColLeft*, Bottom*, UBottom*, Width*, Height*: INTEGER; arrow*, star*, hook*, cross*, downArrow*, grey0*, grey1*, grey2*, ticks*: LONGINT; PROCEDURE MakePatterns; VAR image: ARRAY 33 OF SET; i: INTEGER; BEGIN i := 1; WHILE i < 33 DO image[i] := {0, 4, 8, 12, 16, 20, 24, 28}; image[i+1] := {}; image[i+2] := {2, 6, 10, 14, 18, 22, 26, 30}; image[i+3] := {}; INC(i, 4); END ; Win32.NewPattern(image, 32, 32, grey0); i := 1; WHILE i < 33 DO image[i] := {30, 28, 26, 24, 22, 20, 18, 16, 14, 12, 10, 8, 6, 4, 2, 0}; INC(i); image[i] := {31, 29, 27, 25, 23, 21, 19, 17, 15, 13, 11, 9, 7, 5, 3, 1}; INC(i); END ; Win32.NewPattern(image, 32, 32, grey1); i := 1; WHILE i < 33 DO image[i] := {0, 1, 4, 5, 8, 9, 12, 13, 16, 17, 20, 21, 24, 25, 28, 29}; INC(i); image[i] := {0, 1, 4, 5, 8, 9, 12, 13, 16, 17, 20, 21, 24, 25, 28, 29}; INC(i); image[i] := {2, 3, 6, 7, 10, 11, 14, 15, 18, 19, 22, 23, 26, 27, 30, 31}; INC(i); image[i] := {2, 3, 6, 7, 10, 11, 14, 15, 18, 19, 22, 23, 26, 27, 30, 31}; INC(i); END ; Win32.NewPattern(image, 32, 32, grey2); image[1] := {13}; image[2] := {12..14}; image[3] := {11..13}; image[4] := {10..12}; image[5] := {9..11}; image[6] := {8..10}; image[7] := {7..9}; image[8] := {0, 6..8}; image[9] := {0, 1, 5..7}; image[10] := {0..2, 4..6}; image[11] := {0..5}; image[12] := {0..4}; image[13] := {0..5}; image[14] := {0..6}; image[15] := {0..7}; Win32.NewPattern(image, 15, 15, arrow); image[1] := {0, 10}; image[2] := {1, 9}; image[3] := {2, 8}; image[4] := {3, 7}; image[5] := {4, 6}; image[6] := {}; image[7] := {4, 6}; image[8] := {3, 7}; image[9] := {2, 8}; image[10] := {1, 9}; image[11] := {0, 10}; Win32.NewPattern(image, 11, 11, cross); image[1] := {0..7}; image[2] := {0..6}; image[3] := {0..5}; image[4] := {0..4}; image[5] := {0..3}; image[6] := {0..2}; image[7] := {0..1}; image[8] := {0}; Win32.NewPattern(image, 8, 8, hook); image[1] := {7}; image[2] := {7}; image[3] := {2, 7, 12}; image[4] := {3, 7, 11}; image[5] := {4, 7, 10}; image[6] := {5, 7, 9}; image[7] := {6..8}; image[8] := {0..6, 8..14}; image[9] := {6..8}; image[10] := {5, 7, 9}; image[11] := {4, 7, 10}; image[12] := {3, 7, 11}; image[13] := {2, 7, 12}; image[14] := {7}; image[15] := {7}; Win32.NewPattern(image, 15, 15, star); image[1] := {6}; image[2] := {5..7}; image[3] := {4..8}; image[4] := {3..9}; image[5] := {2..10}; image[6] := {5..7}; image[7] := {5..7}; image[8] := {5..7}; image[9] := {5..7}; image[10] := {5..7}; image[11] := {5..7}; image[12] := {5..7}; image[13] := {5..7}; image[14] := {5..7}; image[15] := {}; Win32.NewPattern(image, 15, 15, downArrow); i := 1; WHILE i < 33 DO image[i] := {}; INC(i) END ; image[1] := {0, 16}; image[17] := {0, 16}; Win32.NewPattern(image, 32, 32, ticks); END MakePatterns; PROCEDURE Map* (X: INTEGER): LONGINT; BEGIN RETURN 0 END Map; PROCEDURE SetMode* (X: INTEGER; s: SET); BEGIN IF 2 IN s THEN Win32.BlackOnWhite ELSE Win32.WhiteOnBlack END ; END SetMode; PROCEDURE SetColor* (col, red, green, blue: INTEGER); BEGIN IF ~(col IN {0, 1, 2, 3, 15}) THEN Win32.UpdatePalette(col, red, green, blue) END END SetColor; PROCEDURE GetColor* (col: INTEGER; VAR red, green, blue: INTEGER); BEGIN Win32.GetColor(col, red, green, blue) END GetColor; PROCEDURE GetChar* (f: Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER; VAR p: Pattern); VAR m: LONGINT; h1: INTEGER; F: Win32.Font; BEGIN F := SYSTEM.VAL(Win32.Font, f); IF ~F.oberon THEN ch := Win32.OberonToWin[ORD(ch)] END ; Win32.cc.font := F; Win32.cc.ch := ch; (* avoid indexing using SYSTEM.GET *) m := SYSTEM.VAL(LONGINT, f) + ORD(ch)*SIZE(Win32.MetricDesc); p := m + 8; Win32.cc.pat := p; SYSTEM.GET(m, h1); dx := h1; Win32.cc.dx := h1; INC(m, 2); SYSTEM.GET(m, h1); x := h1; Win32.cc.x := h1; INC(m, 2); SYSTEM.GET(m, h1); y := h1; Win32.cc.y := h1; INC(m, 12); SYSTEM.GET(m, w); INC(m, 2); SYSTEM.GET(m, h); END GetChar; PROCEDURE NewPattern* (VAR image: ARRAY OF SET; w, h: INTEGER): LONGINT; VAR pat: LONGINT; BEGIN Win32.NewPattern(image, w, h, pat); RETURN pat; END NewPattern; (* -------------------- no clipping --------------------- *) PROCEDURE CopyBlock* (sx, sy, w, h, dx, dy, mode: INTEGER); VAR clientW, clientH: LONGINT; BEGIN IF (w <= 0) OR (h <= 0) THEN RETURN END ; Win32.SetClippingArea(0, 0, Win32.DispW, Win32.DispH); IF Win32.lc.len > 0 THEN Win32.FlushCache END ; Win32.GetClientSize(clientW, clientH); IF (clientW = Width) & (clientH = Height) THEN Win32.BitBlt(Win32.hdcDisp, dx, Win32.DispH-dy-h, w, h, Win32.hdcDisp, sx, Win32.DispH-sy-h, SRCCOPY); ELSIF ((sx # dx) & (clientW < sx+w)) OR ((sy # dy) & (Height-clientH > sy)) THEN Win32.RefreshDisplay; ELSE Win32.BitBlt(Win32.hdcDisp, dx, Win32.DispH-dy-h, w, h, Win32.hdcDisp, sx, Win32.DispH-sy-h, SRCCOPY); END END CopyBlock; PROCEDURE ReplConst* (col, x, y, w, h, mode: INTEGER); VAR colref: COLORREF; BEGIN IF (w <= 0) OR (h <= 0) THEN RETURN END ; Win32.SetClippingArea(0, 0, Win32.DispW, Win32.DispH); IF Win32.lc.len > 0 THEN Win32.FlushCache END ; IF mode = invert THEN Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y, w, -h, DSTINVERT); ELSIF (col = black) & (mode >=0) THEN Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, Win32.BackgRop) ELSIF (col = white) & (mode >=0) THEN Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, Win32.ForegRop) ELSE colref := Win32.ColorRef(col); Win32.SetBrushColor(colref); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATCOPY) END; Win32.GdiFlush END ReplConst; PROCEDURE CopyPattern* (col: INTEGER; pat: Pattern; x, y, mode: INTEGER); VAR p: Win32.PatternPtr; colref: COLORREF; dmmy: LONGINT; hdcMem: LONGINT; BEGIN Win32.SetClippingArea(0, 0, Win32.DispW, Win32.DispH); IF (pat = Win32.cc.pat) & (Win32.cc.font.hfont # 0) & (mode # invert) THEN (* character cache valid and Windows font available. Invert mode not supported by line cache. *) Win32.CacheCharacter(x, y, col, mode); ELSE colref := Win32.ColorRef(col); IF Win32.lc.len > 0 THEN Win32.FlushCache END ; p := SYSTEM.VAL(Win32.PatternPtr, pat); hdcMem := Win32.CreateCompatibleDC(Win32.hdcDisp); dmmy := Win32.SelectObject(hdcMem, p.bitmap); CASE mode OF | invert: Win32.SetBackgCol(Win32.White); Win32.SetTextCol(Win32.Black); Win32.BitBlt(Win32.hdcDisp, x, Win32.DispH-(y+p.h), p.w, p.h, hdcMem, p.x, p.y, SRCINVERT) | replace: Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Backg); Win32.BitBlt(Win32.hdcDisp, x, Win32.DispH-(y+p.h), p.w, p.h, hdcMem, p.x, p.y, SRCCOPY); | paint: IF colref # Win32.White THEN Win32.SetBackgCol(Win32.Black); Win32.SetTextCol(Win32.White); Win32.BitBlt(Win32.hdcDisp, x, Win32.DispH-(y+p.h), p.w, p.h, hdcMem, p.x, p.y, SRCAND); END ; IF colref # Win32.Black THEN Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Black); Win32.BitBlt(Win32.hdcDisp, x, Win32.DispH-(y+p.h), p.w, p.h, hdcMem, p.x, p.y, SRCPAINT); END ; ELSE END ; Win32.DeleteDC(hdcMem); END END CopyPattern; PROCEDURE ReplPattern* (col: INTEGER; pat: Pattern; x, y, w, h, mode: INTEGER); VAR colref: LONGINT; BEGIN IF (w <= 0) OR (h <= 0) THEN RETURN END ; Win32.SetClippingArea(0, 0, Win32.DispW, Win32.DispH); IF Win32.lc.len > 0 THEN Win32.FlushCache END ; colref := Win32.ColorRef(col); Win32.SetPatternBrush(SYSTEM.VAL(Win32.PatternPtr, pat)); Win32.SetBrushOrgEx(Win32.hdcDisp, 0, Win32.DispH, 0); CASE mode OF | invert: Win32.SetBackgCol(Win32.White); Win32.SetTextCol(Win32.Black); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATINVERT); | replace: Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Backg); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATCOPY) | paint: IF colref # Win32.White THEN Win32.SetBackgCol(Win32.Black); Win32.SetTextCol(Win32.White); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATCOPY); (* PATAND *) END ; IF colref # Win32.Black THEN Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Black); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATPAINT); END ; END END ReplPattern; PROCEDURE Dot* (col, x, y, mode: INTEGER); BEGIN ReplConst(col, x, y, 1, 1, mode) END Dot; (* ------------------ clipping support -------------------- *) PROCEDURE CopyBlockC* (F: Frame; sx, sy, w, h, dx, dy, mode: INTEGER); VAR u: INTEGER; BEGIN IF dx < F.X THEN DEC(w, F.X - dx); INC(sx, F.X - dx); dx := F.X END ; u := (dx+w)-(F.X+F.W); IF u > 0 THEN DEC(w, u) END ; IF dy < F.Y THEN DEC(h, F.Y - dy); INC(sy, F.Y - dy); dy := F.Y END ; u := (dy+h) - (F.Y+F.H); IF u > 0 THEN DEC(h, u) END ; IF (h <= 0) OR (w <= 0) THEN RETURN END ; CopyBlock(sx, sy, w, h, dx, dy, mode); END CopyBlockC; PROCEDURE CopyPatternC* (F: Frame; col: INTEGER; pat: LONGINT; x, y, mode: INTEGER); VAR p: Win32.PatternPtr; colref: LONGINT; dmmy: LONGINT; hdcMem: LONGINT; BEGIN Win32.SetClippingArea(F.X, F.Y, F.W, F.H); IF (pat = Win32.cc.pat) & (Win32.cc.font.hfont # 0) & (mode # invert) THEN (* character cache valid and Windows font available. Invert mode not supported by line cache. *) Win32.CacheCharacter(x, y, col, mode); ELSE IF Win32.lc.len > 0 THEN Win32.FlushCache END ; p := SYSTEM.VAL(Win32.PatternPtr, pat); colref := Win32.ColorRef(col); hdcMem := Win32.CreateCompatibleDC(Win32.hdcDisp); dmmy := Win32.SelectObject(hdcMem, p.bitmap); CASE mode OF | invert: Win32.SetBackgCol(Win32.White); Win32.SetTextCol(Win32.Black); Win32.BitBlt(Win32.hdcDisp, x, Win32.DispH-(y+p.h), p.w, p.h, hdcMem, p.x, p.y, SRCINVERT) | replace: Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Backg); Win32.BitBlt(Win32.hdcDisp, x, Win32.DispH-(y+p.h), p.w, p.h, hdcMem, p.x, p.y, SRCCOPY); | paint: IF colref # Win32.White THEN Win32.SetBackgCol(Win32.Black); Win32.SetTextCol(Win32.White); Win32.BitBlt(Win32.hdcDisp, x, Win32.DispH-(y+p.h), p.w, p.h, hdcMem, p.x, p.y, SRCAND); END ; IF colref # Win32.Black THEN Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Black); Win32.BitBlt(Win32.hdcDisp, x, Win32.DispH-(y+p.h), p.w, p.h, hdcMem, p.x, p.y, SRCPAINT); END ; ELSE END ; Win32.DeleteDC(hdcMem); END END CopyPatternC; PROCEDURE ReplPatternC* (F: Frame; col: INTEGER; pat: LONGINT; x, y, w, h, xp, yp, mode: INTEGER); VAR u: INTEGER; colref: LONGINT; BEGIN IF x < F.X THEN DEC(w, F.X - x); x := F.X END ; u := (x+w)-(F.X+F.W); IF u > 0 THEN DEC(w, u) END ; IF y < F.Y THEN DEC(h, F.Y - y); y := F.Y END ; u := (y+h) - (F.Y+F.H); IF u > 0 THEN DEC(h, u) END ; IF (h <= 0) OR (w <= 0) THEN RETURN END ; Win32.SetClippingArea(0, 0, Win32.DispW, Win32.DispH); IF Win32.lc.len > 0 THEN Win32.FlushCache END ; Win32.SetPatternBrush(SYSTEM.VAL(Win32.PatternPtr, pat)); Win32.SetBrushOrgEx(Win32.hdcDisp, xp, Win32.DispH-yp, 0); colref := Win32.ColorRef(col); CASE mode OF | invert: Win32.SetBackgCol(Win32.White); Win32.SetTextCol(Win32.Black); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATINVERT); | replace: Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Backg); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATCOPY) | paint: IF colref # Win32.White THEN Win32.SetBackgCol(Win32.Black); Win32.SetTextCol(Win32.White); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATCOPY); (* PATAND *) END ; IF colref # Win32.Black THEN Win32.SetBackgCol(colref); Win32.SetTextCol(Win32.Black); Win32.PatBlt(Win32.hdcDisp, x, Win32.DispH-y-h, w, h, PATPAINT); END ; END ; END ReplPatternC; PROCEDURE ReplConstC* (F: Frame; col, x, y, w, h, mode: INTEGER); VAR u: INTEGER; BEGIN IF x < F.X THEN DEC(w, F.X - x); x := F.X END ; u := (x+w)-(F.X+F.W); IF u > 0 THEN DEC(w, u) END ; IF y < F.Y THEN DEC(h, F.Y - y); y := F.Y END ; u := (y+h) - (F.Y+F.H); IF u > 0 THEN DEC(h, u) END ; IF (w > 0) & (h > 0) THEN ReplConst(col, x, y, w, h, mode) END ; END ReplConstC; PROCEDURE DotC* (F: Frame; col, x, y, mode: INTEGER); BEGIN IF (F.X <= x) & (x < (F.X+F.W)) & (F.Y <= y) & (y < (F.Y+F.H)) THEN ReplConst(col, x, y, 1, 1, mode) END ; END DotC; BEGIN Unit := 10000; Left := 0; Bottom := 0; Width := SHORT(Win32.DispW); Height := SHORT(Win32.DispH); ColLeft := Left; UBottom := Bottom; MakePatterns; END Display.