(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich. Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *) MODULE GfxBuffer; (** portable *) (* eos *) (** AUTHOR "eos"; PURPOSE "Raster contexts rendering into background buffers"; *) (* 10.12.98 - first version; derived from GfxDev 25.8.99 - replaced GfxMaps with Images/GfxImages 10.8.99 - scratched SetPoint, added Close method 13.02.2000 - new get/set clip methods 10.05.2000 - Rect now ignores empty rectangles *) IMPORT Images := Raster, GfxMatrix, GfxImages, GfxRegions, Gfx, GfxRaster; TYPE Context* = OBJECT (GfxRaster.Context) VAR orgX*, orgY*: REAL; (** origin of default coordinate system **) scale*: REAL; (** default scale factor **) bgCol*: Gfx.Color; (** background color for erasing **) img*: Images.Image; (** target buffer **) pix: Images.Pixel; compOp:SHORTINT; (* composition operation for raster device *) (** initialize buffered context **) PROCEDURE InitBuffer* (img: Images.Image); BEGIN SELF.InitRaster(); SELF.compOp := 1; (* Copy Op is default *) SELF.img := img; SELF.SetCoordinates(0, 0, 1); SELF.SetBGColor(Gfx.White); SELF.Reset(); END InitBuffer; PROCEDURE{FINAL} SetColPat* (col: Gfx.Color; pat: Gfx.Pattern); BEGIN SetColPat^(col, pat); Images.SetRGBA(SELF.pix, col.r, col.g, col.b, col.a) END SetColPat; (** set default coordinate origin and scale factor **) PROCEDURE{FINAL} SetCoordinates* (x, y, scale: REAL); BEGIN SELF.orgX := x; SELF.orgY := y; SELF.scale := scale END SetCoordinates; (** set background color **) PROCEDURE{FINAL} SetBGColor* (col: Gfx.Color); BEGIN SELF.bgCol := col END SetBGColor; (** set composition operation as defined in Raster **) PROCEDURE{FINAL} SetCompOp* (op:SHORTINT); BEGIN SELF.compOp := op END SetCompOp; (**--- Coordinate System ---**) (** current transformation matrix **) PROCEDURE{FINAL} ResetCTM* (); BEGIN GfxMatrix.Translate(GfxMatrix.Identity, SELF.orgX, SELF.orgY, SELF.ctm); GfxMatrix.Scale(SELF.ctm, SELF.scale, SELF.scale, SELF.ctm) END ResetCTM; (**--- Clipping ---**) PROCEDURE{FINAL} ResetClip* (); BEGIN SELF.ResetClip^(); SELF.clipReg.SetToRect(0, 0, SHORT(SELF.img.width), SHORT(SELF.img.height)) END ResetClip; (**--- Raster ---**) PROCEDURE{FINAL} DrawImage* (x, y: REAL; img: Images.Image; VAR filter: GfxImages.Filter); VAR m: GfxMatrix.Matrix; dx, dy, llx, lly, urx, ury: INTEGER; col: Images.Pixel; BEGIN GfxMatrix.Translate(SELF.ctm, x, y, m); dx := SHORT(ENTIER(m[2, 0] + 0.5)); dy := SHORT(ENTIER(m[2, 1] + 0.5)); col := filter.col; Images.SetModeColor(filter, SELF.fillCol.r, SELF.fillCol.g, SELF.fillCol.b); IF (filter.hshift # GfxImages.hshift) & (dx + 0.1 < m[2, 0]) & (m[2, 0] < dx + 0.9) OR (filter.vshift # GfxImages.vshift) & (dy + 0.1 < m[2, 1]) & (m[2, 1] < dy + 0.9) OR GfxMatrix.Scaled(m) OR GfxMatrix.Rotated(m) THEN GfxImages.Transform(img, SELF.img, m, filter) ELSE llx := 0; lly := 0; urx := SHORT(img.width); ury := SHORT(img.height); GfxRegions.ClipRect(llx, lly, urx, ury, SELF.clipReg.llx - dx, SELF.clipReg.lly - dy, SELF.clipReg.urx - dx, SELF.clipReg.ury - dy); IF SELF.clipReg.llx > dx THEN dx := SELF.clipReg.llx END; IF SELF.clipReg.lly > dy THEN dy := SELF.clipReg.lly END; IF dx + urx > SELF.img.width THEN urx := SHORT(SELF.img.width - dx) END; IF dy + ury > SELF.img.height THEN ury := SHORT(SELF.img.height - dy) END; IF dx < 0 THEN llx := -dx; dx := 0 END; IF dy < 0 THEN lly := -dy; dy := 0 END; IF (llx < urx) & (lly < ury) THEN IF ~GfxRegions.RectEmpty(llx, lly, urx, ury) THEN Images.Copy(img, SELF.img, llx, lly, urx, ury, dx, dy, filter) END END END; Images.SetModeColor(filter, ORD(col[Images.r]), ORD(col[Images.g]), ORD(col[Images.b])) END DrawImage; PROCEDURE{FINAL} dot*(x, y: LONGINT); (** current dot procedure **) VAR px, py: LONGINT; mode: Images.Mode; BEGIN IF (SELF.clipState = GfxRaster.In) OR (SELF.clipState = GfxRaster.InOut) & SELF.clipReg.RectInside(SHORT(x), SHORT(y), SHORT(x+1), SHORT(y+1)) THEN IF SELF.pat = NIL THEN Images.InitMode(mode, SELF.compOp); Images.Put(SELF.img, SHORT(x), SHORT(y), SELF.pix, mode) ELSE px := (x - ENTIER(SELF.orgX + SELF.pat.px + 0.5)) MOD SELF.pat.img.width; py := (y - ENTIER(SELF.orgY + SELF.pat.py + 0.5)) MOD SELF.pat.img.height; Images.InitModeColor(mode, Images.srcOverDst, SELF.col.r, SELF.col.g, SELF.col.b); Images.Copy(SELF.pat.img, SELF.img, px, py, px+1, py+1, SHORT(x), SHORT(y), mode) END END END dot; PROCEDURE{FINAL} rect* (llx, lly, urx, ury: LONGINT); (** current rect procedure **) VAR data: RegData; mode: Images.Mode; BEGIN IF (SELF.clipState # GfxRaster.Out) & (llx < urx) & (lly < ury) THEN IF SELF.pat = NIL THEN IF SELF.clipState = GfxRaster.In THEN Images.InitMode(mode, SELF.compOp); Images.Fill(SELF.img, SHORT(llx), SHORT(lly), SHORT(urx), SHORT(ury), SELF.pix, mode) ELSE data.bc := SELF; SELF.clipReg.Enumerate(SHORT(llx), SHORT(lly), SHORT(urx), SHORT(ury), Color, data) END ELSE data.bc := SELF; data.dx := SHORT(ENTIER(SELF.orgX + SELF.pat.px + 0.5)); data.dy := SHORT(ENTIER(SELF.orgY + SELF.pat.py + 0.5)); Images.InitModeColor(data.mode, Images.srcOverDst, SELF.col.r, SELF.col.g, SELF.col.b); SELF.clipReg.Enumerate(SHORT(llx), SHORT(lly), SHORT(urx), SHORT(ury), Tile, data) END END END rect; END Context; RegData = RECORD (GfxRegions.EnumData) dx, dy: INTEGER; bc: Context; mode: Images.Mode; END; (*--- Rendering ---*) PROCEDURE Color (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR bc: Context; mode: Images.Mode; BEGIN bc := data(RegData).bc; Images.InitMode(mode, bc.compOp); Images.Fill(bc.img, llx, lly, urx, ury, bc.pix, mode) END Color; PROCEDURE Tile (llx, lly, urx, ury: INTEGER; VAR data: GfxRegions.EnumData); VAR bc: Context; BEGIN WITH data: RegData DO bc := data.bc; Images.FillPattern(bc.pat.img, bc.img, llx, lly, urx, ury, data.dx, data.dy, data.mode) END END Tile; (** set default coordinate origin and scale factor **) PROCEDURE SetCoordinates* (bc: Context; x, y, scale: REAL); BEGIN bc.SetCoordinates(x, y, scale); END SetCoordinates; (** set background color **) PROCEDURE SetBGColor* (bc: Context; col: Gfx.Color); BEGIN bc.SetBGColor(col); END SetBGColor; (** set composition operation as defined in Raster **) PROCEDURE SetCompOp* (bc: Context; op:SHORTINT); BEGIN bc.SetCompOp(op); END SetCompOp; (** initialize buffered context **) PROCEDURE Init* (bc: Context; img: Images.Image); BEGIN bc.InitBuffer( img ); END Init; END GfxBuffer.