Oberon/ETH Oberon/2.3.7/Displays.Mod
< Oberon | ETH Oberon
(* 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
*)