wSyntax10.Scn.Fnt=InfoElemsAllocUSyntax10.Scn.FntStampElemsAlloc2 Mar 99n"Title": Pictures for X11 "Author": RLI, with help of MAH "Abstract": Implements Pictures-Module as described in Pictures.Text "Keywords": Pictures, Graphics, BMP "Version": 0.01prealpha "From": 18 Dec 96 "Until":  "Changes": 18 Dec 96 MAH, RLI CleanUp from MacVersion, crucial parts left open 21 May 97 RLI Finished alpha version, clipping taken from Display - Module 19 Aug 97 RLI Pseudo color visual support, Get/SetScanline extensions 08 Oct 97 RLI InsertText included, Bug in Match fixed 08 Oct 97 RLI Bugs in GetPixelRGB fixed "Hints": Edit.Open Pictures.Text Parts of this module taken from Windows.bBalloonElemsAllocSyntax10.Scn.Fnt`Syntax10b.Scn.Fnt  Syntax10i.Scn.Fnt!& q  "BitmapInfoHeader" BitmapInfoHeader = RECORD size, width, height: LONGINT; planes, bits: INTEGER; compression, sizeImage, xPelsPerMeter, yPelsPerMeter, clrUsed, clrImportant: LONGINT END; BitmapInfoHeader contains basic information about a .bmp - Picture: size contains the size of the BitmapInfoHeader in Byte width, height refer to the size of the Picture planes must be 1 bits represents the depth of the picture, i.e. 1, 4, 8, 24 or 32 compression must be 0 in order to work with Pictures sizeImage is only relevant for compressed Pictures xPelsPerMeter and yPelsPerMeter define the resolution of the Picture in Pixels per Meter clrUsed contains the number of used colors or 0 clrImportant contains the number of important colors "Picture" The central Type of Pictures. See PictureDesc and Pictures.Text for detailed description. "PictureDesc" PictureDesc* = RECORD width-, height-, depth-: INTEGER; (* width and height of Bitmap *) pictData: POINTER TO ARRAY OF CHAR; (* raw image data *) bpl: LONGINT; (* bytes per line in raw data *) rgb: RGB; col: SHORTINT; registered: BOOLEAN; infoHead: BitmapInfoHeader; pixels: ARRAY 256 OF LONGINT; (* Handle to X11 - Color cell *) cols: ARRAY 256 OF RECORD red, green, blue: INTEGER END END; pixels and cols are redundant for efficiency reasons "Gc" The X11-Graphics context needed for almost every operation under X. Since there is no possibility to access the gc of Module Display, Pictures has it's own gc. Note that the gc is allocated but never freed with XFree(...). Since this behaviour is the same in all modules (e.g. Display) I guess it does not matter much. "CreateGC" See Gc for details "Window" Window is needed for clipping only. Clipping is taken from Display. "Secondary" This procedure was taken from Display. "InitPictures" Initializes the global TrueColor palette. Unfortunately this process takes a while. This part should be optimized. "Print" You need a special Oberon.Header.ps to print Pictures.cSyntax10b.Scn.Fnt .  Syntax10i.Scn.Fnt  v O   ;      /W8FoldElemsNew#Syntax10.Scn.Fnt VAR p: Picture; BEGIN p := S.VAL(Picture, o); IF (p.pictData # 0) THEN Kernel.free(p.pictData); p.pictData := 0 END END Finalizer; 8 ,88 0y8#Syntax10.Scn.Fntee BEGIN red := p.cols[col].red; green := p.cols[col].green; blue := p.cols[col].blue END GetPalette; 8 8cSyntax10.Scn.Fnt}Syntax10b.Scn.FntkSyntax10i.Scn.Fnt VAR i, cnt, idx: INTEGER; m, match: LONGINT; PROCEDURE Match (idx: INTEGER) : LONGINT; VAR red, green, blue: INTEGER; r2, g2, b2: LONGINT; BEGIN p.GetPalette (idx, red, green, blue); r2 := red-r; g2 := green-g; b2 := blue-b; RETURN r2*r2 + g2*g2 + b2*b2; END Match; PROCEDURE checkCache(r, g, b: INTEGER; VAR idx: INTEGER): BOOLEAN; VAR i: INTEGER; BEGIN i := 0; WHILE (i < cacheSize) & ((r # pCache[i].r) OR (g # pCache[i].g) OR (b # pCache[i].b)) DO INC(i); END; idx := pCache[i].idx; RETURN i < cacheSize; END checkCache; BEGIN IF useCache & checkCache(r, g, b, idx) THEN p.col := SHORT(idx); (* INC(cacheHits); *) RETURN END; (* INC(cacheMisses); *) p.rgb.red := r; p.rgb.green := g; p.rgb.blue := b; IF p.depth <= 8 THEN (* find matching color index *) cnt := SHORT (ASH (1, p.depth)); idx := 0; match := Match (0); FOR i := 1 TO cnt - 1 DO m := Match(i); IF m < match THEN match := m; idx := i END END; p.col := SHORT (idx); FOR i := 0 TO cacheSize-2 DO pCache[i] := pCache[i+1]; END; pCache[cacheSize-1].r := r; pCache[cacheSize-1].g := g; pCache[cacheSize-1].b := b; pCache[cacheSize-1].idx := idx; END END SetColorRGB; 8 8CSyntax10.Scn.FntSyntax10i.Scn.Fnt5~ VAR r, g, b: INTEGER; BEGIN (* IF (X11.depth <= 8) THEN ASSERT(col <= 27) END; *) p.col := SHORT(col); Display.GetColor(col, r, g, b); p.rgb.red := r; p.rgb.green := g; p.rgb.blue := b END SetColorIdx; 8 8#Syntax10.Scn.FntUU BEGIN IF p.depth <= 8 THEN col := p.col ELSE col := - 1 END END GetColorIdx; 8 8#Syntax10.Scn.FntKK BEGIN r := p.rgb.red; g := p.rgb.green; b := p.rgb.blue END GetColorRGB; 8A8;8"8e88#Syntax10.Scn.Fnt BEGIN res := error END Copy; 88#Syntax10.Scn.Fnt BEGIN res := error END Paste; 8 o8{Syntax10.Scn.FnteSyntax10i.Scn.FntP_^M3O VAR base, adr: LONGINT; ch: CHAR; set: SET; col, pcol: 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 base := p.pictData + p.bpl * 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 (* Compiler bug (?) workaround, RLI, 14 May 1997 *) pcol := p.col; ch := S.VAL(CHAR, S.VAL(SET, ch) * {0..3} + S.VAL(SET, S.LSH(pcol, 4)) * {4..7}) END ; 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(p.rgb.red, - 3); g := S.LSH(p.rgb.green, - 3); b := S.LSH(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); INC(adr); S.PUT(adr, p.rgb.green); INC(adr); S.PUT(adr, p.rgb.red) ELSIF mode = Display.invert THEN 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))) END | 32: adr := base + x * 4; IF mode IN {Display.replace, Display.paint} THEN S.PUT(adr, p.rgb.blue); INC(adr); S.PUT(adr, p.rgb.green); INC(adr); S.PUT(adr, p.rgb.red) ELSIF mode = Display.invert THEN 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))) END END END END SetPixel; 8 8CSyntax10.Scn.FntSyntax10i.Scn.FntZ (* mode la Display, fllt (x,y) w,h mit Farbe p.col oder p.rgb je nach Art des Bildes *) VAR i, j: INTEGER; pixVal, dummy: LONGINT; BEGIN FOR i := x TO x + w DO FOR j := y TO y + h DO p.SetPixel(i, j, mode) END END END ReplConst; 8)8-y8&a8#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 VAR pix: LONGINT; i: INTEGER; red, green, blue, idx: CHAR; BEGIN IF (x >= 0) & (x < p.width) & (y >= 0) & (y < p.height) THEN IF p.depth > 8 THEN S.GET(p.pictData + y * p.bpl + x * 3, blue); S.GET(p.pictData + y * p.bpl + x * 3 + 1, green); S.GET(p.pictData + y * p.bpl + x * 3 + 2, red); r := ORD(red); g := ORD(green); b := ORD(blue) ELSIF p.depth = 8 THEN S.GET(p.pictData + y * p.bpl + x, idx); i := ORD(idx); p.GetPalette(i, r, g, b) ELSIF p.depth = 4 THEN S.GET(p.pictData + y * p.bpl + x DIV 2, idx); i := ORD(idx); IF ODD(x) THEN i := i MOD 16 ELSE i := i DIV 16 END; p.GetPalette(i, r, g, b) ELSIF p.depth = 1 THEN S.GET(p.pictData + y * p.bpl + x DIV 8, idx); i := ORD(idx); IF S.BIT(S.ADR(i), 7 - (x MOD 8)) THEN p.GetPalette(1, r, g, b) ELSE p.GetPalette(0, r, g, b) END END END; END GetPixelRGB; 8 $8#Syntax10.Scn.Fnt   VAR c: CHAR; BEGIN ASSERT (p.depth <= 8); IF (x >= 0) & (x < p.width) & (y >= 0) & (y < p.height) THEN IF p.depth = 8 THEN S.GET(p.pictData + y * p.bpl + x, c); col := ORD(c) ELSIF p.depth = 4 THEN S.GET(p.pictData + y * p.bpl + x DIV 2, c); col := ORD(c); IF ODD(x) THEN col := col DIV 16 ELSE col := col MOD 16 END ELSIF p.depth = 1 THEN S.GET(p.pictData + y * p.bpl + x DIV 8, c); col := ORD(c); IF S.BIT(S.ADR(col), x MOD 8) THEN col := 1 ELSE col := 0 END END END END GetPixelIdx; 8M8fSyntax10.Scn.FntSyntax10i.Scn.Fnt- N VAR filelen, offset: LONGINT; rgb: FileRGB; blue, green, red, cnt, i, filler, y, x, depth: INTEGER; dstRowStart, rowBytes, f, m, pixVal: LONGINT; bbb: ARRAY 4*1024 OF CHAR; buffer: POINTER TO ARRAY OF CHAR; BEGIN Files.Write(r, 'B'); Files.Write(r, 'M'); IF p.depth < 24 THEN offset := ASH(1, p.depth) * 4 ELSE offset := 0 END ; INC(offset, SIZE(BitmapInfoHeader)); INC(offset, 2 + 4 + 2 + 2 + 4); (* BITMAPFILEHEADER *) IF p.depth = 32 THEN depth := 24 ELSE depth := p.depth END; filelen := offset + p.height * (((p.width * depth + 7) DIV 8 + 4 - 1) DIV 4 * 4); (* filelen := offset + p.width * p.height; *) Files.WriteLInt(r, filelen); (* file length *) Files.WriteInt(r, 0); Files.WriteInt(r, 0); Files.WriteLInt(r, offset); Files.WriteLInt (r, p.infoHead.size); Files.WriteLInt (r, p.infoHead.width); Files.WriteLInt (r, p.infoHead.height); Files.WriteInt (r, p.infoHead.planes); Files.WriteInt (r, p.infoHead.bits); Files.WriteLInt (r, p.infoHead.compression); Files.WriteLInt (r, p.infoHead.sizeImage); Files.WriteLInt (r, p.infoHead.xPelsPerMeter); Files.WriteLInt (r, p.infoHead.yPelsPerMeter); Files.WriteLInt (r, p.infoHead.clrUsed); Files.WriteLInt (r, p.infoHead.clrImportant); IF p.depth <= 8 THEN cnt := SHORT (ASH (1, p.depth)); FOR i := 0 TO cnt - 1 DO p.GetPalette(i, blue, green, red); rgb.b := CHR(blue); rgb.g := CHR(green); rgb.r := CHR(red); Files.WriteBytes (r, rgb, 4) END END; NEW(buffer, p.bpl); FOR y := 0 TO p.height - 1 DO S.MOVE(p.pictData + y * p.bpl, S.ADR(buffer^), p.bpl); Files.WriteBytes(r, buffer^, p.bpl) END END Store; 8 5T8mSyntax10.Scn.FntSyntax10i.Scn.FntG8g8FoldElemsNewSyntax10.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; start, end: LONGINT; how to copy without messing up overlapping regions BEGIN useCache := TRUE; FOR x := 0 TO cacheSize-1 DO pCache[x].r := -1 END; IF (sx >= 0) & (sx < p.width) & (sy >= 0) & (sy < p.height) & (dx >= 0) & (dx < dP.width) & (dy >= 0) & (dy < dP.height) THEN 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 sy < dy THEN (* copy top most pixels first *) y := dy; 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 + lasty - 1 - sy; 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 - 1 - 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; useCache := FALSE; END CopyBlock; 8@88 MarkElemsAlloc 3 THEN K := 3 ELSIF K < 0 THEN K := 0 END ; error := ln[i] - (K * 64); IF ABS(ln[i] - ln[ip3]) > 64 THEN error := 0 END (* avoid strange effects on dark/light borders *) ELSE K := ln[i] DIV 51; IF K > 4 THEN K := 4 ELSIF K < 0 THEN K := 0 END ; error := ln[i] - (K * 51); IF ABS(ln[i] - ln[ip3]) > 51 THEN error := 0 END (* avoid strange effects on dark/light borders *) END; 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 * 25 + K1 * 5 + K + 16); 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 Oberon.Remove(dt) END END Dithering; 8  1 THEN K := 1 ELSIF K < 0 THEN K := 0 END ; error := ln[i] - (K * 64); IF ABS(ln[i] - ln[ip3]) > 128 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 IF K + K1 + K2 > 2 THEN p.SetColorIdx(Display.black) ELSE p.SetColorIdx(Display.white) END; 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 Oberon.Remove(dt) END END DitheringBW; 8 =/8#Syntax10.Scn.FntKK VAR ditherTask: DitherTask; i, red, green, blue, r, g, b: INTEGER; necessary: BOOLEAN; BEGIN NEW(ditherTask); ditherTask.safe := FALSE; IF X11.colorClass = X11.monochrome THEN ditherTask.handle := DitheringBW ELSE ditherTask.handle := Dithering END; ditherTask.p := p; necessary := X11.depth <= 8; IF p.depth <= 8 THEN FOR i := 0 TO 255 DO Display.GetColor(i, r, g, b); red := p.cols[i].red; green := p.cols[i].green; blue := p.cols[i].blue; necessary := necessary OR (r # red) OR (g # green) OR (b # blue); ditherTask.oldColors[i] := p.cols[i]; p.SetPalette(i, r, g, b) END END ; IF necessary THEN 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; 88/\828#Syntax10.Scn.Fnt__ VAR p2: Picture; x, y: LONGINT; col, r, g, b: INTEGER; BEGIN NEW(p2); p2.Init(dw, dh, p.depth); p2.pixels := p.pixels; p2.cols := p.cols; FOR y := 0 TO dh - 1 DO FOR x := 0 TO dw - 1 DO IF p.depth <= 8 THEN p.GetPixelIdx(SHORT(sx + x * sw DIV dw), SHORT(sy + y * sh DIV dh), col); p2.SetColorIdx(col); p2.SetPixel(SHORT(x), SHORT(y), Display.replace) ELSE p.GetPixelRGB(SHORT(sx + x * sw DIV dw), SHORT(sy + y * sh DIV dh), r, g, b); p2.SetColorRGB(r, g, b); p2.SetPixel(SHORT(x), SHORT(y), Display.replace) END END END; p2.Draw(dx, dy, mode) END DrawStretched; 83p8CSyntax10.Scn.FntSyntax10i.Scn.FntN VAR cliprect: X11.Rectangle; BEGIN IF X11.lclen > 0 THEN X11.FlushLCache END ; cliprect.x := F.X; cliprect.y := X11.Height - F.Y - F.H; cliprect.w := F.W; cliprect.h := F.H; IF F.Y >= 0 THEN Window := X11.primary ELSE Window := X11.secondary; INC(cliprect.y, X11.UBottom) END ; IF (cliprect.x <= 0) & (cliprect.y <= 0) & (cliprect.w >= X11.Width) & (cliprect.h >= X11.Height) THEN (* no clipping *) X11.SetClipMask(X11.display, Gc, X11.None) ELSE X11.SetClipRectangles(X11.display, Gc, 0, 0, S.ADR(cliprect), 1, X11.YXBanded) END; RETURN Window = X11.secondary END Secondary; 8D8CSyntax10.Scn.FntSyntax10i.Scn.Fnt BEGIN IF Secondary(f) THEN DEC(dy, X11.UBottom) END; p.DrawStretched(sx, sy, sw, sh, dx, dy, dw, dh, mode); X11.SetClipMask(X11.display, Gc, X11.None) (* Turn off clipping *) END DrawStretchedC; 8*8#Syntax10.Scn.Fnt__ BEGIN p.DrawStretchedC (f, 0, 0, p.width, p.height, x, y, p.width, p.height, mode) END DrawC; 838#Syntax10.Scn.Fnt VAR r, g, b, re, gr, bl: INTEGER; xc: X11.Color; dummy: LONGINT; pm: LONGINT; pal: ARRAY 4, 4, 4 OF LONGINT; BEGIN IF X11.depth >= 16 THEN ELSE END END InitPictures; 8&P8CSyntax10.Scn.FntFSyntax10i.Scn.Fnt n BEGIN Printer.Picture (x, y, destW, destH, mode, S.VAL (LONGINT, p)) (* Printer still open ??? *) END Print; 8 l8#Syntax10.Scn.Fntrr VAR i: SHORTINT; BEGIN i := 0; WHILE loaders[i] # NIL DO INC(i) END; loaders[i] := loader END RegisterFormat; 8 .8#Syntax10.Scn.Fnt VAR i: SHORTINT; li: LoadInfo; loader: Loader; BEGIN i := 0; 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@8#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 8QSyntax10.Scn.FntSyntax10i.Scn.Fnt47 (** must be called after last call of LoadInfo.Do *) BEGIN IF ASH(1, li.picture.depth) >= X11.nofcol THEN Dither(li.picture) END END Completed; 88#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; 88#Syntax10.Scn.Fnt BEGIN Gc := X11.CreateGC(X11.display, X11.primary, 0, 0); IF Gc = 0 THEN HALT(45) END ; X11.SetPlaneMask(X11.display, Gc, X11.planesMask); X11.SetGraphicsExposures(X11.display, Gc, X11.True); X11.SetBackground(X11.display, Gc, X11.background) END CreateGC; 8  g8{Syntax10.Scn.FntCSyntax10i.Scn.Fnt5H~^/30 VAR bytes : POINTER TO ARRAY OF S.BYTE; oneBit : S.BYTE; help : SHORTINT; ret, fieldlen, w, i, j, hBitmap, hdcMem : LONGINT; dim : RECORD dx, miny, maxy : INTEGER END ; h, curx: INTEGER; pix: X11.Pixmap; xfont: X11.Font; xmet: X11.MetricDesc; pat: Display.Pattern; xpat: X11.Pattern; ximg: X11.Image; BEGIN (*---- filter out all tabs and stop at first CR/LF *) i := 0; WHILE (text[i] # 0X) & (text[i] # CR) & (text[i] # LF) DO IF text[i] = TAB THEN text[i] := ' ' END ; INC(i) END ; text[i] := 0X; len := i; (*---- open a bitmap with dimensions of text, write text into bitmap *) xfont := S.VAL(X11.Font, font); dim.dx := 0; dim.miny := 0; dim.maxy := 0; FOR i := 0 TO len - 1 DO xmet := xfont.metrics[ORD(text[i])]; dim.dx := dim.dx + xmet.dx; h := xmet.p.h + xmet.y; IF xmet.y < dim.miny THEN dim.miny := xmet.y END; IF h > dim.maxy THEN dim.maxy := h END END; X11.SetForeground(X11.display, Gc, X11.foreground); X11.SetBackground(X11.display, Gc, X11.background); IF X11.colorClass = X11.color THEN X11.SetFunction(X11.display, Gc, X11.GXcopy); ELSE X11.SetFunction(X11.display, Gc, X11.GXequiv); END; pix := X11.CreatePixmap(X11.display, X11.primary, dim.dx, dim.maxy - dim.miny, X11.depth); curx := 0; FOR i := 0 TO len - 1 DO xmet := xfont.metrics[ORD(text[i])]; X11.CopyPlane(X11.display, xmet.p.pixmap, pix, Gc, xmet.p.x, xmet.p.y, xmet.p.w, xmet.p.h, curx + xmet.x, dim.maxy - xmet.p.h - xmet.y, 1); curx := curx + xmet.dx END; X11.CopyPlane(X11.display, pix, X11.primary, Gc, 0, 0, dim.dx, dim.maxy - dim.miny, 50, 50, 1); (*---- assertion : text written in a bitmap *) (*---- now scan the bitmap for the text pixels *) dx := SHORT(dim.dx); dy := SHORT(dim.maxy-dim.miny); NEW(bits, dx*dy); ximg := X11.GetImage(X11.display, pix, 0, 0, dim.dx, dim.maxy - dim.miny, 1, X11.XYPixmap); FOR i := 0 TO dy - 1 DO FOR j := 0 TO dx - 1 DO bits[(i * dx) + j] := (X11.GetPixel(ximg, j, i)) = 1; END END END ConvertText; 8O8#Syntax10.Scn.Fnt VAR i, j : INTEGER; BEGIN ASSERT (bits # NIL); FOR i := 0 TO dy - 1 DO FOR j := 0 TO dx - 1 DO IF bits[(i * dx) + j] THEN p.SetPixel(x + j, y + dy - i, mode); END END END END SetText; 8 GN8#Syntax10.Scn.Fnt VAR bits: BitField; dx, dy: INTEGER; BEGIN ConvertText(f.raster, s, len, bits, dx, dy); p.SetText(bits, dx, dy, x, y, mode) END InsertText; 8 +|8#Syntax10.Scn.Fntbb 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 ((8#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; 888(MODULE Pictures;   IMPORT S := SYSTEM, Display, Files, Printer, Kernel, Viewers, X11, Oberon, Input, Fonts; CONST done* = 0; needData* = 1; error* = 2; maxLoaders = 10; TAB = 9X; LF = 0AX; CR = 0DX; cacheSize = 64; TYPE BitmapInfoHeader = RECORD size, width, height: LONGINT; planes, bits: INTEGER; compression, sizeImage, xPelsPerMeter, yPelsPerMeter, clrUsed, clrImportant: LONGINT END; RGB = RECORD red, green, blue: INTEGER END; Picture* = POINTER TO PictureDesc; PictureDesc* = RECORD width-, height-, depth-: INTEGER; (* width and height of Bitmap *) pictData: LONGINT; (* raw image data *) bpl: LONGINT; (* bytes per line in raw data *) rgb: RGB; col: SHORTINT; registered: BOOLEAN; infoHead: BitmapInfoHeader; pixels: ARRAY 256 OF LONGINT; (* Handle to X11 - Color cell *) cols: ARRAY 256 OF RGB END; FileRGB = RECORD r, g, b, reserved: CHAR END; UpdateMsg* = RECORD (Display.FrameMsg) p*, new*: Picture; x*, y*, w*, h*: INTEGER END; LoadInfo* = POINTER TO LoadInfoDesc; Loader* = PROCEDURE (file: Files.File; pos: LONGINT) : LoadInfo; LoadInfoDesc* = RECORD res*: INTEGER; usedBytes*: LONGINT; picture*: Picture; r: Files.Rider END; DitherTask = POINTER TO DitherTaskDesc; DitherTaskDesc = RECORD (Oberon.TaskDesc) p: Picture; cury, lastUpdateY: INTEGER; lastUpdateTime: LONGINT; err: ARRAY 1280 * 3 OF INTEGER; oldColors: ARRAY 256 OF RGB END ; BitField* = POINTER TO ARRAY OF BOOLEAN; PCache = ARRAY cacheSize+1 OF RECORD r, g, b: INTEGER; idx: INTEGER; END; VAR Gc: X11.GC; Window: X11.Window; loaders: ARRAY maxLoaders OF Loader; pCache: PCache; useCache: BOOLEAN; (* cacheHits, cacheMisses: LONGINT; *) PROCEDURE Finalizer (o: S.PTR);  PROCEDURE (p: Picture) SetPalette* (col: INTEGER; red, green, blue: INTEGER);  VAR xc: X11.Color; x: LONGINT; y: INTEGER; BEGIN xc.red := red * 256; xc.green := green * 256; xc.blue := blue * 256; xc.flags := CHR(7); IF X11.depth > 8 THEN x := X11.AllocColor(X11.display, X11.cmap, S.ADR(xc)); ASSERT(x # 0, 100); p.pixels[col] := xc.pixel ELSE y := (blue DIV 64) * 25 + (green DIV 52) * 5 + red DIV 52; p.pixels[col] := X11.pixelValues[y + 16] END; p.cols[col].red := red; p.cols[col].green := green; p.cols[col].blue := blue END SetPalette;  PROCEDURE (p: Picture) GetPalette* (col: INTEGER; VAR red, green, blue: INTEGER);  PROCEDURE (p: Picture) SetColorRGB* (r, g, b: INTEGER);  PROCEDURE (p: Picture) SetColorIdx* (col: INTEGER);  PROCEDURE (p: Picture) GetColorIdx* (VAR col: INTEGER);  PROCEDURE (p: Picture) GetColorRGB* (VAR r, g, b: INTEGER);  PROCEDURE InitPic (p: Picture; width, height, depth: INTEGER);  VAR filler: INTEGER; h, w: LONGINT; BEGIN p.depth := depth; p.width := width; p.height := height; h := height; w := width; filler := SHORT (ENTIER (w * p.depth / 8)); IF w * p.depth / 8 # filler THEN INC (filler) END; filler := (4 - filler MOD 4) MOD 4; IF p.depth <= 8 THEN p.bpl := SHORT(((w * p.depth + 7) DIV 8) + filler); ELSE p.bpl := SHORT(w * 3 + filler) END; ASSERT(p.bpl >= 0); p.pictData := Kernel.malloc(h * p.bpl); ASSERT(p.pictData # 0); IF ~p.registered THEN Kernel.RegisterObject (p, Finalizer); p.registered := TRUE END END InitPic;  PROCEDURE (p: Picture) Init* (width, height, depth: INTEGER);  VAR r, g, b: INTEGER; BEGIN InitPic (p, width, height, depth); IF p.depth = 0 THEN RETURN END; IF p.depth = 8 THEN (* set standard palette *) FOR r := 0 TO 5 DO FOR g := 0 TO 5 DO FOR b := 0 TO 6 DO p.SetPalette(b+g*7+r*42, r*43, g*43, b*37) END; END; END; END; p.infoHead.size := 40; p.infoHead.width := width; p.infoHead.height := height; p.infoHead.planes := 1; p.infoHead.bits := depth; p.infoHead.compression := 0; p.infoHead.sizeImage := 0; p.infoHead.xPelsPerMeter := 0; p.infoHead.yPelsPerMeter := 0; p.infoHead.clrUsed := 0; p.infoHead.clrImportant := 0 END Init;  PROCEDURE (p: Picture) Copy* (VAR res: INTEGER);  PROCEDURE (p: Picture) Paste* (VAR res: INTEGER);  PROCEDURE (p: Picture) SetPixel* (x, y, mode: INTEGER);  PROCEDURE (p: Picture) ReplConst* (x, y, w, h, mode: INTEGER);  PROCEDURE (p: Picture) Load* (VAR r: Files.Rider; VAR res: INTEGER);  VAR i, dummy, cnt, bits: INTEGER; id1, id2: CHAR; y, width, height, offset, startPos, filelen: LONGINT; rgb: FileRGB; buffer: POINTER TO ARRAY OF CHAR; BEGIN startPos := Files.Pos (r); Files.Read (r, id1); Files.Read (r, id2); IF (id1 # 'B') OR (id2 # 'M') THEN res := error; RETURN END; Files.ReadLInt (r, filelen); Files.ReadInt (r, dummy); ASSERT (dummy = 0); Files.ReadInt (r, dummy); ASSERT(dummy = 0); Files.ReadLInt (r, offset); (* offset of data *) Files.ReadLInt (r, p.infoHead.size); Files.ReadLInt (r, p.infoHead.width); Files.ReadLInt (r, p.infoHead.height); Files.ReadInt (r, p.infoHead.planes); Files.ReadInt (r, p.infoHead.bits); Files.ReadLInt (r, p.infoHead.compression); Files.ReadLInt (r, p.infoHead.sizeImage); Files.ReadLInt (r, p.infoHead.xPelsPerMeter); Files.ReadLInt (r, p.infoHead.yPelsPerMeter); Files.ReadLInt (r, p.infoHead.clrUsed); Files.ReadLInt (r, p.infoHead.clrImportant); IF p.infoHead.compression > 0 THEN HALT (99) END; width := p.infoHead.width; height := p.infoHead.height; bits := p.infoHead.bits; InitPic (p, SHORT (width), SHORT (height), p.infoHead.bits); IF p.depth = 0 THEN res := error; RETURN END; IF bits <= 8 THEN cnt := SHORT (ASH (1, bits)); FOR i := 0 TO cnt - 1 DO Files.ReadBytes (r, rgb, 4); p.SetPalette(i, ORD(rgb.b), ORD(rgb.g), ORD(rgb.r)) END END; Files.Set (r, Files.Base (r), offset + startPos); ASSERT(p.pictData # 0); NEW(buffer, p.bpl); FOR y := 0 TO height - 1 DO Files.ReadBytes(r, buffer^, p.bpl); S.MOVE(S.ADR(buffer^), p.pictData + y * p.bpl, p.bpl) END; p.height := SHORT(height); p.width := SHORT(width); res := done END Load;  PROCEDURE (p: Picture) Update* (new: Picture; x, y, w, h: INTEGER);  PROCEDURE (p: Picture) GetPixelRGB* (x, y: INTEGER; VAR r, g, b: INTEGER);  PROCEDURE (p: Picture) GetPixelIdx* (x, y: INTEGER; VAR col: INTEGER);  PROCEDURE (p: Picture) Store* (VAR r: Files.Rider);  PROCEDURE (p: Picture) CopyBlock* (dP: Picture; sx, sy, w, h, dx, dy, mode: INTEGER);  PROCEDURE (p: Picture) GetPixelValue (idx: LONGINT): LONGINT;  VAR res: LONGINT; r, g, b: CHAR; y: INTEGER; BEGIN S.GET(p.pictData + idx, b); S.GET(p.pictData + idx + 1, g); S.GET(p.pictData + idx + 2, r); IF X11.depth >= 24 THEN res := ORD(b) + ASH(ORD(g), 8) + ASH(ORD(r), 16) ELSIF X11.depth > 8 THEN (* This is rather heuristic *) res := ASH(ORD(r), - 3) + ASH(ASH(ORD(g), - 2), 5) + ASH(ASH(ORD(b), - 3), 11) ELSE y := (ORD(r) DIV 64) * 25 + (ORD(g) DIV 52) * 5 + ORD(b) DIV 52; res := X11.pixelValues[y + 16] END; RETURN res END GetPixelValue;  PROCEDURE Dithering;  PROCEDURE DitheringBW;  PROCEDURE Dither (p: Picture);  PROCEDURE (p: Picture) Draw* (dx, dy, mode: INTEGER);  VAR iPtr: X11.ImagePtr; img: X11.Image; filler, bits: INTEGER; x, y, z, n, dummy2: LONGINT; c: CHAR; BEGIN IF (p.pictData = 0) THEN RETURN END; bits := p.infoHead.bits; img := X11.CreateImage(X11.display, X11.visualptr, X11.depth, X11.ZPixmap, 0, 0, p.width, p.height, 8, 0); ASSERT(img # 0); iPtr := S.VAL(X11.ImagePtr, img); ASSERT(iPtr # NIL); iPtr.data := Kernel.malloc(iPtr.bytesPerLine * p.height); ASSERT(iPtr.data # 0); (* filler: Anz alignment Bytes im .BMP-Datei *) filler := SHORT (ENTIER (p.width * bits / 8)); IF p.width * bits / 8 # filler THEN INC (filler) END; filler := (4 - filler MOD 4) MOD 4; IF p.depth > 8 THEN z := 0; FOR y := 0 TO p.height - 1 DO FOR x := 0 TO p.width - 1 DO dummy2 := X11.PutPixel(img, x, p.height - y - 1, p.GetPixelValue(z)); INC(z, 3) END; z := z + filler END ELSIF p.depth = 8 THEN FOR y := 0 TO p.height - 1 DO FOR x := 0 TO p.width - 1 DO S.GET(p.pictData + y * p.bpl + x, c); dummy2 := X11.PutPixel(img, x, p.height - y - 1, p.pixels[ORD(c)]) END END ELSIF p.depth = 4 THEN FOR y := 0 TO p.height - 1 DO FOR x := 0 TO p.bpl - 1 DO S.GET(p.pictData + y * p.bpl + x, c); z := ORD(c); IF x * 2 < p.width THEN dummy2 := X11.PutPixel(img, x * 2 + 1, p.height - y - 1, p.pixels[z DIV 16]) END; IF (x * 2 + 1) < p.width THEN dummy2 := X11.PutPixel(img, x * 2, p.height - y - 1, p.pixels[z MOD 16]) END END END ELSIF p.depth = 1 THEN FOR y := 0 TO p.height - 1 DO FOR x := 0 TO p.bpl - 1 DO FOR n := 0 TO 7 DO IF x * 8 + n < p.width THEN IF S.BIT(p.pictData + y * p.bpl + x, 7 - n) THEN dummy2 := X11.PutPixel(img, x * 8 + n, p.height - y - 1, p.pixels[1]) ELSE dummy2 := X11.PutPixel(img, x * 8 + n, p.height - y - 1, p.pixels[0]) END END END END END END; IF (p.width = 0) OR (p.height = 0) THEN RETURN END; X11.SetFunction(X11.display, Gc, X11.function[mode]); X11.PutImage(X11.display, X11.primary, Gc, img, 0, 0, dx, Display.Height - dy - p.height, p.width, p.height); Kernel.free(iPtr.data); X11.Free(img) END Draw;  PROCEDURE (p: Picture) DrawStretched* (sx, sy, sw, sh, dx, dy, dw, dh, mode: INTEGER);  PROCEDURE Secondary (F: Display.Frame): BOOLEAN;  PROCEDURE (p: Picture) DrawStretchedC* (f: Display.Frame; sx, sy, sw, sh, dx, dy, dw, dh, mode: INTEGER);  PROCEDURE (p: Picture) DrawC* (f: Display.Frame; x, y, mode: INTEGER);  PROCEDURE InitPictures;  PROCEDURE (p: Picture) Print* (x, y, destW, destH, mode: INTEGER);  PROCEDURE RegisterFormat* (loader: Loader);  PROCEDURE Load* (file: Files.File; pos: LONGINT) : LoadInfo;  PROCEDURE BmpLoader (f: Files.File; pos: LONGINT) : LoadInfo;  PROCEDURE (li: LoadInfo) Completed*;  PROCEDURE (li: LoadInfo) Do*;  PROCEDURE CreateGC;  PROCEDURE ConvertText* (font : Display.Font; text : ARRAY OF CHAR; len : LONGINT; VAR bits: BitField; VAR dx, dy: INTEGER);  PROCEDURE (p: Picture) SetText (bits: BitField; dx, dy, x, y, mode : INTEGER);  PROCEDURE (p: Picture) InsertText* (s: ARRAY OF CHAR; len: INTEGER; x, y, mode: INTEGER; f: Fonts.Font);  PROCEDURE (p: Picture) SetScanLine* (VAR data: ARRAY OF CHAR; y, h: INTEGER);  PROCEDURE (p: Picture) GetScanLine* (VAR data: ARRAY OF CHAR; y: INTEGER);  BEGIN CreateGC; InitPictures; loaders[maxLoaders - 1] := BmpLoader; (* cacheHits := 0; cacheMisses := 0; *) useCache := FALSE;  END Pictures.