Jump to content

Oberon/ETH Oberon/2.3.7/Displays.Mod

From Wikibooks, open books for an open world
(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license.txt file provided with this distribution. *)

MODULE Displays;	(* pjm *)

IMPORT SYSTEM;

CONST
		(** formats for Transfer.  value = bytes per pixel. *)
	index8* = 1; color565* = 2; color888* = 3; color8888* = 4;

		(** operations for Transfer. *)
	get* = 0; set* = 1;
	
		(** color components. *)
	red* = 00FF0000H; green* = 0000FF00H; blue* = 000000FFH;
	
	trans* = 80000000H;	(** transparency for Mask. *)
	invert* = 40000000H;	(** inverting. *)
(*
	alpha = 0C0000000H;	(** alpha blending. *)
*)

	BufSize = 65536;
	
TYPE
	Display* = OBJECT
		VAR
			width*, height*: LONGINT;	(** dimensions of visible display. *)
			offscreen*: LONGINT;	(** number of non-visible lines at the bottom of the display. *)
			format*: LONGINT;	(** format for Transfer. *)
			unit*: LONGINT;	(** approximate square pixel size = unit/36000 mm. *)
			fblow, fbhigh, fbstride: LONGINT;
		
		(** Transfer a block of pixels in "raw" display format to (op = set) or from (op = get) the display.  Pixels in the rectangular area are transferred from left to right and top to bottom.  The pixels are transferred to or from "buf", starting at "ofs".  The line byte increment is "stride", which may be positive, negative or zero. *)
		PROCEDURE Transfer*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, op: LONGINT);
		VAR bufadr, buflow, bufhigh, dispadr: LONGINT;
		BEGIN
			IF w > 0 THEN
				ASSERT(fblow # 0);
				w := w * format;	(* convert to bytes *)
				bufadr := SYSTEM.ADR(buf[ofs]);
				dispadr := fblow + ((y*width)+x)*format;
				CASE op OF
					set:
						WHILE h > 0 DO
							ASSERT((dispadr >= fblow) & (dispadr+w <= fbhigh));	(* index check *)
							SYSTEM.MOVE(bufadr, dispadr, w);
							INC(bufadr, stride); INC(dispadr, fbstride);
							DEC(h)
						END
					|get:
						buflow := SYSTEM.ADR(buf[0]); bufhigh := buflow + LEN(buf);
						WHILE h > 0 DO
							ASSERT((bufadr >= buflow) & (bufadr+w <= bufhigh));	(* index check *)
							SYSTEM.MOVE(dispadr, bufadr, w);
							INC(bufadr, stride); INC(dispadr, fbstride);
							DEC(h)
						END
					ELSE (* skip *)
				END
			END
		END Transfer;
		
		(** Fill a rectangle in color "col". *)
		PROCEDURE Fill*(col, x, y, w, h: LONGINT);
		BEGIN
			Fill0(SELF, col, x, y, w, h)
		END Fill;
		
		(** Equivalent to Fill(col, x, y, 1, 1). *)
		PROCEDURE Dot*(col, x, y: LONGINT);
		TYPE Buf = ARRAY 4 OF CHAR;
		VAR t, c: SET;
		BEGIN (*{EXCLUSIVE}*)
			IF col >= 0 THEN	(* opaque or invert *)
				CASE format OF
					index8:
						c := SYSTEM.VAL(SET, ColorToIndex(col))
					|color565:
						c := SYSTEM.VAL(SET, ASH(col, 15-23)) * {11..15} +
								SYSTEM.VAL(SET, ASH(col, 10-15)) * {5..10} +
								SYSTEM.VAL(SET, ASH(col, 4-7)) * {0..4}
					|color888, color8888:
						c := SYSTEM.VAL(SET, col MOD 1000000H)
				END;
				IF ASH(col, 1) < 0 THEN	(* invert *)
					IF c = {} THEN c := {0..31} END;
					Transfer(SYSTEM.VAL(Buf, t), 0, format, x, y, 1, 1, get);
					c := t / c
				END;
				Transfer(SYSTEM.VAL(Buf, c), 0, format, x, y, 1, 1, set)
			END
		END Dot;
		
		(** Transfer a block of pixels from a 1-bit mask to the display.  Pixels in the rectangular area are transferred from left to right and top to bottom.  The pixels are transferred from "buf", starting at bit offset "bitofs".  The line byte increment is "stride", which may be positive, negative or zero. "fg" and "bg" specify the colors for value 1 and 0 pixels respectively. *)
		PROCEDURE Mask*(VAR buf: ARRAY OF CHAR; bitofs, stride, fg, bg, x, y, w, h: LONGINT);
		TYPE Buf = ARRAY 4 OF CHAR;
		VAR p, i: LONGINT; s, fgc, bgc, t: SET;
		BEGIN
			IF (w > 0) & (h > 0) THEN
				CASE format OF
					index8:
						IF fg >= 0 THEN fgc := SYSTEM.VAL(SET, ColorToIndex(fg)) END;
						IF bg >= 0 THEN bgc := SYSTEM.VAL(SET, ColorToIndex(bg)) END
					|color565:
						fgc := SYSTEM.VAL(SET, ASH(fg, 15-23)) * {11..15} +
								SYSTEM.VAL(SET, ASH(fg, 10-15)) * {5..10} +
								SYSTEM.VAL(SET, ASH(fg, 4-7)) * {0..4};
						bgc := SYSTEM.VAL(SET, ASH(bg, 15-23)) * {11..15} +
								SYSTEM.VAL(SET, ASH(bg, 10-15)) * {5..10} +
								SYSTEM.VAL(SET, ASH(bg, 4-7)) * {0..4}
					|color888, color8888:
						fgc := SYSTEM.VAL(SET, fg MOD 1000000H);
						bgc := SYSTEM.VAL(SET, bg MOD 1000000H)
				END;
				IF (ASH(fg, 1) < 0) & (fgc = {}) THEN fgc := {0..31} END;	(* invert special *)
				IF (ASH(bg, 1) < 0) & (bgc = {}) THEN bgc := {0..31} END;	(* invert special *)
				p := SYSTEM.ADR(buf[0]) + bitofs DIV 32 * 4;	(* p always aligned to 32-bit boundary *)
				bitofs := bitofs MOD 32; stride := stride*8;
				LOOP
					SYSTEM.GET(p, s); i := bitofs;
					LOOP
						IF (i MOD 32) IN s THEN
							IF fg >= 0 THEN
								IF ASH(fg, 1) < 0 THEN	(* invert *)
									Transfer(SYSTEM.VAL(Buf, t), 0, format, x+i-bitofs, y, 1, 1, get);
									t := t / fgc
								ELSE
									t := fgc
								END;
								Transfer(SYSTEM.VAL(Buf, t), 0, format, x+i-bitofs, y, 1, 1, set)
							END
						ELSE
							IF bg >= 0 THEN
								IF ASH(bg, 1) < 0 THEN	(* invert *)
									Transfer(SYSTEM.VAL(Buf, t), 0, format, x+i-bitofs, y, 1, 1, get);
									t := t / bgc
								ELSE
									t := bgc
								END;
								Transfer(SYSTEM.VAL(Buf, t), 0, format, x+i-bitofs, y, 1, 1, set)
							END
						END;
						INC(i);
						IF i-bitofs = w THEN EXIT END;
						IF i MOD 32 = 0 THEN SYSTEM.GET(p+i DIV 8, s) END
					END;
					DEC(h);
					IF h = 0 THEN EXIT END;
					INC(y); INC(bitofs, stride);
					IF (bitofs >= 32) OR (bitofs < 0) THEN	(* moved outside s *)
						INC(p, bitofs DIV 32 * 4); bitofs := bitofs MOD 32
					END
				END
			END
		END Mask;
		
		(** Copy source block sx, sy, w, h to destination dx, dy.  Overlap is allowed. *)
		PROCEDURE Copy*(sx, sy, w, h, dx, dy: LONGINT);
		BEGIN
			Copy0(SELF, sx, sy, w, h, dx, dy)
		END Copy;
		
		(** Map a color value to an 8-bit CLUT index.  Only used if format = index8. *)
		PROCEDURE ColorToIndex*(col: LONGINT): LONGINT;
		BEGIN
				(* default implementation is not very useful and should be overridden. *)
			RETURN SYSTEM.VAL(LONGINT, 
					SYSTEM.VAL(SET, ASH(col, 7-23)) * {5..7} +
					SYSTEM.VAL(SET, ASH(col, 4-15)) * {2..4} +
					SYSTEM.VAL(SET, ASH(col, 1-7)) * {0..1})
		END ColorToIndex;
		
		(** Map an 8-bit CLUT index to a color value.  Only used if format = index8. *)
		PROCEDURE IndexToColor*(index: LONGINT): LONGINT;
		BEGIN
				(* default implementation is not very useful and should be overridden. *)
			RETURN
					ASH(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, index) * {5..7}), 23-7) +
					ASH(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, index) * {2..4}), 15-4) +
					ASH(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, index) * {0..1}), 7-1)
		END IndexToColor;
		
		(** Initialize a linear frame buffer for Transfer. *)
		PROCEDURE InitFrameBuffer*(adr, size: LONGINT);
		BEGIN
			ASSERT(width*(height+offscreen)*format <= size);
			fblow := adr; fbhigh := fblow + size; fbstride := width*format;
			ASSERT(ASH(fblow, -31) = ASH(fbhigh, -31), 100)	(* same sign, for index check in Transfer *)
		END InitFrameBuffer;
		
(*
		(** Draw a line. *)
		PROCEDURE Line*(col, x1, y1, x2, y2: LONGINT);	(* error term, major, minor? *)
		BEGIN
			HALT(99)
		END Line;
		
		(* Like Mask, but replicate the mask in the specified rectangular area. *)
		PROCEDURE ReplMask*(VAR buf: ARRAY OF CHAR; bitofs, stride, fg, bg, px, py, pw, ph, x, y, w, h: LONGINT);
		BEGIN
			HALT(99)
		END ReplMask;
*)
		
	END Display;

VAR
	main*: Display;
	buf: POINTER TO ARRAY OF CHAR;

PROCEDURE Fill0(d: Display; col, x, y, w, h: LONGINT);
VAR j, p, w0, h0, s: LONGINT; t, c: SET; invert: BOOLEAN;
BEGIN (*{EXCLUSIVE}*)
	IF (w > 0) & (h > 0) & (col >= 0) THEN	(* opaque or invert *)
		invert := ASH(col, 1) < 0;
		IF buf = NIL THEN NEW(buf, BufSize) END;
		CASE d.format OF
			index8:
				s := 4; col := d.ColorToIndex(col);
				c := SYSTEM.VAL(SET, ASH(col, 24) + ASH(col, 16) + ASH(col, 8) + col)
			|color565:
				s := 4;
				col := SYSTEM.VAL(LONGINT, 
						SYSTEM.VAL(SET, ASH(col, 15-23)) * {11..15} +
						SYSTEM.VAL(SET, ASH(col, 10-15)) * {5..10} +
						SYSTEM.VAL(SET, ASH(col, 4-7)) * {0..4});
				c := SYSTEM.VAL(SET, ASH(col, 16) + col MOD 10000H)
			|color888:
				s := 3; c := SYSTEM.VAL(SET, col MOD 1000000H)
			|color8888:
				s := 4; c := SYSTEM.VAL(SET, col MOD 1000000H)
		END;
		w0 := w*d.format; h0 := (LEN(buf^)-3) DIV w0;	(* -3 for 32-bit loops below *)
		ASSERT(h0 > 0);
		IF h < h0 THEN h0 := h END;
		IF ~invert THEN
			p := SYSTEM.ADR(buf[0]);
			FOR j := 0 TO (w0*h0-1) DIV s DO SYSTEM.PUT(p, c); INC(p, s) END
		ELSE
			IF c = {} THEN c := {0..31} END
		END;
		LOOP
			IF invert THEN
				d.Transfer(buf^, 0, w0, x, y, w, h0, get);
				p := SYSTEM.ADR(buf[0]);
				FOR j := 0 TO (w0*h0-1) DIV s DO
					SYSTEM.GET(p, t); SYSTEM.PUT(p, t / c); INC(p, s)
				END
			END;
			d.Transfer(buf^, 0, w0, x, y, w, h0, set);
			DEC(h, h0);
			IF h <= 0 THEN EXIT END;
			INC(y, h0);
			IF h < h0 THEN h0 := h END
		END
	END
END Fill0;

PROCEDURE Copy0(d: Display; sx, sy, w, h, dx, dy: LONGINT);
VAR w0, h0, s: LONGINT;
BEGIN (*{EXCLUSIVE}*)
	IF (w > 0) & (h > 0) THEN
		IF buf = NIL THEN NEW(buf, BufSize) END;
		w0 := w*d.format; h0 := LEN(buf^) DIV w0;
		ASSERT(h0 > 0);
		IF (sy >= dy) OR (h <= h0) THEN
			s := 1
		ELSE
			s := -1; INC(sy, h-h0); INC(dy, h-h0)
		END;
		LOOP
			IF h < h0 THEN
				IF s = -1 THEN INC(sy, h0-h); INC(dy, h0-h) END;
				h0 := h
			END;
			d.Transfer(buf^, 0, w0, sx, sy, w, h0, get);
			d.Transfer(buf^, 0, w0, dx, dy, w, h0, set);
			DEC(h, h0);
			IF h <= 0 THEN EXIT END;
			INC(sy, s*h0); INC(dy, s*h0)
		END
	END
END Copy0;

BEGIN
	buf := NIL
END Displays.

(**
o The display origin (0,0) is at the top left.
o The display is "width" pixels wide and "height" pixels high.
o The offscreen area is a possibly empty extension below the visible display.  Its height is "offscreen" pixels.
o Rectangles are specified with the top left corner as pinpoint.
o No clipping is performed.
o The offset and stride parameters must always specify values inside the supplied buffer (otherwise results undefined).
o Accessing coordinates outside the display space (including offscreen) is undefined.
o "Undefined" in this case means a trap could occur, or garbage can be displayed, but memory will never be corrupted.
o Colors are 888 truecolor values represented in RGB order with B in the least significant byte.  The top 2 bits of a 32-bit color value are used for flags.  The other bits are reserved.
o The "invert" flag means the destination color is inverted with the given color.  The effect is implementation-defined, but must be reversible with the same color.  Usually an XOR operation is performed.
o The "trans" flag means the color is transparent and drawing in this color has no effect.  It is defined for Mask only.
o The transfer "format" should be chosen close to the native framebuffer format for efficiency.
o Transfer uses raw framebuffer values, and does not support color flags.
o A concrete Display must implement at least the Transfer function, or initialize a linear frame buffer and call the InitFrameBuffer method.
o An optimized Display driver should override all the primitives with accelerated versions.
o An "index8" display uses a fixed palette and map a truecolor value to an equivalent color in the palette.
o The palette can be chosen freely by a concrete 8-bit Display, which should override the ColorToIndex and IndexToColor methods.  These methods are not defined for other formats.
o The default ColorToIndex method assumes a direct-mapped palette with 3 bits each for red and green, and 2 bits for blue.
o Palette animation is not supported.
*)

(*
to do:
1 ReplMask
1 include OGLDisplay functionality (state abstraction)
1 include other primitives: Line, ReplMask, etc.
2 window manager and cursor?
2 pan to offscreen area
3 how to write a new driver
*)