Oberon/ETH Oberon/2.3.7/GfxDisplay.Mod

(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich. Refer to the license.txt file provided with this distribution. *) MODULE GfxDisplay; (** portable *)	(* eos 05.01.03 20:13:30 *) (** 		Raster contexts on Oberon display 	**) (* 		10.12.98 - first release; derived from former GfxDev 		16.4.99 - bugfix in CopyIndex and BlendIndex: used wrong offset into bitmap 		19.4.99 - uses Display transfer and truecolor functionality 		[26.5.99 - use 300 dpi metrics in Show (removed 14.7.99)] 		25.8.99 - replaced GfxMaps with Images/GfxImages 		10.8.99 - scratched SetPoint, added Close method 		17.11.1999 - added Colors 		13.02.2000 - new get/set clip methods 	*) IMPORT Display, Fonts, Colors, Images, GfxMatrix, GfxImages, GfxRegions, GfxFonts, Gfx, GfxRaster; CONST red = Images.r; green = Images.g; blue = Images.b; alpha = Images.a; 		MaxRun = 256; TYPE Context* = POINTER TO ContextDesc; ContextDesc* = RECORD (GfxRaster.ContextDesc) orgX*, orgY*: REAL;	(** origin of default coordinate system **) scale*: REAL;	(** scale factor of default coordinate system **) defClip*: GfxRegions.Region;	(** default clipping region **) bg*: Gfx.Color;	(** background color for erasing **) bgCol: Display.Color;	(* display color corresponding to background color *) bgPix: Images.Pixel;	(* pixel value corresponding to background color *) dcol: Display.Color;	(* current display color *) srcOverDst: Images.Mode;	(* srcOverDst mode with current color *) END; RegData = RECORD (GfxRegions.EnumData) dc: Context; dx, dy: INTEGER; pat: Display.Pattern; img: Images.Image; col: Display.Color; END; BlendDotProc = PROCEDURE (dc: Context; img: Images.Image; mx, my: INTEGER; x, y: LONGINT); CopyRunProc = PROCEDURE (img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); BlendRunProc = PROCEDURE (dc: Context; img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); WarpProc = PROCEDURE (dc: Context; img: Images.Image; dx, dy, x0, y0, x1, y1: INTEGER; VAR m: GfxMatrix.Matrix; VAR f: GfxImages.Filter); CopyImageProc = PROCEDURE (dc: Context; img: Images.Image; dx, dy: INTEGER; VAR filter: GfxImages.Filter); VAR TrueColor, TransferBlock: BOOLEAN;	(* set if corresponding Display features are available *) Methods: Gfx.Methods; BlendDot: BlendDotProc;	(* copies dot from pattern to display *) CopyRun: CopyRunProc;	(* copies run from image to display *) BlendRun: BlendRunProc;	(* blends buffer run with display *) TileRect: GfxRegions.Enumerator;	(* fills rectangular area with pattern *) Warp: WarpProc;	(* applies matrix to image and stores result in buffer *) BlendImageRect: GfxRegions.Enumerator;	(* blends image rectangle *) CopyImage: CopyImageProc;	(* copies visible parts of image to display *) Buffer: Images.Image;	(* shadow map *) PROCEDURE CreateBuffer (w, h: INTEGER); BEGIN (* 			Display.TransferBlock on Windows Oberon requires that the size of the supplied memory block is a 			multiple of 4 bytes. We therefore ensure that one row occupies at least 4 bytes and allocate one 			row more than requested. 		*) IF w * Images.DisplayFormat.bpp < 32 THEN w := 32 DIV Images.DisplayFormat.bpp END; Images.Create(Buffer, w, h+1, Images.DisplayFormat) END CreateBuffer; (*--- Blend Dot Into Display ---*) PROCEDURE BlendDotBlk (dc: Context; img: Images.Image; mx, my: INTEGER; x, y: LONGINT); VAR buf: ARRAY 4 OF CHAR; BEGIN IF Images.alpha IN img.fmt.components THEN	(* get original color from display *) Display.TransferBlock(buf, 0, 0, x, y, 1, 1, Display.get) END; Images.GetPixels(img, mx, my, 1, Images.DisplayFormat, buf, dc.srcOverDst); Display.TransferBlock(buf, 0, 0, x, y, 1, 1, Display.set) END BlendDotBlk; PROCEDURE BlendDotRGB (dc: Context; img: Images.Image; mx, my: INTEGER; x, y: LONGINT); VAR pix: Images.Pixel; BEGIN IF Images.alpha IN img.fmt.components THEN pix := dc.bgPix END; Images.GetPixels(img, mx, my, 1, Images.PixelFormat, pix, dc.srcOverDst); Display.Dot(Display.RGB(ORD(pix[red]), ORD(pix[green]), ORD(pix[blue])), x, y, Display.replace) END BlendDotRGB; PROCEDURE BlendDotIdx (dc: Context; img: Images.Image; mx, my: INTEGER; x, y: LONGINT); VAR buf: ARRAY 1 OF CHAR; BEGIN IF Images.alpha IN img.fmt.components THEN buf[0] := CHR(dc.bgCol) END; Images.GetPixels(img, mx, my, 1, Images.D8, buf, dc.srcOverDst); Display.Dot(ORD(buf[0]), x, y, Display.replace) END BlendDotIdx; PROCEDURE Dot (rc: GfxRaster.Context; x, y: LONGINT); VAR dc: Context; img: Images.Image; mw, mh, mx, my: INTEGER; BEGIN IF (rc.clipState = GfxRaster.In) OR 			(rc.clipState = GfxRaster.InOut) & GfxRegions.RectInside(SHORT(x), SHORT(y), SHORT(x+1), SHORT(y+1), rc.clipReg) THEN IF rc.pat = NIL THEN Display.Dot(rc(Context).dcol, x, y, Display.replace) ELSE dc := rc(Context); img := dc.pat.img; mw := img.width; mh := img.height; mx := SHORT(x - ENTIER(dc.orgX + dc.pat.px + 0.5)) MOD mw; my := SHORT(y - ENTIER(dc.orgY + dc.pat.py + 0.5)) MOD mh; BlendDot(dc, img, mx, my, x, y) 			END END END Dot; (*--- Draw Run ---*) PROCEDURE DrawRunRGB (VAR buf: ARRAY OF CHAR; len, x, y: LONGINT); VAR i, l: LONGINT; r, g, b: CHAR; BEGIN i := 0; WHILE len > 0 DO 			r := buf[i + red]; g := buf[i + green]; b := buf[i + blue]; INC(i, 3); l := 1; WHILE (l < len) & (buf[i + red] = r) & (buf[i + green] = g) & (buf[i + blue] = b) DO 				INC(i, 3); INC(l) END; Display.ReplConst(Display.RGB(ORD(r), ORD(g), ORD(b)), x, y, l, 1, Display.replace); INC(x, l); DEC(len, l) 		END END DrawRunRGB; PROCEDURE DrawRunIdx (VAR buf: ARRAY OF CHAR; len, x, y: LONGINT); VAR i, l: LONGINT; idx: CHAR; BEGIN i := 0; WHILE len > 0 DO 			idx := buf[i]; INC(i); l := 1; WHILE (l < len) & (buf[i] = idx) DO INC(i); INC(l) END; Display.ReplConst(ORD(idx), x, y, l, 1, Display.replace); INC(x, l); DEC(len, l) 		END END DrawRunIdx; (*--- Copy Image Run ---*) PROCEDURE CopyRunRGB (img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); VAR buf: ARRAY 3*MaxRun OF CHAR; BEGIN Images.GetPixels(img, mx, my, len, Images.BGR888, buf, Images.SrcCopy); DrawRunRGB(buf, len, x, y) 	END CopyRunRGB; PROCEDURE CopyRunIdx (img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); VAR buf: ARRAY MaxRun OF CHAR; BEGIN Images.GetPixels(img, mx, my, len, Images.D8, buf, Images.SrcCopy); DrawRunIdx(buf, len, x, y) 	END CopyRunIdx; (*--- Blend Image Run ---*) PROCEDURE BlendRunRGB (dc: Context; img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); VAR i, j, l: LONGINT; buf: ARRAY 3*MaxRun OF CHAR; alpha: ARRAY MaxRun OF CHAR; a, r, g, b: CHAR; BEGIN i := 0; j := 0; WHILE i < len DO 			buf[j + blue] := dc.bgPix[blue]; buf[j + green] := dc.bgPix[green]; buf[j + red] := dc.bgPix[red]; INC(i); INC(j, 3) END; Images.GetPixels(img, mx, my, len, Images.BGR888, buf, dc.srcOverDst); Images.GetPixels(img, mx, my, len, Images.A8, alpha, Images.SrcCopy); i := 0; j := 0; WHILE len > 0 DO 			a := alpha[i]; INC(i); IF a = 0X THEN INC(j, 3); INC(x); DEC(len) ELSE r := buf[j + red]; g := buf[j + green]; b := buf[j + blue]; INC(j, 3); l := 1; WHILE (l < len) & (alpha[i] # 0X) & (buf[j + red] = r) & (buf[j + green] = g) & (buf[j + blue] = b) DO 					INC(i); INC(j, 3); INC(l) END; Display.ReplConst(Display.RGB(ORD(r), ORD(g), ORD(b)), x, y, l, 1, Display.replace); INC(x, l); DEC(len, SHORT(l)) END END END BlendRunRGB; PROCEDURE BlendRunIdx (dc: Context; img: Images.Image; mx, my, len: INTEGER; x, y: LONGINT); VAR i, l: LONGINT; buf, alpha: ARRAY MaxRun OF CHAR; idx: CHAR; BEGIN i := 0; WHILE i < len DO buf[i] := CHR(dc.bgCol); INC(i) END; Images.GetPixels(img, mx, my, len, Images.D8, buf, dc.srcOverDst); Images.GetPixels(img, mx, my, len, Images.A8, alpha, Images.SrcCopy); i := 0; WHILE len > 0 DO 			IF alpha[i] = 0X THEN INC(i); INC(x); DEC(len) ELSE idx := buf[i]; INC(i); l := 1; WHILE (l < len) & (alpha[i] # 0X) & (buf[i] = idx) DO INC(i); INC(l) END; Display.ReplConst(ORD(idx), x, y, l, 1, Display.replace); INC(x, l); DEC(len, SHORT(l)) END END END BlendRunIdx; (*--- Draw Rectangle ---*) PROCEDURE DrawRect (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); BEGIN Display.ReplConst(data(RegData).col, llx, lly, urx - llx, ury - lly, Display.replace) END DrawRect; PROCEDURE TileRectBlk (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR w, h: INTEGER; BEGIN WITH data: RegData DO 			w := urx - llx; h := ury - lly; CreateBuffer(w, h); IF Images.alpha IN data.img.fmt.components THEN Display.TransferBlock(Buffer.mem^, 0, Buffer.bpr, llx, lly, w, h, Display.get) END; Images.FillPattern(data.img, Buffer, 0, 0, w, h, data.dx - llx, data.dy - lly, data.dc.srcOverDst); Display.TransferBlock(Buffer.mem^, 0, Buffer.bpr, llx, lly, w, h, Display.set) END END TileRectBlk; PROCEDURE TileRectPix (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR mw, mh, y, my, x, mx, len: INTEGER; BEGIN WITH data: RegData DO 			mw := data.img.width; mh := data.img.height; y := lly; my := (lly - data.dy) MOD mh; WHILE y < ury DO 				x := llx; mx := (llx - data.dx) MOD mw; WHILE x < urx DO 					len := urx - x; 					IF mx + len > mw THEN len := mw - mx END; IF len > MaxRun THEN len := MaxRun END; IF Images.alpha IN data.img.fmt.components THEN BlendRun(data.dc, data.img, mx, my, len, x, y) 					ELSE CopyRun(data.img, mx, my, len, x, y) 					END; INC(x, len); INC(mx, len); IF mx = mw THEN mx := 0 END END; INC(y); INC(my); IF my = mh THEN my := 0 END END END END TileRectPix; PROCEDURE Rect (rc: GfxRaster.Context; llx, lly, urx, ury: LONGINT); VAR data: RegData; dc: Context; BEGIN IF rc.clipState # GfxRaster.Out THEN IF rc.pat = NIL THEN IF rc.clipState = GfxRaster.In THEN Display.ReplConst(rc(Context).dcol, llx, lly, urx - llx, ury - lly, Display.replace) ELSE data.col := rc(Context).dcol; GfxRegions.Enumerate(rc.clipReg, SHORT(llx), SHORT(lly), SHORT(urx), SHORT(ury), DrawRect, data) END ELSE dc := rc(Context); data.dx := SHORT(ENTIER(dc.orgX + dc.pat.px + 0.5)); data.dy := SHORT(ENTIER(dc.orgY + dc.pat.py + 0.5)); data.dc := dc; data.img := dc.pat.img; GfxRegions.Enumerate(dc.clipReg, SHORT(llx), SHORT(lly), SHORT(urx), SHORT(ury), TileRect, data) END END END Rect; (*--- Set Color/Pattern for Raster Context ---*) PROCEDURE SetColPatRGB (rc: GfxRaster.Context; col: Gfx.Color; pat: Gfx.Pattern); VAR dc: Context; BEGIN dc := rc(Context); dc.col := col; dc.pat := pat; dc.dcol := Display.RGB(col.r, col.g, col.b); Images.SetModeColor(dc.srcOverDst, col.r, col.g, col.b) 	END SetColPatRGB; PROCEDURE SetColPatIdx (rc: GfxRaster.Context; col: Gfx.Color; pat: Gfx.Pattern); VAR dc: Context; BEGIN dc := rc(Context); dc.col := col; dc.pat := pat; dc.dcol := Colors.Match(Colors.DisplayIndex, Colors.DisplayBits, col.r, col.g, col.b); Images.SetModeColor(dc.srcOverDst, col.r, col.g, col.b) 	END SetColPatIdx; (*--- Draw String ---*) PROCEDURE CopyPattern (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); BEGIN WITH data: RegData DO 			Display.SetClip(llx, lly, urx - llx, ury - lly); Display.CopyPattern(data.col, data.pat, data.dx, data.dy, Display.paint); Display.ResetClip END END CopyPattern; PROCEDURE Show (ctxt: Gfx.Context; x, y: REAL; VAR str: ARRAY OF CHAR); VAR mat: GfxMatrix.Matrix; font: GfxFonts.Font; dc: Context; u, v: REAL; px, py, i, aw, dx, bx, by, w, h: INTEGER; pat: Display.Pattern; data: RegData; BEGIN GfxMatrix.Concat(ctxt.font.mat, ctxt.ctm, mat); font := GfxFonts.Open(ctxt.font.name, ctxt.font.ptsize, mat); IF font = NIL THEN font := GfxFonts.Default END; IF (font.rfont # NIL) & (ctxt.mode * {Gfx.Record..Gfx.EvenOdd} = {Gfx.Fill}) & (ctxt.fillPat = NIL) THEN dc := ctxt(Context); dc.setColPat(dc, dc.fillCol, NIL); GfxMatrix.Apply(dc.ctm, x, y, u, v); px := SHORT(ENTIER(u + 0.5)); py := SHORT(ENTIER(v + 0.5)); i := 0; aw := 0; WHILE str[i] # 0X DO 				Fonts.GetChar(font.rfont, str[i], dx, bx, by, w, h, pat); INC(aw, dx); INC(i) END; IF GfxRegions.RectInside(px, py + font.rfont.minY, px + aw, py + font.rfont.maxY, dc.clipReg) THEN i := 0; WHILE str[i] # 0X DO 					Fonts.GetChar(font.rfont, str[i], dx, bx, by, w, h, pat); IF w * h # 0 THEN Display.CopyPattern(dc.dcol, pat, px + bx, py + by, Display.paint) END; INC(px, dx); INC(i) END ELSE data.col := dc.dcol; i := 0; WHILE str[i] # 0X DO 					Fonts.GetChar(font.rfont, str[i], dx, bx, by, w, h, pat); IF (w * h # 0) & GfxRegions.RectOverlaps(px + bx, py + by, px + bx + w, py + by + h, dc.clipReg) THEN data.dx := px + bx; data.dy := py + by; data.pat := pat; GfxRegions.Enumerate(dc.clipReg, data.dx, data.dy, data.dx + w, data.dy + h, CopyPattern, data) END; INC(px, dx); INC(i) END END; dc.cpx := x + aw; dc.cpy := y	(* font coordinates are same as world coordinates *) ELSE GfxRaster.Show(ctxt, x, y, str) END END Show; (*--- Transform To Temporary Bitmap ---*) PROCEDURE WarpBlk (dc: Context; img: Images.Image; dx, dy, x0, y0, x1, y1: INTEGER; VAR m: GfxMatrix.Matrix; VAR f: GfxImages.Filter); VAR col: Images.Pixel; BEGIN CreateBuffer(x1 - x0, y1 - y0); Display.TransferBlock(Buffer.mem^, 0, Buffer.bpr, dx + x0, dy + y0, x1 - x0, y1 - y0, Display.get); m[2, 0] := m[2, 0] - x0; m[2, 1] := m[2, 1] - y0;	(* make transform local to Buffer origin *) col := f.col; Images.SetModeColor(f, dc.fillCol.r, dc.fillCol.g, dc.fillCol.b); GfxImages.Transform(img, Buffer, m, f); Images.SetModeColor(f, ORD(col[red]), ORD(col[green]), ORD(col[blue])) END WarpBlk; PROCEDURE WarpPix (dc: Context; img: Images.Image; dx, dy, x0, y0, x1, y1: INTEGER; VAR m: GfxMatrix.Matrix; VAR f: GfxImages.Filter); VAR op: INTEGER; col: Images.Pixel; BEGIN Images.Create(Buffer, x1 - x0, y1 - y0, Images.BGRA8888); m[2, 0] := m[2, 0] - x0; m[2, 1] := m[2, 1] - y0;	(* make transform local to Buffer origin *) op := f.op; col := f.col; Images.InitModeColor(f, Images.srcCopy, dc.fillCol.r, dc.fillCol.g, dc.fillCol.b); GfxImages.Transform(img, Buffer, m, f); Images.InitModeColor(f, op, ORD(col[red]), ORD(col[green]), ORD(col[blue])) END WarpPix; (*--- Draw/Blend Image Rectangle ---*) PROCEDURE DrawImageRectBlk (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR off: LONGINT; BEGIN WITH data: RegData DO 			off := (lly - data.dy) * data.img.bpr + LONG(llx - data.dx) * (data.img.fmt.bpp DIV 8); Display.TransferBlock(data.img.mem^, off, data.img.bpr, llx, lly, urx - llx, ury - lly, Display.set) END END DrawImageRectBlk; PROCEDURE DrawImageRectPix (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR y, x, len: INTEGER; BEGIN WITH data: RegData DO 			y := lly; WHILE y < ury DO 				x := llx; WHILE x < urx DO 					len := MaxRun; IF x + MaxRun > urx THEN len := urx - x END; CopyRun(data.img, x - data.dx, y - data.dy, len, x, y); INC(x, len) END; INC(y) END END END DrawImageRectPix; PROCEDURE BlendImageRectPix (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR y, x, len: INTEGER; BEGIN WITH data: RegData DO 			y := lly; WHILE y < ury DO 				x := llx; WHILE x < urx DO 					len := MaxRun; IF x + MaxRun > urx THEN len := urx - x END; BlendRun(data.dc, data.img, x - data.dx, y - data.dy, len, x, y); INC(x, len) END; INC(y) END END END BlendImageRectPix; (*--- Copy Image To Display ---*) PROCEDURE CopyImageBlk (dc: Context; img: Images.Image; dx, dy: INTEGER; VAR filter: GfxImages.Filter); VAR data: RegData; llx, lly, urx, ury: INTEGER; col: Images.Pixel; BEGIN IF Images.Same(img.fmt, Images.DisplayFormat) & (img.mem # NIL) & ((filter.op IN {Images.srcCopy, Images.srcInDst}) OR 			 (filter.op IN {Images.srcOverDst, Images.srcAtopDst}) & ~(Images.alpha IN img.fmt.components)) THEN	(* copy directly from image *) data.img := img; data.dx := dx; data.dy := dy; GfxRegions.Enumerate(dc.clipReg, dx, dy, dx + img.width, dy + img.height, DrawImageRectBlk, data) ELSE	(* blend into temporary map first *) llx := dx; lly := dy; urx := llx + img.width; ury := lly + img.height; GfxRegions.ClipRect(llx, lly, urx, ury, dc.clipReg.llx, dc.clipReg.lly, dc.clipReg.urx, dc.clipReg.ury); IF ~GfxRegions.RectEmpty(llx, lly, urx, ury) THEN CreateBuffer(urx - llx, ury - lly); IF ~(filter.op IN {Images.srcCopy, Images.srcInDst}) & ~((filter.op IN {Images.srcOverDst, Images.srcAtopDst}) & ~(Images.alpha IN img.fmt.components)) THEN Display.TransferBlock(Buffer.mem^, 0, Buffer.bpr, llx, lly, urx - llx, ury - lly, Display.get) END; col := filter.col; Images.SetModeColor(filter, dc.fillCol.r, dc.fillCol.g, dc.fillCol.b); Images.Copy(img, Buffer, llx - dx, lly - dy, urx - dx, ury - dy, 0, 0, filter); Images.SetModeColor(filter, ORD(col[red]), ORD(col[green]), ORD(col[blue])); data.img := Buffer; data.dx := llx; data.dy := lly; GfxRegions.Enumerate(dc.clipReg, llx, lly, urx, ury, DrawImageRectBlk, data) END END END CopyImageBlk; PROCEDURE CopyImagePix (dc: Context; img: Images.Image; dx, dy: INTEGER; VAR filter: GfxImages.Filter); VAR data: RegData; llx, lly, urx, ury: INTEGER; buf: Images.Image; col: Images.Pixel; mode: Images.Mode; BEGIN IF (filter.op IN {Images.srcCopy, Images.srcInDst}) & ~(Images.alpha IN img.fmt.components) THEN data.img := img; data.dx := dx; data.dy := dy; GfxRegions.Enumerate(dc.clipReg, dx, dy, dx + img.width, dy + img.height, DrawImageRectPix, data) ELSIF filter.op IN {Images.srcOverDst, Images.srcAtopDst} THEN dc.setColPat(dc, dc.fillCol, NIL); data.dc := dc; data.img := img; data.dx := dx; data.dy := dy; GfxRegions.Enumerate(dc.clipReg, dx, dy, dx + img.width, dy + img.height, BlendImageRectPix, data) ELSE llx := dx; lly := dy; urx := llx + img.width; ury := lly + img.height; GfxRegions.ClipRect(llx, lly, urx, ury, dc.clipReg.llx, dc.clipReg.lly, dc.clipReg.urx, dc.clipReg.ury); IF ~GfxRegions.RectEmpty(llx, lly, urx, ury) THEN NEW(buf); Images.Create(buf, urx - llx, ury - lly, Images.PixelFormat); Images.Fill(buf, 0, 0, urx - llx, ury - lly, dc.bgPix, Images.SrcCopy); col := filter.col; Images.SetModeColor(filter, dc.fillCol.r, dc.fillCol.g, dc.fillCol.b); Images.Copy(img, buf, llx - dx, lly - dy, urx - dx, ury - dy, 0, 0, filter); Images.SetModeColor(filter, ORD(col[red]), ORD(col[green]), ORD(col[blue])); Images.InitMode(mode, Images.dstInSrc); Images.Copy(img, buf, llx - dx, lly - dy, urx - dx, ury - dy, 0, 0, mode);	(* reduce buf to opaque parts of img *) data.img := buf; data.dx := llx; data.dy := lly; GfxRegions.Enumerate(dc.clipReg, llx, lly, urx, ury, BlendImageRectPix, data) END END END CopyImagePix; (*--- Draw Bitmap ---*) PROCEDURE Image (ctxt: Gfx.Context; x, y: REAL; img: Images.Image; VAR filter: GfxImages.Filter); VAR dc: Context; m: GfxMatrix.Matrix; dx, dy, llx, lly, urx, ury: INTEGER; x0, y0, x1, y1: REAL; data: RegData; BEGIN dc := ctxt(Context); GfxMatrix.Translate(dc.ctm, x, y, m); dx := SHORT(ENTIER(m[2, 0])); m[2, 0] := m[2, 0] - dx; dy := SHORT(ENTIER(m[2, 1])); m[2, 1] := m[2, 1] - dy; IF (filter.hshift # GfxImages.NoFilter.hshift) & (0.1 < m[2, 0]) & (m[2, 0] < 0.9) OR 			(filter.vshift # GfxImages.NoFilter.vshift) & (0.1 < m[2, 1]) & (m[2, 1] < 0.9) OR 			GfxMatrix.Scaled(m) OR 			GfxMatrix.Rotated(m) THEN	(* transform into temporary image and copy from there *) GfxMatrix.ApplyToRect(m, 0, 0, img.width, img.height, x0, y0, x1, y1); llx := SHORT(ENTIER(x0)); lly := SHORT(ENTIER(y0)); urx := -SHORT(ENTIER(-x1)); ury := -SHORT(ENTIER(-y1)); GfxRegions.ClipRect(llx, lly, urx, ury, dc.clipReg.llx - dx, dc.clipReg.lly - dy, dc.clipReg.urx - dx, dc.clipReg.ury - dy); IF ~GfxRegions.RectEmpty(llx, lly, urx, ury) THEN Warp(dc, img, dx, dy, llx, lly, urx, ury, m, filter); data.dc := dc; data.img := Buffer; data.dx := dx + llx; data.dy := dy + lly; GfxRegions.Enumerate(dc.clipReg, data.dx, data.dy, dx + urx, dy + ury, BlendImageRect, data) END ELSE CopyImage(dc, img, dx, dy, filter) END END Image; (*--- Gfx Context Methods ---*) PROCEDURE ResetCTM (ctxt: Gfx.Context); VAR dc: Context; BEGIN dc := ctxt(Context); GfxMatrix.Translate(GfxMatrix.Identity, dc.orgX, dc.orgY, dc.ctm); GfxMatrix.Scale(dc.ctm, dc.scale, dc.scale, dc.ctm) END ResetCTM; PROCEDURE ResetClip (ctxt: Gfx.Context); VAR dc: Context; BEGIN dc := ctxt(Context); GfxRaster.ResetClip(dc); GfxRegions.Copy(dc.defClip, dc.clipReg) END ResetClip; PROCEDURE InitMethods; VAR do: Gfx.Methods; BEGIN NEW(do); Methods := do; do.reset := Gfx.DefResetContext; do.resetCTM := ResetCTM; do.setCTM := Gfx.DefSetCTM; do.translate := Gfx.DefTranslate; do.scale := Gfx.DefScale; do.rotate := Gfx.DefRotate; do.concat := Gfx.DefConcat; do.resetClip := ResetClip; do.getClipRect := GfxRaster.GetClipRect; do.getClip := GfxRaster.GetClip; do.setClip := GfxRaster.SetClip; do.setStrokeColor := Gfx.DefSetStrokeColor; do.setStrokePattern := Gfx.DefSetStrokePattern; do.setFillColor := Gfx.DefSetFillColor; do.setFillPattern := Gfx.DefSetFillPattern; do.setLineWidth := Gfx.DefSetLineWidth; do.setDashPattern := Gfx.DefSetDashPattern; do.setCapStyle := Gfx.DefSetCapStyle; do.setJoinStyle := Gfx.DefSetJoinStyle; do.setStyleLimit := Gfx.DefSetStyleLimit; do.setFlatness := Gfx.DefSetFlatness; do.setFont := Gfx.DefSetFont; do.getWidth := Gfx.DefGetStringWidth; do.begin := GfxRaster.Begin; do.end := GfxRaster.End; do.enter := GfxRaster.Enter; do.exit := GfxRaster.Exit; do.close := GfxRaster.Close; do.line := GfxRaster.Line; do.arc := GfxRaster.Arc; do.bezier := GfxRaster.Bezier; do.show := Show; do.flatten := Gfx.DefFlatten; do.outline := Gfx.DefOutline; do.render := GfxRaster.Render; do.rect := GfxRaster.Rect; do.ellipse := GfxRaster.Ellipse; do.image := Image; do.newPattern := Gfx.DefNewPattern; IF TransferBlock THEN BlendDot := BlendDotBlk; TileRect := TileRectBlk; BlendImageRect := DrawImageRectBlk; Warp := WarpBlk; CopyImage := CopyImageBlk ELSIF TrueColor THEN BlendDot := BlendDotRGB; TileRect := TileRectPix; CopyRun := CopyRunRGB; BlendRun := BlendRunRGB; BlendImageRect := BlendImageRectPix; Warp := WarpPix; CopyImage := CopyImagePix ELSE BlendDot := BlendDotIdx; TileRect := TileRectPix; CopyRun := CopyRunIdx; BlendRun := BlendRunIdx; BlendImageRect := BlendImageRectPix; Warp := WarpPix; CopyImage := CopyImagePix END END InitMethods; (*--- Exported Interface ---*) (** set default clip region to rectangle **) PROCEDURE SetClipRect* (dc: Context; llx, lly, urx, ury: INTEGER); BEGIN GfxRegions.SetToRect(dc.defClip, llx, lly, urx, ury) END SetClipRect; (** copy given region to default clip region **) PROCEDURE SetClipRegion* (dc: Context; reg: GfxRegions.Region); BEGIN GfxRegions.Copy(reg, dc.defClip) END SetClipRegion; (** set default coordinate origin and scale factor **) PROCEDURE SetCoordinates* (dc: Context; x, y, scale: REAL); BEGIN dc.orgX := x; dc.orgY := y; dc.scale := scale END SetCoordinates; (** set background color for display context **) PROCEDURE SetBGColor* (dc: Context; col: Gfx.Color); BEGIN dc.bg := col; Images.SetRGB(dc.bgPix, col.r, col.g, col.b); IF TrueColor THEN dc.bgCol := Display.RGB(col.r, col.g, col.b) 		ELSE dc.bgCol := Colors.Match(Colors.DisplayIndex, Colors.DisplayBits, col.r, col.g, col.b) 		END END SetBGColor; (** initialize display context to rectangle **) PROCEDURE Init* (dc: Context; llx, lly, urx, ury: INTEGER); BEGIN GfxRaster.InitContext(dc); dc.do := Methods; dc.dot := Dot; dc.rect := Rect; IF TrueColor THEN dc.setColPat := SetColPatRGB ELSE dc.setColPat := SetColPatIdx END; Images.InitMode(dc.srcOverDst, Images.srcOverDst); NEW(dc.defClip); GfxRegions.Init(dc.defClip, GfxRegions.Winding); SetClipRect(dc, llx, lly, urx, ury); SetCoordinates(dc, llx, lly, 1); SetBGColor(dc, Gfx.White); Gfx.DefResetContext(dc) END Init; BEGIN TrueColor := Display.TrueColor(Display.ColLeft); TransferBlock := Display.TransferFormat(Display.ColLeft) # Display.unknown; NEW(Buffer); InitMethods END GfxDisplay.