}Syntax10.Scn.FntSyntax10b.Scn.FntSyntax10i.Scn.FntIStampElemsAlloc26 May 98~s35(!8FoldElemsNewSyntax10.Scn.FntSyntax10i.Scn.Fnt'TbKeplerElemsAllocKeplerGraphsGraphDescKeplerGraphsStarDesc~{}}}}}}||||||{{{{{{~{~{~{~~~~~{~ {} }} }} }| || || |{ {{ {{ {~{~{~{~~~~}}}}}}||||||{{{{{{~~~}}}|}}}}|}||||{{{{{{Kepler1RectangleDescKepler1AttrDesc   KeplerFramesCaptionDescbSyntax10.Scn.FntgSyntax10.Scn.FntrSyntax10.Scn.FntflSyntax10.Scn.FntpictureSyntax10.Scn.Fnt systemSyntax10.Scn.Fnt!"#$%&'()*+,-./0123456789:;bSyntax10.Scn.Fnt<gSyntax10.Scn.Fnt=rSyntax10.Scn.Fnt>flSyntax10.Scn.Fnt?p.bmi.colorSyntax10.Scn.Fntp.bmi.paletteSyntax10.Scn.FntWin32.PalSyntax10.Scn.Fnte  (* The palette of the picture is normally the identity palette (so that the color index col represents the color that is also returned by Display.GetColor(col, r, g, b)). If the picture uses an own palette, different colors, or has been dithered, the palette entry may refer to any system color. The original RGB value is nevertheless stored in the color array. When a palette-BMP is read via a rider, the RGB values are passed to SetPalette, which performs color matching via Win32.Match and sets the palette index p.bmi.palette[i] to the index of the matched color in the Oberon palette. A pixel with color index 10 then is then displayed with the color corresponding to the RGB values in the Oberon palette at index 10. Dithering (dithered IN flags) resets the picture palette to the identity palette. The bmi.color values are updated to the values stored in Win32.Pal (Oberon palette).  *) END ; 8 8Syntax10.Scn.FntSyntax10b.Scn.Fnt  Syntax10i.Scn.FntN' 7/ <%\& " PictureDesc* = RECORD width-, height-, depth-: INTEGER; (** width, height in pixels, and depth in bits per pixel (1, 4, 8, 16, 24, or 32). *) nofCols: LONGINT; (* number of colors used (<= ASH(1, depth) *) address: LONGINT; (* address of bitmap data *) handle: LONGINT; (* handle to bitmap data, if allocated with GlobalAlloc *) ptr: S.PTR; (* pointer to bitmap data, if allocated with S.NEW *) (* depth bits stored sequentially 1 each pixel is represented by one bit, bit is index in palette (not set => palIdx 0, set => palIdx 1) 4 each pixel is represented by 4 bits, bits are index in palette (0..15) 8 each pixel is represented by one byte, byte is index in palette (0..255) 16 each pixel is represented by two bytes 24 each pixel is represented by three bytes 32 each pixel is represented by four bytes *) wth: LONGINT; (* width of one line of pixels including padding bits, in bytes *) bmi: BMPInfo; flags: SET; (* palChanged IN flags, iff bmi.palette changed after initialisation, bitsChanged IN flags iff SetPixel, ReplConst, or Copy has been performed dithered IN flags iff picture has been dithered *) f: Files.File; col: INTEGER; rgb: BMPBase.RGBColor; rMask, gMask, bMask: SET (* used for bmi.compression = BIBitFields *) END ; 8 "A8Syntax10.Scn.FntSyntax10b.Scn.Fnt7 p*, new*: Picture; x*, y*, w*, h*: INTEGER END ; 8?G    -!MarkElemsAlloc O (8CSyntax10.Scn.FntSyntax10i.Scn.Fnt5 VAR matchedCol: INTEGER; BEGIN ASSERT(p.depth <= 8); ASSERT((col >= 0) & (col < 256)); (* Win32.Match(red, green, blue, matchedCol, red, green, blue); *) p.bmi.color[col].red := CHR(red); p.bmi.color[col].green := CHR(green); p.bmi.color[col].blue := CHR(blue); INCL(p.flags, palChanged) END SetPalette; 8 5^D8#Syntax10.Scn.Fnt BEGIN ASSERT(p.depth <= 8); red := ORD(p.bmi.color[col].red); green := ORD(p.bmi.color[col].green); blue := ORD( p.bmi.color[col].blue) END GetPalette; 8O*;8Syntax10.Scn.Fnt5Syntax10i.Scn.Fnt!Syntax10b.Scn.Fnt    G VAR i: INTEGER; BEGIN IF p.nofCols <= 256 THEN (* only for those there is a palette *) i := 0; WHILE i < p.nofCols DO IF (red = ORD(p.bmi.color[i].red)) & (green = ORD(p.bmi.color[i].green)) & (blue = ORD(p.bmi.color[i].blue)) THEN RETURN i END ; INC(i) END END ; RETURN -1 (* not found *) END Idx; 8? #8#Syntax10.Scn.Fnt%% VAR col: INTEGER; BEGIN IF p.depth <= 8 THEN col := p.Idx(red, green, blue); IF col = -1 THEN Win32.Match(red, green, blue, p.col, red, green, blue); ELSE p.col := col END ELSE p.rgb.red := CHR(red); p.rgb.green := CHR(green); p.rgb.blue := CHR(blue) END END SetColorRGB; 8? 8#Syntax10.Scn.Fnt VAR r, g, b: INTEGER; BEGIN ASSERT((col >= 0) & (col < 256)); IF p.depth <= 8 THEN p.col := col ELSE Display.GetColor(col, r, g, b); p.rgb.red := CHR(r); p.rgb.green := CHR(g); p.rgb.blue := CHR(b) END END SetColorIdx; 8? _8#Syntax10.Scn.FntTT BEGIN IF p.depth <= 8 THEN col := p.col ELSE col := -1 END END GetColorIdx; 8? #8#Syntax10.Scn.Fnt BEGIN IF p.depth <= 8 THEN r := ORD(p.bmi.color[p.col].red); g := ORD(p.bmi.color[p.col].green); b := ORD(p.bmi.color[p.col].blue) ELSE r := ORD(p.rgb.red); g := ORD(p.rgb.green); b := ORD(p.rgb.blue) END END GetColorRGB; 8? )8#Syntax10.Scn.FntZZ VAR ch: CHAR; set: SET; base, adr: LONGINT; BEGIN IF (x >= 0) & (x < p.width) & (y >=0) & (y < p.height) THEN base := p.address + p.wth * y; CASE p.depth OF 1: adr := base + x DIV 8; x := 7 - x MOD 8; S.GET(adr, ch); set := S.VAL(SET, ch) * {0..7}; IF x IN set THEN col := 1 ELSE col := 0 END ; | 4: adr := base + x DIV 2; x := x MOD 2; S.GET(adr, ch); IF ODD(x) THEN col := S.VAL(INTEGER, S.VAL(SET, ch) * {0..3}) ELSE col := S.VAL(INTEGER, S.VAL(SET, ch) * {4..7}); col := col DIV 16 END | 8: S.GET(base + x, ch); col := ORD(ch) ELSE HALT(69) END END END GetPixelIdx; 8 O 67'8#Syntax10.Scn.Fnt VAR col: INTEGER; ch: CHAR; set: SET; base, adr: LONGINT; BEGIN IF (x >= 0) & (x < p.width) & (y >=0) & (y < p.height) THEN base := p.address + p.wth * y; CASE p.depth OF 1: adr := base + x DIV 8; x := 7 - x MOD 8; S.GET(adr, ch); set := S.VAL(SET, ch) * {0..7}; IF x IN set THEN col := 1 ELSE col := 0 END ; | 4: adr := base + x DIV 2; x := x MOD 2; S.GET(adr, ch); IF ODD(x) THEN col := S.VAL(INTEGER, S.VAL(SET, ch) * {0..3}) ELSE col := S.VAL(INTEGER, S.VAL(SET, ch) * {4..7}); col := col DIV 16 END | 8: S.GET(base + x, ch); col := ORD(ch) | 16: S.GET(base + x * 2, col); red := SHORT(ASH(col DIV 1024 MOD 32, 3)); green := SHORT(ASH(col DIV 32 MOD 32, 3)); blue := SHORT(ASH(col MOD 32, 3)) | 24: adr := base + x * 3; S.GET(adr, ch); blue := ORD(ch); INC(adr); S.GET(adr, ch); green := ORD(ch); INC(adr); S.GET(adr, ch); red := ORD(ch) | 32: adr := base + x * 4; S.GET(adr, ch); blue := ORD(ch); INC(adr); S.GET(adr, ch); green := ORD(ch); INC(adr); S.GET(adr, ch); red := ORD(ch) END ; IF p.depth <= 8 THEN red := ORD(p.bmi.color[col].red); green := ORD(p.bmi.color[col].green); blue := ORD(p.bmi.color[col].blue) END END END GetPixelRGB; 8O |8Syntax10.Scn.Fnt_Syntax10i.Scn.FntR2*8FoldElemsNewSyntax10.Scn.FntULTKeplerElemsAllocKeplerGraphsGraphDescKeplerGraphsStarDesc~~~~~}~}~~~~~~~~~~~~~~~~~~~~~~~~~}~}}|}~~|~{~}}}~}~~~~~~~~~~~~~}~]~Kepler1AttrDesc    !"#KeplerFramesCaptionDescbaseSyntax10.Scn.Fnt$%&xSyntax10.Scn.Fnt'base + x DIV 8Syntax10.Scn.Fnt()!*+,-bit 0 of setSyntax10.Scn.Fnt*bit 7Syntax10.Scn.Fnt,./x MOD 8Syntax10.Scn.Fnt0124356789:;<=>?Kepler1TextureDesc7 - x MOD 8Syntax10.Scn.FntvC%88 VAR base, adr: LONGINT; ch: CHAR; set: SET; col: INTEGER; r, g, b: INTEGER; black: BOOLEAN; (* TRUE iff actually black, i.e. # Display.black, set pixel if paint in black *) BEGIN IF (x >= 0) & (x < p.width) & (y >=0) & (y < p.height) THEN INCL(p.flags, bitsChanged); base := p.address + p.wth * y; CASE p.depth OF 1: adr := base + x DIV 8; x := 7 - x MOD 8; black := p.col # Display.black; (* a bit that is set selects the color with idx 15 in the system palette (i.e., really black), a bit that is not set selects the color with idx 0 in the system palette (i.e., really white) *) S.GET(adr, ch); set := S.VAL(SET, ch) * {0..7}; CASE mode OF Display.replace: IF black THEN INCL(set, x) ELSE EXCL(set, x) END ; S.PUT(adr, S.VAL(CHAR, set)) | Display.paint: IF black THEN INCL(set, x); S.PUT(adr, S.VAL(CHAR, set)) END | Display.invert: IF black THEN set := set / {x}; S.PUT(adr, S.VAL(CHAR, set)) END END  | 4: adr := base + x DIV 2; S.GET(adr, ch); IF (mode = Display.replace) OR (mode = Display.paint) & (p.col # Display.black) THEN IF ODD(x) THEN ch := S.VAL(CHAR, S.VAL(SET, ch) * {4..7} + S.VAL(SET, p.col) * {0..3}) ELSE ch := S.VAL(CHAR, S.VAL(SET, ch) * {0..3} + S.VAL(SET, S.LSH(p.col, 4)) * {4..7}) END ; (*Out.F4(" setting # at [#,#; #]", ORD(ch), x, y, adr);*) S.PUT(adr, ch) ELSIF mode = Display.invert THEN IF p.col # Display.black THEN IF ODD(x) THEN col := 15 - S.VAL(INTEGER, S.VAL(SET, ch) * {0..3}); S.PUT(adr, S.VAL(CHAR, S.VAL(SET, ch) * {4..7} + S.VAL(SET, col) * {0..3})) ELSE col := S.VAL(INTEGER, S.VAL(SET, ch) * {4..7}); col := 15 - S.LSH(col, -4); S.PUT(adr, S.VAL(CHAR, S.VAL(SET, ch) * {0..3} + S.VAL(SET, S.LSH(col, 4)) * {4..7})) END END END | 8: adr := base + x; IF (mode = Display.replace) OR (mode = Display.paint) & (p.col # Display.black) THEN S.PUT(adr, CHR(p.col)) ELSIF mode = Display.invert THEN S.GET(adr, ch); col := ORD(ch); IF col <= 15 THEN S.PUT(adr, CHR(15 - col)) ELSE S.PUT(adr, CHR(255 - col)) END END | 16: adr := base + x * 2; IF mode IN {Display.replace, Display.paint} THEN r := S.LSH(ORD(p.rgb.red), -3); g := S.LSH(ORD(p.rgb.green), -3); b := S.LSH(ORD(p.rgb.blue), -3); S.PUT(adr, S.VAL(INTEGER, b + ASH(g, 5) + ASH(r, 10))) ELSIF mode = Display.invert THEN S.GET(adr, col); r := 255 - col DIV 1024 MOD 32; g := 255 - col DIV 32 MOD 32; b := 255 - col MOD 32; S.PUT(adr, S.VAL(INTEGER, b + ASH(g, 5) + ASH(r, 10))) END | 24: adr := base + x * 3; IF mode IN {Display.replace, Display.paint} THEN S.PUT(adr, p.rgb.blue); S.PUT(adr + 1, p.rgb.green); S.PUT(adr + 2, p.rgb.red) ELSIF mode = Display.invert THEN S.GET(adr, ch); S.PUT(adr, CHR(255 - ORD(ch))); S.GET(adr + 1, ch); S.PUT(adr, CHR(255 - ORD(ch))); S.GET(adr + 2, ch); S.PUT(adr, CHR(255 - ORD(ch))) END | 32: adr := base + x * 4; IF mode IN {Display.replace, Display.paint} THEN S.PUT(adr, p.rgb.blue); S.PUT(adr + 1, p.rgb.green); S.PUT(adr + 2, p.rgb.red) ELSIF mode = Display.invert THEN S.GET(adr, ch); S.PUT(adr, CHR(255 - ORD(ch))); S.GET(adr + 1, ch); S.PUT(adr, CHR(255 - ORD(ch))); S.GET(adr + 2, ch); S.PUT(adr, CHR(255 - ORD(ch))) END END END END SetPixel; 8O "c8Syntax10.Scn.FntcSyntax10i.Scn.FntIPR  u  N  a  7 VAR ch: CHAR; adr: LONGINT; set: SET; curx, cury, col, r, g, b: INTEGER; lastx, lasty: INTEGER; (* will not be painted, area to be painted is [x..lastX[, [y, lasty[ *) black: BOOLEAN; (* TRUE iff actually black, i.e. # Display.black, set pixel if paint in black *) BEGIN IF (x >= 0) & (x < p.width) & (y >=0) & (y < p.height) THEN INCL(p.flags, bitsChanged); IF p.width < x + w THEN lastx := p.width ELSE lastx := x + w END ; IF p.height < y + h THEN lasty := p.height ELSE lasty := y + h END ; CASE p.depth OF 1: black := p.col # Display.black; IF ~black & (mode = Display.paint) THEN RETURN END ; IF black THEN ch := 0FFX ELSE ch := 0X END ; cury := y; WHILE cury < lasty DO curx := x; WHILE curx MOD 8 # 0 DO p.SetPixel(curx, cury, mode); INC(curx) END ; adr := p.address + p.wth * cury + curx DIV 8; IF black & (mode = Display.invert) THEN WHILE (curx + 7) < lastx DO S.GET(adr, ch); set := S.VAL(SET, ch) * {0..7}; set := -set; S.PUT(adr, S.VAL(CHAR, set)); INC(adr); INC(curx, 8) END ELSIF mode IN {Display.replace, Display.paint} THEN WHILE (curx + 7) < lastx DO S.PUT(adr, ch); INC(adr); INC(curx, 8) END END ; WHILE curx < lastx DO p.SetPixel(curx, cury, mode); INC(curx) END ; INC(cury) END | 4: black := p.col # Display.black; IF (p.col = Display.black) & (mode = Display.paint) THEN RETURN END ; cury := y; ch := S.VAL(CHAR, S.VAL(SET, p.col) * {0..3} + S.VAL(SET, S.LSH(p.col, 4)) * {4..7}); WHILE cury < lasty DO curx := x; IF ODD(curx) THEN p.SetPixel(curx, cury, mode); INC(curx) END ; adr := p.address + p.wth * cury + curx DIV 2; IF (mode = Display.replace) OR (mode = Display.paint) & black THEN WHILE (curx + 1) < lastx DO S.PUT(adr, ch); INC(adr); INC(curx, 2) END ELSIF mode = Display.invert THEN WHILE (curx + 1) < lastx DO S.GET(adr, ch); col := S.VAL(INTEGER, S.VAL(SET, ch) * {4..7}); col := 15 - S.LSH(col, -4); col := S.LSH(col, 4) + 15 - S.VAL(INTEGER, S.VAL(SET, ch) * {0..3}); ch := CHR(col); S.PUT(adr, ch); INC(adr); INC(curx, 2) END END ; IF curx < lastx THEN p.SetPixel(curx, cury, mode) END ; INC(cury) END | 8: IF (p.col = Display.black) & (mode = Display.paint) THEN RETURN END ; cury := y; WHILE cury < lasty DO curx := x; adr := p.address + p.wth * cury + curx; IF mode IN {Display.replace, Display.paint} THEN WHILE curx < lastx DO S.PUT(adr, CHR(p.col)); INC(adr); INC(curx) END ELSE (* mode = Display.invert *) WHILE curx < lastx DO S.GET(adr, ch); col := ORD(ch); IF col <= 15 THEN S.PUT(adr, CHR(15 - col)) ELSE S.PUT(adr, CHR(255 - col)) END ; INC(adr); INC(curx) END END ; INC(cury) END | 16: cury := y; WHILE cury < lasty DO curx := x; adr := p.address + p.wth * cury + curx * 2; r := S.LSH(ORD(p.rgb.red), -3); g := S.LSH(ORD(p.rgb.green), -3); b := S.LSH(ORD(p.rgb.blue), -3); col := S.VAL(INTEGER, b + ASH(g, 5) + ASH(r, 10)); IF mode IN {Display.replace, Display.paint} THEN WHILE curx < lastx DO S.PUT(adr, col); INC(adr, 2); INC(curx) END ELSE (* mode = Display.invert *) WHILE curx < lastx DO S.GET(adr, col); r := 255 - col DIV 1024 MOD 32; g := 255 - col DIV 32 MOD 32; b := 255 - col MOD 32; S.PUT(adr, S.VAL(INTEGER, b + ASH(g, 5) + ASH(r, 10))); INC(adr, 2); INC(curx) END END ; INC(cury) END | 24: cury := y; WHILE cury < lasty DO curx := x; adr := p.address + p.wth * cury + curx * 3; IF mode IN {Display.replace, Display.paint} THEN WHILE curx < lastx DO S.PUT(adr, p.rgb.blue); INC(adr); S.PUT(adr, p.rgb.green); INC(adr); S.PUT(adr, p.rgb.red); INC(adr); INC(curx) END ELSE (* mode = Display.invert *) WHILE curx < lastx DO S.GET(adr, ch); S.PUT(adr, CHR(255 - ORD(ch))); INC(adr); S.GET(adr, ch); S.PUT(adr, CHR(255 - ORD(ch))); INC(adr); S.GET(adr, ch); S.PUT(adr, CHR(255 - ORD(ch))); INC(adr); INC(curx) END END ; INC(cury) END | 32: cury := y; WHILE cury < lasty DO curx := x; adr := p.address + p.wth * cury + curx * 4; IF mode IN {Display.replace, Display.paint} THEN WHILE curx < lastx DO S.PUT(adr, p.rgb.blue); INC(adr); S.PUT(adr, p.rgb.green); INC(adr); S.PUT(adr, p.rgb.red); INC(adr); INC(adr); INC(curx) END ELSE (* mode = Display.invert *) WHILE curx < lastx DO S.GET(adr, ch); S.PUT(adr, CHR(255 - ORD(ch))); INC(adr); S.GET(adr, ch); S.PUT(adr, CHR(255 - ORD(ch))); INC(adr); S.GET(adr, ch); S.PUT(adr, CHR(255 - ORD(ch))); INC(adr); INC(adr); INC(curx) END END ; INC(cury) END END END END ReplConst; 8? :8{Syntax10.Scn.FntSyntax10i.Scn.FntHFg8FoldElemsNewSyntax10.Scn.Fnt7'KeplerElemsAllocKeplerGraphsGraphDescKeplerGraphsStarDesc~}~~~}~}}|~~ } ~ }  ~~ |{z{z{{y{z{z||yKepler1TextureDescKepler1RectangleDescKepler1AttrDesc KeplerFramesCaptionDesc(x0, y0)Syntax10.Scn.Fnt (x1, y1)Syntax10.Scn.Fnt y0 < y1Syntax10.Scn.Fnt  y0 > y1Syntax10.Scn.Fnty0 = y1, x0 < x1Syntax10.Scn.Fnt !"#$y0 = y1, x0 > x1Syntax10.Scn.Fnt%E28@ %!% $ # VAR lastx, lasty: INTEGER; (* will not be copied, area to be copied is [sx..lastX[, [sy, lasty[ *) r, g, b, x0, y0, x, y: INTEGER; nofBytes, bpp, sAdr, dAdr: LONGINT; how to copy without messing up overlapping regions BEGIN (*Out.F4("$sx=#, sy=#, w=#, h=#", sx, sy, w, h); Out.F2(", dx=#, dy=#", dx, dy);*) IF (sx >= 0) & (sx < p.width) & (sy >= 0) & (sy < p.height) & (dx >= 0) & (dx < dP.width) & (dy >= 0) & (dy < dP.height) THEN INCL(dP.flags, bitsChanged); IF p.width < sx + w THEN lastx := p.width ELSE lastx := sx + w END ; IF dP.width < lastx THEN lastx := dP.width END ; IF p.height < sy + h THEN lasty := p.height ELSE lasty := sy + h END ; IF dP.height < lasty THEN lasty := dP.height END ; (* IF (p.depth = dP.depth) & (p.address # dP.address) & (p.depth >= 8) THEN (* optimisation *) bpp := p.depth DIV 8; nofBytes := bpp * (lastx - sx); sAdr := p.address + p.wth * y0 + x0 * bpp; dAdr := dP.address + dP.wth * y + x * bpp; FOR y0 := lasty - 1 TO sy BY -1 DO S.MOVE(sAdr, dAdr, nofBytes); INC(sAdr, p.wth); INC(dAdr, dP.wth) END ; RETURN END ; *) IF sy < dy THEN (* copy top most pixels first *) y := dy + lasty - sy; FOR y0 := lasty - 1 TO sy BY -1 DO x := dx; FOR x0 := sx TO lastx - 1 DO p.GetPixelRGB(x0, y0, r, g, b); dP.SetColorRGB(r, g, b); dP.SetPixel(x, y, mode); INC(x) END ; DEC(y) END ELSIF sy > dy THEN (* copy bottom most pixels first *) y := dy; FOR y0 := sy TO lasty - 1 DO x := dx; FOR x0 := sx TO lastx - 1 DO p.GetPixelRGB(x0, y0, r, g, b); dP.SetColorRGB(r, g, b); dP.SetPixel(x, y, mode); INC(x) END ; INC(y) END ELSIF (* sy = dy *) sx < dx THEN (* copy right most pixels first *) x := dx + lastx - sx; FOR x0 := lastx - 1 TO sx BY -1 DO y := dy; FOR y0 := sy TO lasty - 1 DO p.GetPixelRGB(x0, y0, r, g, b); dP.SetColorRGB(r, g, b); dP.SetPixel(x, y, mode); INC(y) END ; DEC(x) END ELSE (* (sy = dy) & (sx >= dx) *) (* copy left most pixels first *) x := dx; FOR x0 := sx TO lastx - 1 DO y := dy; FOR y0 := sy TO lasty - 1 DO p.GetPixelRGB(x0, y0, r, g, b); dP.SetColorRGB(r, g, b); dP.SetPixel(x, y, mode); INC(y) END ; INC(x) END END END END CopyBlock; 8:/ 68#Syntax10.Scn.Fnt VAR r: LONGINT; BEGIN Win32.SetClippingArea(0, 0, Win32.DispW, Win32.DispH); r := StretchDIBits(Win32.hdcDisp, dx, Win32.DispH - (dy + dh), dw, dh, sx, sy, sw, sh, p.address, S.ADR(p.bmi), BMPBase.DIBRGBCOLORS, SRCCOPY) END DrawStretched; 8;/I8#Syntax10.Scn.Fnt VAR r: LONGINT; BEGIN Win32.SetClippingArea(f.X, f.Y, f.W, f.H); r := StretchDIBits(Win32.hdcDisp, dx, Win32.DispH - (dy + dh), dw, dh, sx, sy, sw, sh, p.address, S.ADR(p.bmi), BMPBase.DIBRGBCOLORS, SRCCOPY) END DrawStretchedC; 8?\8#Syntax10.Scn.FntYY BEGIN p.DrawStretched(0, 0, p.width,p.height, x, y, p.width, p.height, mode) END Draw; 8?.8#Syntax10.Scn.Fnt__ BEGIN p.DrawStretchedC(f, 0, 0, p.width, p.height, x, y, p.width, p.height, mode) END DrawC; 8?%8#Syntax10.Scn.FntJJ BEGIN Printer.Picture(x, y, dw, dh, mode, S.VAL(LONGINT, p)) END Print; 8?+b8#Syntax10.Scn.Fnt|| VAR m: UpdateMsg; BEGIN m.p := p; m.new := new; m.x := x; m.y := y; m.w := w; m.h := h; Viewers.Broadcast(m) END Update; 8 /}8#Syntax10.Scn.Fntaa BEGIN Win32.GlobalUnlock(o(Picture).handle); Win32.GlobalFree(o(Picture).handle) END FreeMem; 8O'88Syntax10.Scn.FntSyntax10i.Scn.Fntb,Syntax10b.Scn.Fnt4%$   CONST FixedAndZeroInit = 40H; VAR i, r, g, b: INTEGER; size: LONGINT; BEGIN IF ~(depth IN {1, 4, 8, 16, 24}) & (depth # 32) THEN HALT(99) END ; p.width := 0; p.height := 0; p.depth := 0; p.wth := ((width * depth + 7) DIV 8 + ALIGN - 1) DIV ALIGN * ALIGN; size := p.wth * height; IF size <= 1024 + 12 THEN S.NEW(p.ptr, size); p.handle := 0; p.address := S.ADR(p.ptr^) ELSE (* allocate memory block outside of Oberon heap *) p.ptr := NIL; p.handle := Win32.GlobalAlloc(FixedAndZeroInit, size); IF p.handle = 0 THEN ShowError.Do("Pictures.Init, GlobalAlloc"); RETURN END ; p.address := Win32.GlobalLock(p.handle); IF p.address = 0 THEN ShowError.Do("Pictures.Init"); Win32.GlobalFree(p.handle); RETURN END ; Kernel.RegisterObject(p, FreeMem) END ; p.width := width; p.height := height; p.depth := depth; p.nofCols := ASH(1, depth); p.bmi.size := SIZE(BMPBase.BMPInfoHeader); p.bmi.width := width; p.bmi.height := height; p.bmi.planes := 1; p.bmi.bits := depth; p.bmi.compression := BMPBase.RGB; (* no run length encoding *) p.bmi.sizeImage := 0; (* not necessary for uncompressed format *) p.bmi.clrUsed := 0; (* use default value according to depth *) p.bmi.clrImportant := 0; (* use all indices in palette table *) Display.GetColor(Display.black, r, g, b); p.SetColorRGB(r, g, b); p.ReplConst(0, 0, width, height, Display.replace); IF depth = 1 THEN Display.GetColor(Display.black, r, g, b); p.SetPalette(0, r, g, b); Display.GetColor(Display.white, r, g, b); p.SetPalette(1, r, g, b); ELSIF depth IN {4, 8} THEN FOR i := 0 TO SHORT(p.nofCols - 1) DO Display.GetColor(i, r, g, b); p.SetPalette(i, r, g, b) END END ; p.flags := {bitsChanged, palChanged} (* SC - 26.5.1998 *) END Init; 87S8Syntax10.Scn.FntSyntax10i.Scn.Fnt5=k$ B{% VAR bytes : POINTER TO ARRAY OF S.BYTE; oneBit : S.BYTE; help : SHORTINT; ret, fieldlen, w, hBitmap, hdcMem, len : LONGINT; wf : Win32.Font; dim : RECORD dx, dy : LONGINT END ; dx, dy, i, j: INTEGER; BEGIN (*---- filter out all tabs and stop at first CR/LF *) len := 0; WHILE (s[len] # 0X) & (s[len] # CR) & (s[len] # LF) DO IF s[len] = TAB THEN s[len] := ' ' END ; INC(len) END ; s[len] := 0X; (*---- open a bitmap with dimensions of text, write text into bitmap *) hdcMem := Win32.CreateCompatibleDC(Win32.hdcDisp); wf := S.VAL(Win32.Font, f.raster); ret := Win32.SelectObject(hdcMem, wf.hfont); ret := GetTextExtentPoint(hdcMem, S.ADR(s[0]), len, S.ADR(dim)); hBitmap := Win32.CreateBitmap(dim.dx, dim.dy, 1, 1, 0); ret := Win32.SelectObject(hdcMem, hBitmap); Win32.TextOut(hdcMem, 0, 0, S.ADR(s[0]), len); (*---- assertion : text written in a bitmap *) (*---- now scan the bitmap for the text pixels, build and fill byte-array *) dx := SHORT(dim.dx); dy := SHORT(dim.dy); (* NEW(bits, dx*dy);*) IF (dx MOD 16 # 0) THEN w := dx + (16 - dx MOD 16) ELSE w := dx END ; fieldlen := (w * dy) DIV 8; NEW(bytes, fieldlen); ret := GetBitmapBits(hBitmap, fieldlen, S.ADR(bytes[0])); w := w DIV 8; FOR i := 0 TO dy - 1 DO FOR j := 0 TO dx - 1 DO oneBit := S.ROT(bytes[i * w + (j DIV 8)], (j + 1) MOD 8); (* mask one bit from array *) help := S.VAL(SHORTINT, oneBit); IF~ODD(help) THEN p.SetPixel(x + j, y + dy - i, mode) END (*bits[(i * dx) + j] := (help MOD 2) = 0*) END END ; Win32.DeleteDC(hdcMem) END Text; 8/(8_Syntax10.Scn.FntSyntax10i.Scn.Fnt$Zq+z VAR i, j, idx, ip3: INTEGER; err, ln: ARRAY 1280 * 3 OF INTEGER; r, g, b: INTEGER; pix, K, K1, K2, error, err7, err3, err5, w, w3: INTEGER; BEGIN FOR i := 0 TO 255 DO p.bmi.palette[i] := i END ; (* set identity palette *) w := p.width; w3 := w * 3; (* Floyd/Steinberg error diffusion dithering, cf. Foley, van Damm: Computer Graphics page 573 *) FOR i := 0 TO LEN(err) - 1 DO err[i] := 0 END ; FOR j := p.height - 1 TO 0 BY -1 DO FOR i := 0 TO w - 1 DO GetPixelRGB(p, i, j, r, g, b); idx := i * 3; ln[idx] := r + err[idx]; INC(idx); ln[idx] := g + err[idx]; INC(idx); ln[idx] := b + err[idx]; err[idx - 2] := 0; err[idx - 1] := 0; err[idx] := 0; END ; pix := 3; ln[w3] := 0; ln[w3 + 1] := 0; ln[w3 + 2] := 0; FOR i := 0 TO w3 - 1 DO K2 := K1; K1 := K; K := ln[i] DIV 42; IF K > 5 THEN K := 5 ELSIF K < 0 THEN K := 0 END ; error := ln[i] - (K * 42 + 21); ip3 := i + 3; IF ABS(ln[i] - ln[ip3]) > 42 THEN error := 0 END ; (* avoid strange effects on dark/light borders *) err7 := error * 7 DIV 16; err3 := error * 3 DIV 16; err5 := error * 5 DIV 16; INC(ln[ip3], err7); IF i > 2 THEN INC(err[i - 3], err3) END ; INC(err[i], err5); INC(err[ip3], error - err7 - err3 - err5); DEC(pix); IF pix = 0 THEN p.col := K2 * 36 + K1 * 6 + K + 20; SetPixel(p, i DIV 3, j, Display.replace); pix := 3 END END END END Dither; 8 5 THEN K := 5 ELSIF K < 0 THEN K := 0 END ; error := ln[i] - (K * 42 + 21); ip3 := i + 3; IF ABS(ln[i] - ln[ip3]) > 42 THEN error := 0 END ; (* avoid strange effects on dark/light borders *) err7 := error * 7 DIV 16; err3 := error * 3 DIV 16; err5 := error * 5 DIV 16; INC(ln[ip3], err7); IF i > 2 THEN INC(dt.err[i - 3], err3) END ; INC(dt.err[i], err5); INC(dt.err[ip3], error - err7 - err3 - err5); DEC(pix); IF pix = 0 THEN p.SetColorIdx(K2 * 36 + K1 * 6 + K + 20); p.SetPixel(i DIV 3, j, Display.replace); pix := 3 END END ; INC(j) END ; IF ((Oberon.Time() - dt.lastUpdateTime) > 0.5 * Input.TimeUnit) OR (j >= p.height) THEN (* at least half a second between updates, don't forget the last update *) dt.lastUpdateTime := Oberon.Time(); p.Update(NIL, 0, dt.lastUpdateY, p.width, j - dt.lastUpdateY); dt.lastUpdateY := j END ; dt.cury := j; IF j >= p.height THEN p.flags := dt.oldFlags + {dithered}; Oberon.Remove(dt) END END Dithering; 8 =/s?.a.8 Syntax10.Scn.FntPSyntax10b.Scn.Fnt(Syntax10i.Scn.Fnt 7I-3-3 VAR i, dummy: INTEGER; id1, id2: CHAR; filelen, len, offset, startPos: LONGINT; ch: CHAR; w: Files.Rider; buf: ARRAY 4096 OF CHAR; red, green, blue: INTEGER; info: BMPBase.BMPInfoHeaderOS2; ptr: S.PTR; BEGIN startPos := Files.Pos (r); Files.Read (r, id1); Files.Read (r, id2); IF (id1 # 'B') OR (id2 # 'M') THEN res := -1; RETURN END ; Files.ReadLInt (r, filelen); (* file length *) Files.ReadInt (r, dummy); ASSERT(dummy = 0); Files.ReadInt (r, dummy); ASSERT(dummy = 0); Files.ReadLInt (r, offset); (* offset of data *) Files.ReadLInt(r, len); (* lookahead: size of INFOHEADER *) Files.Set(r, Files.Base(r), Files.Pos(r) - 4); (* restart before INFOHEADER *) IF len = SIZE(BMPBase.BMPInfoHeader) THEN Files.ReadBytes(r, p.bmi, SIZE(BMPBase.BMPInfoHeader)); IF p.bmi.clrUsed = 0 THEN p.nofCols := ASH(1, p.bmi.bits) ELSE p.nofCols := p.bmi.clrUsed END ; p.Init(SHORT(p.bmi.width), SHORT(p.bmi.height), p.bmi.bits); IF p.width = 0 THEN res := -1; RETURN END ; IF p.depth <= 8 THEN FOR i := 0 TO SHORT(p.nofCols - 1) DO Files.Read(r, ch); blue := ORD(ch); Files.Read(r, ch); green := ORD(ch); Files.Read(r, ch); red := ORD(ch); Files.Read(r, ch); p.SetPalette(i, red, green, blue); (* dithering necessary to improve colour quality *) END END ; Files.Set(r, Files.Base(r), startPos + offset); ptr := S.VAL(S.PTR, p.address); CASE p.bmi.compression OF BMPBase.RGB: Files.ReadBytes(r, ptr^, p.wth * p.height) (* not filelen - offset, since we cannot rely on these *) | BMPBase.RLE4, BMPBase.RLE8: Out.Ln; Out.String("Compressed bitmaps cannot be loaded. "); Out.String("You can decompress them with the command Conversions.RLEToBMP."); res := -1; RETURN | BMPBase.BitFields: Out.String("bitfields compression used!") ELSE HALT(69) END ; ptr := NIL; res := 0; Files.Set(r, Files.Base(r), startPos); p.f := Files.New(""); Files.Set(w, p.f, 0); WHILE filelen > 0 DO IF filelen > 4096 THEN len := 4096 ELSE len := filelen END ; Files.ReadBytes(r, buf, len); Files.WriteBytes(w, buf, len - r.res); DEC(filelen, len) END ; ELSIF len = SIZE(BMPBase.BMPInfoHeaderOS2) THEN (* OS/2 Bitmap Format, Version 1.2 *) Files.ReadBytes(r, info, SIZE(BMPBase.BMPInfoHeaderOS2)); p.nofCols := ASH(1, info.bits); p.Init(info.width, info.height, info.bits); IF p.width = 0 THEN res := -1; RETURN END ; IF p.depth <= 8 THEN FOR i := 0 TO SHORT(p.nofCols - 1) DO Files.Read(r, ch); blue := ORD(ch); Files.Read(r, ch); green := ORD(ch); Files.Read(r, ch); red := ORD(ch); p.SetPalette(i, red, green, blue) (* dithering necessary to improve colour quality *) END END ; Files.Set(r, Files.Base(r), startPos + offset); ptr := S.VAL(S.PTR, p.address); Files.ReadBytes(r, ptr^, p.wth * p.height); (* not filelen - offset, since we cannot rely on these *) ptr := NIL; res := 0; Files.Set(r, Files.Base(r), startPos); p.f := Files.New(""); Files.Set(w, p.f, 0); DEC(filelen, offset); WHILE filelen > 0 DO IF filelen > 4096 THEN len := 4096 ELSE len := filelen END ; Files.ReadBytes(r, buf, len); Files.WriteBytes(w, buf, len - r.res); DEC(filelen, len) END ; ELSE HALT(69) END ; p.flags := p.flags - {palChanged, bitsChanged} END Load; 8?8mSyntax10.Scn.Fnt Syntax10i.Scn.FntON k2  VAR r0: Files.Rider; buf: ARRAY 4096 OF CHAR; offset, filelen: LONGINT; i: INTEGER; ptr: S.PTR; j, red, green, blue, matchedCol: INTEGER; BEGIN IF ((p.flags * {bitsChanged, palChanged} = {}) OR (p.flags * {bitsChanged, palChanged, dithered} = {dithered})) & (p.f # NIL) THEN (* SC - 26.5.1998 *) Files.Set(r0, p.f, 0); REPEAT Files.ReadBytes(r0, buf, 4096); Files.WriteBytes(r, buf, 4096 - r0.res) UNTIL r0.eof ELSE Files.Write(r, 'B'); Files.Write(r, 'M'); IF p.depth <= 8 THEN offset := ASH(1, p.depth) * 4 ELSE offset := 0 END ; INC(offset, SIZE(BMPBase.BMPInfoHeader)); INC(offset, 2 + 4 + 2 + 2 + 4); (* BITMAPFILEHEADER *) filelen := offset + p.wth * p.height; Files.WriteLInt(r, filelen); (* file length *) Files.WriteInt(r, 0); Files.WriteInt(r, 0); Files.WriteLInt(r, offset); Files.WriteBytes(r, p.bmi, SIZE(BMPBase.BMPInfoHeader)); IF p.depth <= 8 THEN FOR i := 0 TO SHORT(p.nofCols) - 1 DO p.GetPalette(i, red, green, blue); Files.Write(r, CHR(blue)); Files.Write(r, CHR(green)); Files.Write(r, CHR(red)); Files.Write(r, 0X) END ; WHILE i < ASH(1, p.depth) DO Files.WriteLInt(r, 0); INC(i) END END ; ptr := S.VAL(S.PTR, p.address); Files.WriteBytes(r, ptr^, p.wth * p.height); ptr := NIL END END Store; 8y:$ 8#Syntax10.Scn.Fnt CONST CFBitmap = 2; CFDib = 8; VAR done: BOOLEAN; binfo: BMPBase.BMPInfoColorTable; h, ret, i: LONGINT; r, g, b: INTEGER; buf: S.PTR; bmi: BMPBase.BMPInfoColorTable; adr, colors: LONGINT; BEGIN res := 1; done := Win32.OpenClipboard(Win32.Display); IF done THEN h := Win32.GetClipboardData(CFBitmap); IF h # NULL THEN binfo.size := SIZE(BMPBase.BMPInfoHeader); binfo.width := 0; binfo.height := 0; ret := GetDIBits(Win32.hdcDisp, h, 0, 0, 0, S.ADR(binfo), BMPBase.DIBRGBCOLORS); p.Init(SHORT(binfo.width), SHORT(binfo.height), binfo.bits); S.NEW(buf, p.wth); FOR i := 0 TO binfo.height - 1 DO ret := GetDIBits(Win32.hdcDisp, h, i, 1, S.ADR(buf^), S.ADR(binfo), BMPBase.DIBRGBCOLORS); S.MOVE(S.ADR(buf^), p.address + p.wth * i, p.wth) END ; IF binfo.bits <= 8 THEN FOR i := 0 TO ASH(1, binfo.bits) - 1 DO r := ORD(binfo.color[i].red); g := ORD(binfo.color[i].green); b := ORD(binfo.color[i].blue); p.SetPalette(SHORT(i), r, g, b) END END ; p.flags := {bitsChanged}; res := 0; IF ASH(1, p.depth) >= Win32.NumColors THEN Dither(p) END ELSE h := Win32.GetClipboardData(CFDib); IF h # NULL THEN adr := Win32.GlobalLock(h); IF adr # 0 THEN S.MOVE(adr, S.ADR(bmi), SIZE(BMPBase.BMPInfoColorTable)); p.Init(SHORT(bmi.width), SHORT(bmi.height), bmi.bits); IF bmi.clrUsed > 0 THEN colors := bmi.clrUsed ELSE colors := ASH(1, bmi.bits) END ; IF colors <= 256 THEN FOR i := 0 TO colors - 1 DO p.SetPalette(SHORT(i), ORD(bmi.color[i].red), ORD(bmi.color[i].green), ORD(bmi.color[i].blue)) END ; adr := adr + SIZE(BMPBase.BMPInfoHeader) + SIZE(BMPBase.FileRGB) * colors ELSE adr := adr + SIZE(BMPBase.BMPInfoHeader) END ; S.MOVE(adr, p.address, p.wth * p.height); Win32.GlobalUnlock(h); p.flags := {bitsChanged}; res := 0; IF ASH(1, p.depth) >= Win32.NumColors THEN Dither(p) END END END END ; Win32.CloseClipboard END END Paste; 8y:!g8#Syntax10.Scn.Fntww CONST SRCCOPY = 0CC0020H; CFBitmap = 2; VAR done: BOOLEAN; ret, hnd, oldbitmap, bitmap, hdcMem: LONGINT; BEGIN done := Win32.OpenClipboard(Win32.Display); IF done THEN hdcMem := Win32.CreateCompatibleDC(Win32.hdcDisp); bitmap := Win32.CreateCompatibleBitmap(Win32.hdcDisp, p.width, p.height); ret := Win32.SelectObject(hdcMem, bitmap); ret := StretchDIBits(hdcMem, 0, 0, p.width, p.height, 0, 0, p.width, p.height, p.address, S.ADR(p.bmi), BMPBase.DIBRGBCOLORS, SRCCOPY); Win32.EmptyClipboard; hnd := Win32.SetClipboardData(CFBitmap, bitmap); Win32.CloseClipboard; Win32.DeleteDC(hdcMem); END END Copy; 8 /Yk8#Syntax10.Scn.Fntss VAR i: SHORTINT; BEGIN i := 0; WHILE loaders[i] # NIL DO INC(i) END ; loaders[i] := loader END RegisterFormat; 8 /28#Syntax10.Scn.Fnt VAR i: SHORTINT; li: LoadInfo; loader: Loader; BEGIN i := 0; li := NIL; WHILE (i < maxLoaders) & (li = NIL) DO IF loaders[i] # NIL THEN loader := loaders[i]; li := loader (file, pos) END ; INC(i) END ; RETURN li END Load; 8 /48#Syntax10.Scn.Fnt++ VAR r: Files.Rider; li: LoadInfo; id1, id2: CHAR; BEGIN Files.Set (r, f, pos); Files.Read (r, id1); Files.Read (r, id2); IF (id1 # 'B') OR (id2 # 'M') THEN RETURN NIL END ; NEW (li); li.res := needData; li.usedBytes := 0; li.picture := NIL; Files.Set (li.r, f, pos); RETURN li END BmpLoader; 8/ $|8#Syntax10.Scn.Fntbb BEGIN IF ASH(1, li.picture.depth) >= Win32.NumColors THEN Dither(li.picture) END END Completed; 8/H8#Syntax10.Scn.Fnt VAR pos: LONGINT; BEGIN IF li.res # error THEN pos := Files.Pos (li.r); IF li.picture = NIL THEN NEW (li.picture) END ; li.picture.Load (li.r, li.res); li.picture.Update (NIL, 0, 0, li.picture.width, li.picture.height); li.usedBytes := Files.Pos (li.r) - pos END END Do; 8 O8#Syntax10.Scn.Fnt\\ VAR mod: LONGINT; BEGIN mod := Kernel.LoadLibrary("GDI32"); Kernel.GetAdr(mod, "StretchDIBits", S.VAL(LONGINT, StretchDIBits)); Kernel.GetAdr(mod, "CreateBitmap", S.VAL(LONGINT, CreateBitmap)); Kernel.GetAdr(mod, "CreateCompatibleBitmap", S.VAL(LONGINT, CreateCompatibleBitmap)); Kernel.GetAdr(mod, "SetDIBits", S.VAL(LONGINT, SetDIBits)); Kernel.GetAdr(mod, "GetDIBits", S.VAL(LONGINT, GetDIBits)); Kernel.GetAdr(mod, "GetBitmapBits", S.VAL(LONGINT, GetBitmapBits)); Kernel.GetAdr(mod, "GetTextExtentPointA", S.VAL(LONGINT, GetTextExtentPoint)); loaders[maxLoaders-1] := BmpLoader END Init0; 8 +8#Syntax10.Scn.FntGG VAR dstRowStart, rowBytes, base: LONGINT; ver, hor, last: INTEGER; BEGIN IF (p.depth = 32) OR (p.depth = 24) THEN ASSERT(LEN(data)>=4*p.width); FOR ver := 0 TO h-1 DO FOR hor := 0 TO p.width-1 DO p.SetColorRGB(ORD(data[4*hor]), ORD(data[4*hor+1]), ORD(data[4*hor+2])); p.SetPixel(hor, y+ver, Display.replace); END END ELSE ASSERT(LEN(data)>=p.width); IF p.depth <= 8 THEN FOR ver := 0 TO h-1 DO FOR hor := 0 TO p.width-1 DO p.SetColorIdx(ORD(data[hor])); p.SetPixel(hor, y+ver, Display.replace) END END END END END SetScanLine; 8 (Q8#Syntax10.Scn.Fnt VAR hor, col, r, g, b: INTEGER; BEGIN IF p.depth = 32 THEN ASSERT(LEN(data)>=4*p.width); FOR hor := 0 TO p.width-1 DO p.GetPixelRGB(hor, y, r, g, b); data[4*hor] := CHR(r); data[4*hor+1] := CHR(g); data[4*hor+2] := CHR(b); data[4*hor+3] := CHR(0) END ELSIF p.depth = 24 THEN ASSERT(LEN(data)>=3*p.width); FOR hor := 0 TO p.width-1 DO p.GetPixelRGB(hor, y, r, g, b); data[3*hor] := CHR(r); data[3*hor+1] := CHR(g); data[3*hor+2] := CHR(b) END ELSE ASSERT(LEN(data)>=p.width); IF p.depth <= 8 THEN FOR hor := 0 TO p.width-1 DO p.GetPixelIdx(hor, y, col); data[hor] := CHR(col) END END END END GetScanLine; 8j(MODULE Pictures; (* CS, 14 Jun 96 -  *) IMPORT S := SYSTEM, ShowError, Kernel, Files, Viewers, Display, Printer, Win32, Oberon, Input, BMPBase, In, Out, Fonts; (* 2 color images (depth = 1, black and white): palette index 0: actually white, bit not set, Display.black palette index 1: actually black, bit set, Display.white 16 color images (depth = 4, 16 standard colors of Oberon): palette index 0: actually white, no bits set, 0000, Display.black palette index 1: red, 0001 palette index 2: green, 0010 palette index 3: blue, 0011 palette index 4: magenta, 0100 palette index 5: yellow, 0101 palette index 6: cyan, 0110 palette index 7: dark red, 0111 palette index 8: dark green, 1000 palette index 9: dark blue, 1001 palette index 10: sky blue, 1010 palette index 11: dark cyan, 1011 palette index 12: light grey, 1100 palette index 13: medium grey, 1101 palette index 14: dark grey, 1110 palette index 15: black, all bits set, 1111, Display.white 256 color images (depth = 8, 256 colors, including the 16 standard colors at indices 0..15) *) CONST SRCCOPY = 0CC0020H; NULL = 0; ALIGN = 4; (* bitmap bits are padded to multiples of so many bytes *) TAB = 9X; LF = 0AX; CR = 0DX; (** error codes for LoadInfoDesc.res *) done* = 0; needData* = 1; error* = 2; identityPalette = 0; bitsChanged = 1; palChanged = 2; dithered = 3; maxLoaders = 10; TYPE BMPInfo = RECORD (BMPBase.BMPInfoColorTable)  Picture* = POINTER TO PictureDesc;  UpdateMsg* = RECORD (Display.FrameMsg) (** this message is broadcast by p.Update(x, y, w, h) indicating that the region with the bottom-left corner (x, y), width w and height h of the picture has changed. *)  LoadInfo* = POINTER TO LoadInfoDesc; Loader* = PROCEDURE (file: Files.File; pos: LONGINT) : LoadInfo; (** is the type of procedures that can be registered to try to load files. *) LoadInfoDesc* = RECORD res*: INTEGER; (** either done, needData, or error *) usedBytes*: LONGINT; (** number of bytes that have already been loaded *) picture*: Picture; (** the picture that is being loaded *) r: Files.Rider END ; DitherTask = POINTER TO DitherTaskDesc; DitherTaskDesc = RECORD (Oberon.TaskDesc) p: Picture; cury, lastUpdateY: INTEGER; lastUpdateTime: LONGINT; oldFlags: SET; err: ARRAY 1280 * 3 OF INTEGER; oldColors: ARRAY 256 OF BMPBase.RGBColor END ; VAR StretchDIBits: PROCEDURE (hdc, dx, dy, dw, dh, sx, sy, sw, sh, bits, bmi, use, rop: LONGINT): LONGINT; CreateBitmap: PROCEDURE (width, height, planes, bitsPerPixel, bits: LONGINT): LONGINT; (* HBITMAP *) SetDIBits: PROCEDURE (hdc, hbmp, start, lines, bits, bmi, use: LONGINT): LONGINT; GetDIBits: PROCEDURE (hdc, hbmp, start, nofLines, bits, binfo, pal: LONGINT): LONGINT; CreateCompatibleBitmap: PROCEDURE (hdc, width, height: LONGINT): LONGINT; GetTextExtentPoint : PROCEDURE(hdcMem : LONGINT; lpStr : LONGINT; len : LONGINT; dim : LONGINT): LONGINT; GetBitmapBits : PROCEDURE(hBitmap : LONGINT; dwCount : LONGINT; lpBits : LONGINT): LONGINT; loaders: ARRAY maxLoaders OF Loader; PROCEDURE (p: Picture) SetPalette* (col, red, green, blue: INTEGER); (** stores the RGB values in the palette of the picture at index col, implicit color matching is performed if the respective RGB color is not available. After p.SetPalette(col, red, green, blue), SetColorRGB(red, green, blue) and SetColorIdx have the same effect. *)  PROCEDURE (p: Picture) GetPalette* (col: INTEGER; VAR red, green, blue: INTEGER); (** returns the RGB values that have previously been set with p.SetPalette(col, red, green, blue). *)  PROCEDURE (p: Picture) Idx (red, green, blue: INTEGER): INTEGER;  PROCEDURE (p: Picture) SetColorRGB* (red, green, blue: INTEGER); (** sets the current painting color to the color specified by the RGB triple. For palettte pictures color matching is performed if there is no palette entry for the specified RGB values *)  PROCEDURE (p: Picture) SetColorIdx* (col: INTEGER); (** sets the current painting color to the color that has previously been registered with p.SetPalette(col, red, green, blue). May only called for palette pictures, i.e. p.depth <= 8. *)  PROCEDURE (p: Picture) GetColorIdx* (VAR col: INTEGER); (** returns the current painting color. May only be called for palette pictures, i.e. p.depth <= 8. *)  PROCEDURE (p: Picture) GetColorRGB* (VAR r, g, b: INTEGER); (** returns the current painting color. *)  PROCEDURE (p: Picture) GetPixelIdx* (x, y: INTEGER; VAR col: INTEGER); (** returns the color index of the pixel at position (x, y). p.GetPalette(col, red, green, blue) can be used to obtain the RGB values. May only called for palette pictures, i.e. p.depth <= 8 *)  PROCEDURE (p: Picture) GetPixelRGB* (x, y: INTEGER; VAR red, green, blue: INTEGER); (** returns the RGB values of the pixel at position (x, y). *)  PROCEDURE (p: Picture) SetPixel* (x, y, mode: INTEGER); (** sets the pixel at position (x, y) with the respective mode (Display.replace, Display.paint, Display.invert) and the current painting color. *)  PROCEDURE (p: Picture) ReplConst* (x, y, w, h, mode: INTEGER); (** sets the pixels contained in the rectangle with the bottom-left corner (x, y), width w and height h, with the respective mode (Display.replace, Display.paint, Display.invert) and the current painting color. *)  PROCEDURE (p: Picture) CopyBlock* (dP: Picture; sx, sy, w, h, dx, dy, mode: INTEGER); (** copies the pixels contained in the rectangle with the bottom-left corner (sx, sy), width w and height h to the destination picture dp at the position (dx, dy), mode can be Display.replace, Display.paint, or Display.invert. *)  PROCEDURE (p: Picture) DrawStretched* (sx, sy, sw, sh, dx, dy, dw, dh, mode: INTEGER); (** draws the pixels contained in the rectangle with the bottom-left corner (sx, sy), width sw and height sh, within the rectangle on the screen with absolute screen coordinates (dx, dy), width dw and height dh. The mode is currently ignored. *)  PROCEDURE (p: Picture) DrawStretchedC* (f: Display.Frame; sx, sy, sw, sh, dx, dy, dw, dh, mode: INTEGER); (** like DrawStretched, additionally clipping is performed at the borders of the frame f, i.e. no pixels outside the rectangle (f.X, f.Y), width f.W, f.H are drawn. The mode is currently ignored. *)  PROCEDURE (p: Picture) Draw* (x, y, mode: INTEGER); (** draws the picture within the rectangle on the screen with absolute screen coordinates (x, y) *)  PROCEDURE (p: Picture) DrawC* (f: Display.Frame; x, y, mode: INTEGER); (** like Draw, additionally clipping is performed at the borders of the frame f, i.e. no pixels outside the rectangle (f.X, f.Y), width f.W, f.H are drawn.*)  PROCEDURE (p: Picture) Print* (x, y, dw, dh, mode: INTEGER); (** prints the picture within the rectangle with absolute printer coordinates (x, y), width w, and height h (width and height are currently ignored). *)  PROCEDURE (p: Picture) Update* (new: Picture; x, y, w, h: INTEGER); (** broadcasts an update message, the region with bottom-left corner (x, y), width w and height h has changed. Update is not called implicitly by making any changes to the picture. A picture receiving an UpdateMsg can e.g. redraw. *)  PROCEDURE FreeMem (o: S.PTR);  PROCEDURE (p: Picture) Init* (width, height, depth: INTEGER); (** initializes internal data structures of the picture, so that it can hold a picture of the specified width, height and color depth (e.g. for palette pictures the palette of the picture is set to the palette used by the environment). *)  PROCEDURE (p:Picture) Text*(s: ARRAY OF CHAR; x, y, mode: INTEGER; f: Fonts.Font); (* PROCEDURE (p: Picture) Dither;  *) PROCEDURE Dithering;  PROCEDURE Dither (p: Picture); VAR ditherTask: DitherTask; i, red, green, blue, r, g, b: INTEGER; necessary: BOOLEAN; BEGIN NEW(ditherTask); ditherTask.safe := FALSE; ditherTask.handle := Dithering; ditherTask.p := p; necessary := FALSE; IF p.depth <= 8 THEN FOR i := 0 TO 255 DO Display.GetColor(i, r, g, b); red := ORD(p.bmi.color[i].red); green := ORD(p.bmi.color[i].green); blue := ORD(p.bmi.color[i].blue); necessary := necessary OR (r # red) OR (g # green) OR (b # blue); ditherTask.oldColors[i] := p.bmi.color[i]; p.SetPalette(i, r, g, b) END ELSE necessary := TRUE END ; IF necessary THEN ditherTask.oldFlags := p.flags; FOR i := 0 TO LEN(ditherTask.err) - 1 DO ditherTask.err[i] := 0 END ; ditherTask.cury := 0; ditherTask.lastUpdateY := 0; ditherTask.lastUpdateTime := Oberon.Time(); Oberon.Install(ditherTask) END END Dither; PROCEDURE (p: Picture) Load* (VAR r: Files.Rider; VAR res: INTEGER); (** loads a picture from a bitmap file at the rider position, res = 0 on success, res = -1 on error. *)  PROCEDURE (p: Picture) Store* (VAR r: Files.Rider); (** stores the picture using the rider r, if the picture has not changed (and no dithering has been performed), the picture is stored again in the same way as it has been loaded, otherwise the picture is stored in the Windows Bitmap Format. *)  PROCEDURE (p: Picture) Paste* (VAR res: INTEGER); (** pastes a picture from the clipboard *)  PROCEDURE (p: Picture) Copy* (VAR res: INTEGER); (** copys a picture to the clipboard *)  PROCEDURE RegisterFormat* (loader: Loader); (** registers a loader that will be used to load pictures when calling Pictures.Load(f, pos). *)  PROCEDURE Load* (file: Files.File; pos: LONGINT) : LoadInfo; (** tries to load a picture from the file at the position pos. IF the return value is # NIL, the picture can be loaded. To initiate loading of the picture, call the Do method of the returned LoadInfo object. *)  PROCEDURE BmpLoader (f: Files.File; pos: LONGINT) : LoadInfo;  PROCEDURE (li: LoadInfo) Completed*; (** must be called at end of LoadInfo.Do *)  PROCEDURE (li: LoadInfo) Do*; (** method of the loader that must be invoked in order to load the picture. *)  PROCEDURE Init0;  PROCEDURE (p: Picture) SetScanLine* (VAR data: ARRAY OF CHAR; y, h: INTEGER); PROCEDURE (p: Picture) GetScanLine* (VAR data: ARRAY OF CHAR; y: INTEGER); BEGIN Init0 END Pictures.SetDither ^ on off System.Free PElems Pictures ~ System.State Pictures System.State Win32 Debugger.SetModules Pictures ~ Debugger.ReleaseModules Pictures ~ Colors.Open Clipboard.Snapshot drag Decoder.Decode Pictures