ð©Syntax10.Scn.FntnSyntax10b.Scn.FntŸs Syntax10i.Scn.Fnt$‚¾ ?D ºMODULE Display1; (* MH 5.11.93 *) IMPORT SYSTEM, Kernel, Win32, Display; CONST R2Not = 6; R2CopyPen = 13; (* ROP2 modes *) white = 0; grey1 = 1; grey2 = 2; grey3 = 3; grey4 = 4; black = 5; texture0 = 6; texture1 = 7; texture2 = 8; texture3 = 9; VAR scrPat: ARRAY 10 OF LONGINT; mod: LONGINT; Ellipse0: PROCEDURE (hdc, left, top, right, bot: LONGINT); CreatePen: PROCEDURE (style, width: LONGINT; color: LONGINT (*COLORREF*)): LONGINT; LineTo: PROCEDURE (hdc, x, y: LONGINT); MoveToEx: PROCEDURE (hdc: LONGINT; x, y: LONGINT; prev: LONGINT); SetROP2: PROCEDURE (hdc: LONGINT; rop: LONGINT): LONGINT; PROCEDURE Ellipse* (F: Display.Frame; col, X, Y, A, B, mode: INTEGER); VAR rop, obj, colref: LONGINT; BEGIN IF Win32.lc.len > 0 THEN Win32.FlushCache END ; colref := Win32.ColorRef(col); obj := Win32.GetStockObject(5); (*NULL_BRUSH*); obj := Win32.SelectObject(Win32.hdcDisp, obj); Win32.DeleteObject(obj); Win32.dc.pat := NIL; Win32.dc.brushCol := -1; Win32.SetPenColor(colref); IF mode = Display.invert THEN rop := SetROP2(Win32.hdcDisp, R2Not) ELSE rop := SetROP2(Win32.hdcDisp, R2CopyPen) END ; Win32.SetClippingArea(F.X, F.Y, F.W, F.H); Ellipse0(Win32.hdcDisp, X-A, Win32.DispH-(Y+B), X+A, Win32.DispH-(Y-B)); rop := SetROP2(Win32.hdcDisp, rop); END Ellipse; PROCEDURE Circle* (F: Display.Frame; col, X, Y, R, mode: INTEGER); BEGIN Ellipse(F, col, X, Y, R, R, mode); END Circle; PROCEDURE Line* (F: Display.Frame; col, X0, Y0, X1, Y1, mode: INTEGER); VAR obj, colref, rop: LONGINT; dx, dy, incX, incY, xmax, ymax: INTEGER; code0, code1: SET; (* 3 = above top edge, 2 = below bottom edge, 1 = right to right edge, 0 = left to left edge *) BEGIN dx := X1 - X0; IF dx < 0 THEN incX := -1; dx := ABS(dx) ELSE incX := 1 END ; dy := Y1 - Y0; IF dy < 0 THEN incY := -1; dy := ABS(dy) ELSE incY := 1 END ; IF dx = dy THEN INC(Y1, incY); INC(X1, incX) ELSIF dy > dx THEN INC(Y1, incY); ELSE INC(X1, incX) END ; (* Cohen-Sutherland line clipping *) code0 := {}; code1 := {}; ymax := F.Y + F.H; xmax := F.X + F.W; IF ymax < Y0 THEN code0 := {3} ELSIF Y0 < F.Y THEN code0 := {2} END ; IF xmax < X0 THEN INCL(code0, 1) ELSIF X0 < F.X THEN INCL(code0, 0) END ; IF ymax < Y1 THEN code1 := {3} ELSIF Y1 < F.Y THEN code1 := {2} END ; IF xmax < X1 THEN INCL(code1, 1) ELSIF X1 < F.X THEN INCL(code1, 0) END ; IF code0 * code1 = {} THEN (* cannot trivially reject *) IF Win32.lc.len > 0 THEN Win32.FlushCache END ; colref := Win32.ColorRef(col); Win32.SetPenColor(colref); MoveToEx(Win32.hdcDisp, X0, Win32.DispH-Y0-1, 0); IF mode = Display.invert THEN rop := SetROP2(Win32.hdcDisp, R2Not) ELSE rop := SetROP2(Win32.hdcDisp, R2CopyPen) END ; Win32.SetClippingArea(F.X, F.Y, F.W, F.H); LineTo(Win32.hdcDisp, X1, Win32.DispH-Y1-1); rop := SetROP2(Win32.hdcDisp, rop); END END Line; PROCEDURE ThisPattern* (n: INTEGER): LONGINT; (* Returns the n-th predefined pattern (corresponding to the printer patterns). If the pattern is not available, 0 is returned. n must be >= 0. Currently 10 patterns are predefined (0 .. 9). *) BEGIN IF n >= LEN(scrPat) THEN RETURN 0 ELSE RETURN scrPat[n] END END ThisPattern; PROCEDURE GetPatternSize* (pat: LONGINT; VAR w, h: INTEGER); VAR p: Win32.PatternPtr; BEGIN p := SYSTEM.VAL(Win32.PatternPtr, pat); w := p.w; h := p.h; END GetPatternSize; PROCEDURE InitPatterns; VAR image: ARRAY 33 OF SET; PROCEDURE Repl(step: INTEGER); VAR i: INTEGER; BEGIN i := step; WHILE i < 32 DO image[i+1] := image[i-step+1]; INC(i) END END Repl; BEGIN image[1] := {}; Repl(1); scrPat[white] := Display.NewPattern(image, 32, 32); image[4] := {0, 8, 16, 24}; image[3] := {}; image[2] := {4, 12, 20, 28}; image[1] := {}; Repl(4); scrPat[grey1] := Display.NewPattern(image, 32, 32); image[2] := {0, 4, 8, 12, 16, 20, 24, 28}; image[1] := {2, 6, 10, 14, 18, 22, 26, 30}; Repl(2); scrPat[grey2] := Display.NewPattern(image, 32, 32); image[2] := {0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22, 24, 26, 28, 30}; image[1] := {1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31}; Repl(2); scrPat[grey3] := Display.NewPattern(image, 32, 32); image[2] := {1..3, 5..7, 9..11, 13..15, 17..19, 21..23, 25..27, 29..31}; image[1] := {0, 1, 3..5, 7..9, 11..13, 15..17, 19..21, 23..25, 27..29, 31}; Repl(2); scrPat[grey4] := Display.NewPattern(image, 32, 32); image[1] := {0..31}; Repl(1); scrPat[black] := Display.NewPattern(image, 32, 32); image[4] :={3, 7, 11, 15, 19, 23, 27, 31}; image[3] :={2, 6, 10, 14, 18, 22, 26, 30}; image[2] :={1, 5, 9, 13, 17, 21, 25, 29}; image[1] :={0, 4, 8, 12, 16, 20, 24, 28}; Repl(4); scrPat[texture0] := Display.NewPattern(image, 32, 32); image[4] :={0, 4, 8, 12, 16, 20, 24, 28}; image[3] :={1, 5, 9, 13, 17, 21, 25, 29}; image[2] :={2, 6, 10, 14, 18, 22, 26, 30}; image[1] :={3, 7, 11, 15, 19, 23, 27, 31}; Repl(4); scrPat[texture1] := Display.NewPattern(image, 32, 32); image[1] := {2, 6, 10, 14, 18, 22, 26, 30}; Repl(1); scrPat[texture2] := Display.NewPattern(image, 32, 32); image[4] := {}; image[3] := {}; image[2] := {}; image[1] := {0..31}; Repl(4); scrPat[texture3] := Display.NewPattern(image, 32, 32); END InitPatterns; BEGIN mod := Kernel.LoadLibrary("GDI32"); Kernel.GetAdr(mod, "Ellipse", SYSTEM.VAL(LONGINT, Ellipse0)); Kernel.GetAdr(mod, "MoveToEx", SYSTEM.VAL(LONGINT, MoveToEx)); Kernel.GetAdr(mod, "LineTo", SYSTEM.VAL(LONGINT, LineTo)); Kernel.GetAdr(mod, "CreatePen", SYSTEM.VAL(LONGINT, CreatePen)); Kernel.GetAdr(mod, "SetROP2", SYSTEM.VAL(LONGINT, SetROP2)); InitPatterns; END Display1.