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

title: Oberon/ETH Oberon/2.3.7/Displays.Mod


text:
Oberon/ETH Oberon/2.3.7/Empty.Display.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 Display;	(** portable, except where noted *) (** Module Display provides the display drawing primitives and the base type of the visual objects, called Frames. *) (* Native Oberon template display driver. *) IMPORT SYSTEM, Objects; CONST BG* = 0; FG* = 15; (** Background, foreground color palette indices *) (** Drawing operation modes. *) replace* = 0;	(** replace destination. *) paint* = 1;	(** paint over destination. *) invert* = 2;	(** invert destination. *) (** Message ids. *) remove* = 0; suspend* = 1; restore* = 2; newprinter* = 3; (** ControlMsg id. *) reduce* = 0; extend* = 1; move* = 2; (** ModifyMsg id. *) display* = 0; state* = 1; (** ModifyMsg mode. *) screen* = 0; printer* = 1; (** DisplayMsg device *) full* = 0; area* = 1; contents* = 2; (** DisplayMsg id. *) get* = 0; set* = 1; reset* = 2; (** SelectMsg id. *) drop* = 0; integrate* = 1; (** ConsumeMsg id. *) (** TransferFormat return values. value DIV 8 = bytes per pixel.  portable, release >= 2.4*) unknown* = 0; index8* = 8; color555* = 16; color565* = 17; color664* = 18; color888* = 24; color8888* = 32; TYPE Color* = LONGINT;	(** portable, release >= 2.4 *) Pattern* = LONGINT; PatternPtr = POINTER TO RECORD w, h: CHAR; pixmap: ARRAY 8192 OF CHAR END; List = POINTER TO ListDesc; ListDesc = RECORD next: List; pat: PatternPtr END; Frame* = POINTER TO FrameDesc;	(** Base type of all displayable objects. *) FrameDesc* = RECORD (Objects.ObjDesc) next*, dsc*: Frame;	(** Sibling, child pointers. *) X*, Y*, W*, H*: INTEGER	(** Coordinates. *) END; FrameMsg* = RECORD (Objects.ObjMsg)	(** Base type of messages sent to frames. *) F*: Frame;	(** Message target, NIL for broadcast. *) x*, y*: INTEGER;	(** Message origin. *) res*: INTEGER	(** Result code: <0 = error or no response, >=0 response. *) END; ControlMsg* = RECORD (FrameMsg) id*: INTEGER	(** remove, suspend, restore. *) END; ModifyMsg* = RECORD (FrameMsg)	(** Change coordinates in container frame. *) id*: INTEGER;	(** reduce, extend, move. *) mode*: INTEGER;	(** Modes display, state. *) dX*, dY*, dW*, dH*: INTEGER;	(** Change from old coordinates (delta). *) X*, Y*, W*, H*: INTEGER	(** New coordinates. *) END; DisplayMsg* = RECORD (FrameMsg)	(** Display a frame, a part of it or its contents. *) device*: INTEGER;	(** screen, printer *) id*: INTEGER;	(** full, area, contents. *) u*, v*, w*, h*: INTEGER	(** Area to be restored. *) END; LocateMsg* = RECORD (FrameMsg)	(** Locate frame in display space. *) loc*: Frame;	(** Result. *) X*, Y*: INTEGER;	(** Absolute location. *) u*, v*: INTEGER	(** Relative coordinates in loc. *) END; SelectMsg* = RECORD (FrameMsg)	(** Selection control. *) id*: INTEGER;	(** get, set, reset. *) time*: LONGINT;	(** Time of selection. *) sel*: Frame;	(** Parent of selection. *) obj*: Objects.Object	(** List of objects involved, linked with slink. *) END; ConsumeMsg* = RECORD (FrameMsg)	(** Drop, integrate frames. *) id*: INTEGER;	(** drop, integrate. *) u*, v*: INTEGER;	(** Relative coordinates in destination when drop. *) obj*: Objects.Object	(** List of objects to be consumed, linked with slink. *) END; MsgProc* = PROCEDURE (VAR M: FrameMsg); VAR Unit*: LONGINT; (** RasterUnit = Unit/36000 mm *) Left*, (** Left margin of black-and-white screen. *) ColLeft*, (** Left margin of secondary display, often same as Left. *) Bottom*, (** Bottom of primary map. *) UBottom*, (** Bottom of offscreen area (negative), 0 if not supported. *) Width*, (** Display width. *) Height*: INTEGER; (** Display height. *) arrow*, 	(** Oberon cursor. *) star*, 	(** Star marker to mark documents and viewers. *) cross*, 	(** Insertion marker. *) downArrow*, 	(** Marker to indicate disk operation. *) hook*,	(** Text caret pattern. *) grey0*, grey1*, grey2*, ticks*, solid*: Pattern;	(** Simulated grey levels. *) Broadcast*: MsgProc;	(** Message broadcast to all frames in the display space. *) pattern: List; (** Change color palette entry. 0 <= col, red, green, blue < 256. *) PROCEDURE SetColor*(col: Color; red, green, blue: LONGINT); BEGIN END SetColor; (** Retrieve color palette entry or color components of a true color value. 0 <= red, green, blue < 256. *) PROCEDURE GetColor*(col: Color; VAR red, green, blue: INTEGER); BEGIN IF col < 0 THEN red := SHORT(ASH(col, -16) MOD 256); green := SHORT(ASH(col, -8) MOD 256); blue := SHORT(col MOD 256) ELSE red := 0; green := 0;  blue := 0 END END GetColor; (** Return true color with specified components. 0 <= red, green, blue < 256. Not all display regions support true color values, see TrueColor. *) PROCEDURE RGB*(red, green, blue: LONGINT): Color;	(** portable, release >= 2.4 *) BEGIN RETURN MIN(LONGINT) + ASH(red, 16) + ASH(green, 8) + blue END RGB; (** Returns the color palette depth for the specified display region. Typical values are 1, 4 and 8 (not larger). *) PROCEDURE Depth*(x: LONGINT): INTEGER; BEGIN RETURN 8 END Depth; (** Returns TRUE iff the specified display region supports true color values. *) PROCEDURE TrueColor*(x: LONGINT): BOOLEAN;	(** portable, release >= 2.4 *) BEGIN RETURN FALSE END TrueColor; (** Get the current clip rectangle. *) PROCEDURE GetClip*(VAR x, y, w, h: INTEGER); BEGIN x := 0; y := 0;  w := Width;  h := Height END GetClip; (** Set the new clipping rectangle. *) PROCEDURE SetClip*(x, y, w, h: LONGINT); BEGIN END SetClip; (** Intersect with current clip rectangle resulting in a new clip rectangle. *) PROCEDURE AdjustClip*(x, y, w, h: LONGINT); BEGIN END AdjustClip; (** Reset the current clipping rectangle to the whole display, including offscreen area. *) PROCEDURE ResetClip*; BEGIN END ResetClip; (** Copy source block sx, sy, w, h to destination dx, dy using operation mode. A block is given by its lower left corner sx, sy and its dimension w, h. Some drivers only implement mode = replace. *) PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT); BEGIN END CopyBlock; (** Copy pattern pat in color col to x, y using operation mode. *) PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT); BEGIN END CopyPattern; (** Replicate pattern pat in color col into block x, y, w, h using operation mode, proceeding from left to right and from bottom to top, starting at lower left corner. The pattern origin is placed at px, py. *) PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT); BEGIN END FillPattern; (** Like FillPattern, but the pattern origin is placed at 0, 0. *) PROCEDURE ReplPattern*(col: Color; pat: Pattern; x, y, w, h, mode: LONGINT); BEGIN END ReplPattern; (** Block fill in color col and operation mode. mode paint and replace are equivalent. *) PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT); BEGIN END ReplConst; (** Place a dot of color col in operation mode at x, y. Effect equivalent to ReplConst with a block of size 1, 1. *) PROCEDURE Dot*(col: Color; x, y, mode: LONGINT); BEGIN END Dot; (** Returns the dimensions of a pattern. *) PROCEDURE GetDim*(pat: Pattern; VAR w, h: INTEGER); VAR ch: CHAR; BEGIN SYSTEM.GET(pat, ch); w := ORD(ch); SYSTEM.GET(pat+1, ch); h := ORD(ch) END GetDim; (** Define a new pattern. *) PROCEDURE NewPattern*(w, h: LONGINT; VAR image: ARRAY OF SET): Pattern; VAR len, src, dest, i: LONGINT; p: PatternPtr;  pl: List; BEGIN len := (w+7) DIV 8; SYSTEM.NEW(p, 4+len*h); p.w := CHR(w);  p.h := CHR(h); src := SYSTEM.ADR(image[0]); dest := SYSTEM.ADR(p.pixmap[0]); i := 0; WHILE i < h DO SYSTEM.MOVE(src, dest, len); INC(src, 4);  INC(dest, len);  INC(i) END; NEW(pl); pl.pat := p;  pl.next := pattern;  pattern := pl;	(* put in list to avoid GC *) RETURN SYSTEM.ADR(p.w) END NewPattern; (** Return the TransferBlock format of a display region. *) PROCEDURE TransferFormat*(x: LONGINT): LONGINT;	(** portable, release >= 2.4 *) BEGIN RETURN unknown END TransferFormat; (** Transfer a block of pixels in display format to (mode = set) or from (mode = get) the display.  Pixels in the rectangular area are transferred from bottom to top and left to right.  The pixels are transferred to or from buf, starting at ofs, and with line increment stride, which may be < 0. *) PROCEDURE TransferBlock*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, mode: LONGINT);	(** portable, release >= 2.4 *) BEGIN HALT(99)	(* TransferBlock not supported if TransferFormat = unknown *) END TransferBlock; (** Change display mode. s is driver-specific. *) PROCEDURE SetMode*(x: LONGINT; s: SET);	(** non-portable *) BEGIN END SetMode; (** Display a picture. Used internally by Pictures module only. *) PROCEDURE DisplayBlock*(adr, dx, dy, w, h, sx, sy, mode: LONGINT);	(** non-portable *) BEGIN END DisplayBlock; (** Return address of display located at x, or 0 if not supported. *) PROCEDURE Map*(x: LONGINT): LONGINT;	(** non-portable *) BEGIN RETURN 0 END Map; (* Define standard patterns. *) PROCEDURE CreatePatterns; VAR image: ARRAY 16 OF SET; BEGIN image[0] := {13}; image[1] := {12..14}; image[2] := {11..13}; image[3] := {10..12}; image[4] := {9..11}; image[5] := {8..10}; image[6] := {7..9}; image[7] := {0, 6..8}; image[8] := {0, 1, 5..7}; image[9] := {0..2, 4..6}; image[10] := {0..5}; image[11] := {0..4}; image[12] := {0..5}; image[13] := {0..6}; image[14] := {0..7}; arrow := NewPattern(15, 15, image); image[0] := {0, 10}; image[1] := {1, 9}; image[2] := {2, 8}; image[3] := {3, 7}; image[4] := {4, 6}; image[5] := {}; image[6] := {4, 6}; image[7] := {3, 7}; image[8] := {2, 8}; image[9] := {1, 9}; image[10] := {0, 10}; cross := NewPattern(11, 11, image); image[0] := {6}; image[1] := {5..7}; image[2] := {4..8}; image[3] := {3..9}; image[4] := {2..10}; image[5] := {5..7}; image[6] := {5..7}; image[7] := {5..7}; image[8] := {5..7}; image[9] := {5..7}; image[10] := {5..7}; image[11] := {5..7}; image[12] := {5..7}; image[13] := {5..7}; image[14] := {}; downArrow := NewPattern(11, 15, image); image[0] := {0, 4, 8, 12}; image[1] := {}; image[2] := {2, 6, 10, 14}; image[3] := {}; image[4] := {0, 4, 8, 12}; image[5] := {}; image[6] := {2, 6, 10, 14}; image[7] := {}; image[8] := {0, 4, 8, 12}; image[9] := {}; image[10] := {2, 6, 10, 14}; image[11] := {}; image[12] := {0, 4, 8, 12}; image[13] := {}; image[14] := {2, 6, 10, 14}; image[15] := {}; grey0 := NewPattern(16, 16, image); image[0] := {0, 2, 4, 6, 8, 10, 12, 14}; image[1] := {1, 3, 5, 7, 9, 11, 13, 15}; image[2] := {0, 2, 4, 6, 8, 10, 12, 14}; image[3] := {1, 3, 5, 7, 9, 11, 13, 15}; image[4] := {0, 2, 4, 6, 8, 10, 12, 14}; image[5] := {1, 3, 5, 7, 9, 11, 13, 15}; image[6] := {0, 2, 4, 6, 8, 10, 12, 14}; image[7] := {1, 3, 5, 7, 9, 11, 13, 15}; image[8] := {0, 2, 4, 6, 8, 10, 12, 14}; image[9] := {1, 3, 5, 7, 9, 11, 13, 15}; image[10] := {0, 2, 4, 6, 8, 10, 12, 14}; image[11] := {1, 3, 5, 7, 9, 11, 13, 15}; image[12] := {0, 2, 4, 6, 8, 10, 12, 14}; image[13] := {1, 3, 5, 7, 9, 11, 13, 15}; image[14] := {0, 2, 4, 6, 8, 10, 12, 14}; image[15] := {1, 3, 5, 7, 9, 11, 13, 15}; grey1 := NewPattern(16, 16, image); image[0] := {0, 1, 4, 5, 8, 9, 12, 13}; image[1] := {0, 1, 4, 5, 8, 9, 12, 13}; image[2] := {2, 3, 6, 7, 10, 11, 14, 15}; image[3] := {2, 3, 6, 7, 10, 11, 14, 15}; image[4] := {0, 1, 4, 5, 8, 9, 12, 13}; image[5] := {0, 1, 4, 5, 8, 9, 12, 13}; image[6] := {2, 3, 6, 7, 10, 11, 14, 15}; image[7] := {2, 3, 6, 7, 10, 11, 14, 15}; image[8] := {0, 1, 4, 5, 8, 9, 12, 13}; image[9] := {0, 1, 4, 5, 8, 9, 12, 13}; image[10] := {2, 3, 6, 7, 10, 11, 14, 15}; image[11] := {2, 3, 6, 7, 10, 11, 14, 15}; image[12] := {0, 1, 4, 5, 8, 9, 12, 13}; image[13] := {0, 1, 4, 5, 8, 9, 12, 13}; image[14] := {2, 3, 6, 7, 10, 11, 14, 15}; image[15] := {2, 3, 6, 7, 10, 11, 14, 15}; grey2 := NewPattern(16, 16, image); image[0] := {0..2, 8..11}; image[1] := {0..2, 7..10}; image[2] := {0..2, 6..9}; image[3] := {0..2, 5..8}; image[4] := {0..2, 4..7}; image[5] := {0..6}; image[6] := {0..5}; image[7] := {0..4}; image[8] := {0..3}; image[9] := {0..2}; image[10] := {0, 1}; image[11] := {0}; hook := NewPattern(12, 12, image); image[0] := {7}; image[1] := {7}; image[2] := {2, 7, 12}; image[3] := {3, 7, 11}; image[4] := {4, 7, 10}; image[5] := {5, 7, 9}; image[6] := {6..8}; image[7] := {0..6, 8..14}; image[8] := {6..8}; image[9] := {5, 7, 9}; image[10] := {4, 7, 10}; image[11] := {3, 7, 11}; image[12] := {2, 7, 12}; image[13] := {7}; image[14] := {7}; star := NewPattern(15, 15, image); image[0] := {}; image[1] := {}; image[2] := {0}; image[3] := {}; image[4] := {}; image[5] := {}; image[6] := {}; image[7] := {}; image[8] := {}; image[9] := {}; image[10] := {}; image[11] := {}; image[12] := {}; image[13] := {}; image[14] := {}; image[15] := {}; ticks := NewPattern(16, 16, image); image[0] := -{}; image[1] := -{}; image[2] := -{}; image[3] := -{}; image[4] := -{}; image[5] := -{}; image[6] := -{}; image[7] := -{}; solid := NewPattern(16, 8, image) END CreatePatterns; BEGIN Unit := 10000; Width := 1024; Height := 768; Left := 0; ColLeft := 0;  Bottom := 0;  UBottom:= -255; pattern := NIL; CreatePatterns END Display. (** Remarks: 1. Background and Foreground colors Oberon can either be used with white text on a black background, or inverted with black text on a white background (the so-called paper model). To reduce confusion you should use the FG and BG constants in your code. 2. Screen Organization Oberon supports multiple displays that are placed next to each other in increasing X coordinates. The X coordinate thus uniquely determines the screen, hence the single parameter of the Depth and TransferFormat procedures. Each screen contains a set of nested frames. Historically, the first screen (at Left) is the black and white screen, and the second screen is the color screen (at ColLeft). Today Left and ColLeft are typically set to 0 (for compatability with older applications), as only a few computers still use black and white displays. Only the color map is supported, and it now exists at the display origin. The screen origin is located at the bottom-left corner of the display (i.e. Y decrease from the top to the bottom of the display). 3. The Frames and the Frame messages Frames are the visual entities of Oberon. The frames are placed in the display space to make them visible. This involves inserting frames using the dsc and next fields into a container already located in the display space. All frames of a container are linked together in priority sequence using the next field. The dsc field points to the first child frame of a container. Note that this is only a convention and certain frames might decide to manage their contents in different ways. The frame messages are used to manipulate Frames. Frames also respond to the object message defined in module Objects. 4. Target or Destination frames The Frame messages are often broadcast into the display space rather than sending them directly to a frame. This is useful when many frames are to be informed of an event. It is also a means to determine the exact location (in coordinates and nesting) of a frame in the display space by following the message thread from the display root object to the frame itself (see module Objects). It is also possible to address a broadcast message to a certain frame. This is called a directed broadcast, because the message is still broadcast, but is intended for a specific target only. The target or destination of a broadcast message is identified by the F field in the FrameMsg. It is set to NIL when all frames are to receive the message (true broadcast) and to a specific frame if only that frame is interested in the message (directed broadcast). The exact location, in coordinates and nesting, of a frame in the display space can be determined by tracing the message thread from the display root object to the frame itself. See module Objects. 5. Frame Coordinates and Message origin The coordinates of a frame are specified relative to its container or parent frame. The frame messages pass the absolute position of the top-left corner of the parent frame to their children in the x and y fields (called the message origin). Thus the absolute display position of a frame F is determined when it receives a frame message M: 	M.x + F.X, M.y + F.Y, F.W, F.H M.x and M.y are set by the container to its absolute coordinates. refer to sections 5.5-5.7 of The Oberon Companion (in Book.Tool). 6. Invalidating Messages Often a frame knows that a broadcast need not pass through the remainder of display space because it has already been handled. In such cases the res field of the frame message is set to zero or positive to indicate that an action has been completed and that the message is invalidated. Setting the res field in this way is called "invalidating a message" and will terminate the broadcast. 7. Broadcasting Frame Messages The Broadcast procedure broadcasts a message through the display space. The procedure initializes fields in the frame message. The message origin is set to (0, 0), the message is time stamped, the res field is set to a negative value, and the dlink field (defined in the base type Objects.ObjMsg) is initialized to NIL. In addition, the clipping rectangle is set to the whole display area. Refer to section 5.7 of The Oberon Companion (in Book.Tool) for a description of dlink. 8. Clipping To prevent the clipping rectangle clipping the wrong display primitives, it is reset on each message broadcast or when a trap occurs. Clipping does not affect the drawing of cursors. The Gadget system uses "display masks" that hide the management of the clipping rectangle from the programmer. 9. NewPattern The NewPattern procedure allows you to define patterns in a machine portable way. The sets contain 32 bits, each specifying a single pixel, with {0} the left-most pixel of the pattern. Each pattern line must be filled with empty bits so that it is a multiple of 32 pixels long. The first SET of the array contains the bottom line of the pattern. 10. ControlMsg The ControlMsg is primarily used to remove a frame from the display space. When id is set to remove, the destination frame should be removed from its current location. This done by the container of the frame and is thus a slight misinterpretation of F as a destination frame. More than one frame is removed if the destination is a list of frames connected by the slink field. In this case, they should all belong to the same parent. This message should always be broadcast. When the message id is set to suspend or restore it indicates that all frames from the destination downwards in the display space will be temporarily removed from the display space, or will be restored to the display space. This allows frames to update their internal data structures as they may have missed messages while suspended. This is because only those frames located in the display space receive message broadcasts. This message is sent to the top-most frame of that part of the display space involved with the destination set to NIL. 11. ModifyMsg The ModifyMsg broadcasts a resize request to the destination frame. This allows moving the relative position or changing the size of a child in a container. When the mode is set to state, the frame should not display itself immediately but should only update its size and position and possibly indicate changes to its children. It is then the task of the sender to send a follow up Display message to the frame. The latter way of using the ModifyMsg allows a container to influence its children without having them draw themselves for each change made. This message must never be invalidated; i.e. it must travel throughout the whole display space. The dX, dY, dW, dH coordinates should always be set correctly to indicate the change in position and size from the original position and size. The id field of the ModifyMsg is ignored by most frames in the system. 12. DisplayMsg The DisplayMsg sends either a redraw request or a print request to a destination frame, according to whether the value of device is screen or printer. When the destination is NIL, a whole DAG of gadgets is implied. When id is set to area, the area u, v, w, h inside the destination frame should be redrawn. Gadgets assumes that these coordinates are relative to the top left-most corner of the destination gadget. Thus v is negative. When printing, the x, y coordinates indicate the absolute printer coordinates of the left-bottom corner of the frame on paper and not the left-bottom corner of the container. When the id is set to full, the frame must print itself as it appears on the display. When the id is set to contents the frame must print its complete contents. For example, a multi-page text can be displayed and printed. The frame can assume that the printer driver has already been initialized. Readying the printer is the task of the sender and is done by calling Printer.Open. 13. LocateMsg This message is broadcast to locate the frame positioned at the absolute coordinates X, Y on the display. The result, if any, is found in the loc field. The frame should return the relative position u, v of X, Y inside itself. Gadgets return these coordinates relative to their top-left corner (i.e. v is typically negative). By convention, the message is invalidated when the loc field is set. 14. SelectMsg When id is set to get, the message is used to return the current object selection, a list, in obj. The parent of the selected objects is returned in the sel field. This message is broadcast with the destination set to NIL. The time of the selection is returned in the time field. Each container frame in the display space typically compares the time of its selection with the time field in the message, updating the returned selection when it is after the time set in the message field. When id is set to set or reset, the destination frame should select or unselect itself. It should never draw itself at this point. This is the task of the message sender. 15. ConsumeMsg When the id is set to drop, the destination frame is requested to consume the list of objects found in the obj field. In this way objects can be dynamically added to a container. The relative u, v coordinates indicate the location inside the container. Typically v is negative. When id is set to integrate, the message is broadcast and indicates that the frame owning the focus (caret) should consume the list of objects. 16. The Broadcast procedure is installed by module Viewers to the default message broadcasting procedure found in that module. 17. TransferBlock TransferBlock is a fast way to read or write the display in a format as close as possible to the native format of the driver. If the driver does not directly use one of the supported formats (defined below), it must select one and translate on-the-fly. The caller must be prepared to handle any of the supported return formats. The value returned by TransferFormat is constant, unless the display mode is changed. TransferBlock performs clipping using the normal clipping rectangle. When reading from the display, the pixels falling outside the clipping rectangle have undefined values. 18. TransferFormat returns unknown - TransferBlock not supported index8 - 8 bits per pixel indexed color555 - 16 bits per pixel XRGB 1x5x5x5 color565 - 16 bits per pixel RGB 5x6x5 color664 - 16 bits per pixel RGB 6x6x4 color888 - 24 bits per pixel RGB 8x8x8 color8888 - 32 bits per pixel XRGB 8x8x8x8 color components: R = red, G = green, B = blue, X = undefined. multibyte values are stored in little-endian order in buf (least-significant byte first). color components are stored in XRGB bit order (B in least-significant bits). 19. Color There are two types of display drivers. "Minimal" drivers that support only indexed color, and "full-featured" drivers that support indexed color and true color. Monochrome drivers should emulate one of the two options. The TrueColor function can be used to determine what kind of driver is active in a display region. A minimal driver only supports color values from 0 to 255 (0 to 0FFH), which are entries into the palette, and color values outside this range produce undefined results (e.g. garbage, index out of range trap). A full-featured driver also supports 24-bit true color values that range from MIN(LONGINT) to MIN(LONGINT)+2^24-1 (80000000H to 80FFFFFFH). The driver translates the color values to the internal format of the display buffer on-the-fly. 20. The RGB function can be used to construct true color values. The RGB components are defined as: R = ASH(col, -16) MOD 256, G = ASH(col, -8) MOD 256, B = col MOD 256, and col = MIN(LONGINT) + ASH(R, 16) + ASH(G, 8) + B, where 0 <= R,G,B <= 255 The RGB function can be used to compose color values, and GetColor can be used to decompose them, as well as to read from the palette. 21. Depth returns the depth of the color palette. 1 - recommend use of color indices BG and FG only. 4 - color indices 0 to 16 supported. 8 - color indices 0 to 255 supported. No driver will support a color palette larger than 8 bits. Instead it might support true color values generated by function RGB. The TrueColor function can be used to check if a driver supports such values. *)

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/4.0/


text:
Oberon/ETH Oberon/2.3.7/GD54xx.Display.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 Display; (* Type: Cirrus Logic	256 Colors 	Date: 2. 5. 96 	Version: 1.0 	Author: Joerg Derungs *) (* works on 5430, not on 5420 *) IMPORT SYSTEM, Objects, Kernel; CONST BG* = 0; FG* = 15;										(*background, foreground*) replace* = 0; paint* = 1; invert* = 2;		  (*operation modes*) remove* = 0; suspend* = 1; restore* = 2; newprinter* = 3; (*ControlMsg id*) reduce* = 0; extend* = 1; move* = 2; (*ModifyMsg id*) display* = 0; state* = 1; (*ModifyMsg mode*) screen* = 0; printer* = 1; (* DisplayMsg device *) full* = 0; area* = 1; contents* = 2; (* DisplayMsg id. *) get* = 0; set* = 1; reset* = 2; (*SelectMsg id*) drop* = 0; integrate* = 1; (*ConsumeMsg id*) unknown* = 0; index8* = 8; color555* = 16; color565* = 17; color664* = 18; color888* = 24; color8888* = 32; BitBLTAdr = 0B8000H; TYPE Color* = LONGINT; Pattern* = LONGINT; PatternPtr = POINTER TO RECORD w, h: CHAR; pixmap: ARRAY 8192 OF CHAR END; List = POINTER TO ListDesc; ListDesc = RECORD next: List; pat: PatternPtr END; Frame* = POINTER TO FrameDesc; FrameDesc* = RECORD (Objects.ObjDesc) next*, dsc*: Frame; X*, Y*, W*, H*: INTEGER END; FrameMsg* = RECORD (Objects.ObjMsg) F*: Frame; (*target*) x*, y*, res*: INTEGER END; ControlMsg* = RECORD (FrameMsg) id*: INTEGER END; ModifyMsg* = RECORD (FrameMsg) id*, mode*: INTEGER; dX*, dY*, dW*, dH*: INTEGER; X*, Y*, W*, H*: INTEGER END; DisplayMsg* = RECORD (FrameMsg) device*: INTEGER; id*: INTEGER; u*, v*, w*, h*: INTEGER END; LocateMsg* = RECORD (FrameMsg) loc*: Frame; X*, Y*, u*, v*: INTEGER END; SelectMsg* = RECORD (FrameMsg) id*: INTEGER; time*: LONGINT; sel*: Frame; obj*: Objects.Object END; ConsumeMsg* = RECORD (FrameMsg) id*: INTEGER; u*, v*: INTEGER; obj*: Objects.Object END; MsgProc* = PROCEDURE (VAR M: FrameMsg); BitBLTPtr = POINTER TO RECORD bg : ARRAY 4 OF SHORTINT;					(* Background Color for Patterns *) fg : ARRAY 4 OF SHORTINT;					 (* Foreground Color for Patterns *) Width, Height : INTEGER;						 (* BLT Width & Height *) DestLen, SrcLen : INTEGER;					 (* Dest & Src Scanline Length *) DestLo : INTEGER; DestHi : SHORTINT;	(* Dest address *) SrcLo : INTEGER; SrcHi : SHORTINT;		 (* Src address *) Mask : SHORTINT;									 (* Map Mask *) Mode, dmy2 : SHORTINT;						 (* BLT Mode *) Op : SHORTINT;										(* Raster Operation *) dmy3 : ARRAY 37 OF CHAR; Start : SHORTINT;									 (* Start / Reset *) END; VAR Unit*: LONGINT; (* RasterUnit = Unit/36000 mm *) Left*,			(* left margin of black-and-white maps *) ColLeft*,	  (* left margin of color maps *) Bottom*,	 (* bottom of primary map *) UBottom*,	(* bottom of secondary map *) Width*,		 (* map width *) Height*:		(* map hight*) INTEGER; arrow*, star*, cross*, downArrow*, hook*, grey0*, grey1*, grey2*, ticks*, solid*: Pattern; Broadcast*: MsgProc; Pat: List; clipx, clipy, clipright, cliptop : INTEGER; CurBank, patterns, patLo : INTEGER; patHi : SHORTINT; PageSize : LONGINT; DispMem : LONGINT; depth: INTEGER; palette: ARRAY 256 OF LONGINT; PROCEDURE Map*(x: LONGINT): LONGINT; BEGIN RETURN SYSTEM.VAL (LONGINT, DispMem) END Map; PROCEDURE Min (a, b : INTEGER) : INTEGER; BEGIN	IF a < b THEN RETURN a ELSE RETURN b END END Min; PROCEDURE Max (a, b : INTEGER) : INTEGER; BEGIN	IF a > b THEN RETURN a ELSE RETURN b END END Max; PROCEDURE AdjustClip*(x, y, w, h: LONGINT); BEGIN clipx := Max (clipx, SHORT(x));	clipy := Max (clipy, SHORT(y)); clipright := Min (clipright, SHORT(x+w));	cliptop := Min (cliptop, SHORT(y+h)); END AdjustClip; PROCEDURE GetDim*(pat: Pattern; VAR w, h: INTEGER); VAR s: CHAR; BEGIN	SYSTEM.GET(pat, s); w := ORD(s); SYSTEM.GET(pat+1, s); h := ORD(s) END GetDim; PROCEDURE ResetClip*; BEGIN	clipx := 0; clipy := UBottom; clipright := Width; cliptop := Height END ResetClip; PROCEDURE SetClip*(x, y, w, h: LONGINT); BEGIN clipx := Max (SHORT(x), 0);	clipy := Max (SHORT(y), UBottom); clipright := Min (SHORT(x+w), Width);	cliptop := Min (SHORT(y+h), Height); END SetClip; PROCEDURE GetClip*(VAR x, y, w, h: INTEGER); BEGIN	x:= clipx; y:= clipy; w:= clipright-clipx; h:= cliptop-clipy END GetClip; PROCEDURE SetColor*(col: Color; red, green, blue: LONGINT);	(* 0 <= col, red, green, blue < 256 *) BEGIN palette[col] := ASH(ASH(red, 8) + green, 8) + blue; red := red DIV 4; green := green DIV 4; blue := blue DIV 4; SYSTEM.PORTOUT(3C8H, CHR(col));			(* VGA - write color entry *) SYSTEM.PORTOUT(3C9H, CHR(red)); SYSTEM.PORTOUT(3C9H, CHR(green)); SYSTEM.PORTOUT(3C9H, CHR(blue)) END SetColor; PROCEDURE GetColor*(col: Color; VAR red, green, blue: INTEGER); BEGIN IF col >= 0 THEN col := palette[col] END; red := SHORT(ASH(col, -16) MOD 256); green := SHORT(ASH(col, -8) MOD 256); blue := SHORT(col MOD 256) END GetColor; PROCEDURE RGB*(red, green, blue: LONGINT): Color; BEGIN RETURN MIN(LONGINT) + ASH(red, 16) + ASH(green, 8) + blue END RGB; PROCEDURE -XOR (adr : LONGINT; val : CHAR); CODE {SYSTEM.i386} POP EAX POP EBX XOR 0[EBX], AL END XOR; PROCEDURE Dot*(col: Color; x, y, mode: LONGINT); VAR Offset : LONGINT; Bank : INTEGER; BEGIN IF (y < clipy) OR (x < clipx) OR (y >= cliptop) OR (x >= clipright) THEN RETURN END; Offset := (Height-y-1)*Width + x; 	Bank := SHORT (Offset DIV PageSize); Offset := Offset MOD PageSize; IF Bank # CurBank THEN CurBank := Bank * SHORT(PageSize DIV 4092); SYSTEM.PORTOUT (03CEH, 09H); SYSTEM.PORTOUT (03CFH, CHR(CurBank)) END; IF mode = invert THEN XOR (DispMem+Offset, CHR(col)) ELSE SYSTEM.PUT(DispMem+Offset, CHR(col)) END END Dot; PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT); VAR SourceAddr, DestAddr, delta : LONGINT; BitBLT : BitBLTPtr; BEGIN IF dx+w > clipright THEN w := clipright - dx END; IF dy+h > cliptop THEN h := cliptop - dy END; IF dx < clipx THEN w := w - (clipx-dx); sx := sx + (clipx-dx); dx := clipx END; IF dy < clipy THEN h := h - (clipy-dy); sy := sy + (clipy-dy); dy := clipy END; IF (w <= 0) OR (h <= 0) THEN RETURN END; BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr); SourceAddr := (Height-sy-h)*Width + sx; DestAddr := (Height-dy-h)*Width + dx; IF DestAddr <= SourceAddr THEN BitBLT.Mode := 0 ELSE delta := (h-1)*Width + w-1; SourceAddr := SourceAddr + delta; DestAddr := DestAddr + delta; BitBLT.Mode := 1 END; BitBLT.Width := SHORT(w-1);	BitBLT.Height := SHORT(h-1); BitBLT.DestLo := SHORT (DestAddr MOD (256*256));	BitBLT.DestHi := SHORT (SHORT (DestAddr DIV (256*256))); BitBLT.SrcLo := SHORT (SourceAddr MOD (256*256));	BitBLT.SrcHi := SHORT (SHORT (SourceAddr DIV (256*256))); IF mode < 2 THEN BitBLT.Op := 0DH ELSE BitBLT.Op := 59H END;	BitBLT.Start := 2; REPEAT UNTIL (BitBLT.Start MOD 2 = 0); END CopyBlock; PROCEDURE SetMode*(x: LONGINT; s: SET); BEGIN END SetMode; PROCEDURE ReversePattern (pat, dest : LONGINT; len, minw, maxw, minh, maxh : INTEGER); VAR a, b : INTEGER; i, j, k, outlen : INTEGER; BEGIN pat := pat+2+len*(maxh-1); outlen := (maxw-minw+7) DIV 8; FOR k := minh TO maxh-1 DO 		i := minw;	a := 0;	SYSTEM.GET(pat + i DIV 8, SYSTEM.VAL(CHAR, a)); IF i MOD 8 # 0 THEN FOR j := 1 TO i MOD 8 DO a := a DIV 2 END END; j := 0;	b := 0; REPEAT	b := b*2 + a MOD 2;	a := a DIV 2; INC (i);	IF i MOD 8 = 0 THEN SYSTEM.GET(pat + i DIV 8, SYSTEM.VAL(CHAR, a)) END; IF j MOD 8 = 7 THEN SYSTEM.PUT(dest + j DIV 8, CHR(b)); b := 0 END;	INC (j) UNTIL j = outlen*8; SYSTEM.PUT(dest + j DIV 8, CHR(b)); pat := pat - len; dest := dest + outlen END; END ReversePattern; PROCEDURE CopyPattern* (col: Color; pat: Pattern; x, y, mode: LONGINT); VAR k : INTEGER; w, h, len : INTEGER; dst : LONGINT; minh, maxh, minw, maxw : INTEGER; BitBLT : BitBLTPtr; BEGIN GetDim (pat, w, h); len := (w+7) DIV 8; minh := 0; maxh := h; minw := 0; maxw := w; 	IF x < clipx THEN minw := SHORT(clipx-x) END; IF x+w > clipright THEN maxw := SHORT(clipright-x) END; IF y < clipy THEN minh := SHORT(clipy-y) END; IF y+h > cliptop THEN maxh := SHORT(cliptop-y) END; IF (minh >= maxh) OR (minw >= maxw) THEN RETURN END; IF CurBank # patterns THEN CurBank := patterns; SYSTEM.PORTOUT (03CEH, 09H); SYSTEM.PORTOUT (03CFH, CHR(CurBank)) END; ReversePattern (pat, 0A0000H, len, minw, maxw, minh, maxh); dst := (Height-y-maxh)*Width + x + minw; BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr); FOR k := 0 TO 3 DO BitBLT.fg[k] := SYSTEM.VAL (SHORTINT, col) END; IF mode = replace THEN col := BG ELSE col := -col-1 END; FOR k := 0 TO 3 DO BitBLT.bg[k] := SYSTEM.VAL(SHORTINT, col) END; BitBLT.Width := maxw-minw-1;	BitBLT.Height := maxh-minh-1; BitBLT.DestLo := SYSTEM.VAL (INTEGER, dst);	BitBLT.DestHi := SHORT (SHORT (dst DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; IF mode = replace THEN BitBLT.Mode := SYSTEM.VAL (SHORTINT, 80H) ELSE BitBLT.Mode := SYSTEM.VAL (SHORTINT, 88H) END; IF mode = invert THEN BitBLT.Op := 59H ELSE BitBLT.Op := 0DH END; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; END CopyPattern; PROCEDURE ReplConst* (col: Color; x, y, w, h, mode: LONGINT); VAR fill : SET; dest : LONGINT; BitBLT : BitBLTPtr; BEGIN IF x < clipx THEN w := w - (clipx-x); x := clipx END; IF y < clipy THEN h := h - (clipy-y); y := clipy END; IF x+w > clipright THEN w := clipright-x END; IF y+h > cliptop THEN h := cliptop-y END; IF (h <= 0) OR (w <= 0) THEN RETURN END; IF CurBank # patterns THEN CurBank := patterns; SYSTEM.PORTOUT (03CEH, 09H); SYSTEM.PORTOUT (03CFH, CHR(patterns)) END; fill := {0..31}; SYSTEM.PUT(0A0000H, fill); SYSTEM.PUT(0A0004H, fill); dest := (Height-y-h)*Width + x; 	BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr); BitBLT.fg[0] := SYSTEM.VAL(SHORTINT, col); BitBLT.Width := SHORT(w-1);	BitBLT.Height := SHORT(h-1); BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Mode := SYSTEM.VAL (SHORTINT, 0C0H); IF mode = invert THEN BitBLT.Op := 59H ELSE BitBLT.Op := 0DH END; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0 END ReplConst; PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT); VAR dh, dw, pw, ph, len, rw, rh : INTEGER; row, dest : LONGINT; i, j : INTEGER; bcol : INTEGER; BitBLT : BitBLTPtr; BEGIN IF x < clipx THEN w := w - (clipx-x); x := clipx END; IF y < clipy THEN h := h - (clipy-y); y := clipy END; IF x+w > clipright THEN w := clipright-x END; IF y+h > cliptop THEN h := cliptop-y END; IF (h <= 0) OR (w <= 0) THEN RETURN END; IF CurBank # patterns THEN CurBank := patterns; SYSTEM.PORTOUT (03CEH, 09H); SYSTEM.PORTOUT (03CFH, SYSTEM.VAL (CHAR, CurBank)) END; BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr); GetDim (pat, pw, ph);	len := (pw+7) DIV 8; dw := pw - (pw + SHORT(x-px) MOD pw) MOD pw; dh := ph - (ph + SHORT(y-py) MOD ph) MOD ph; FOR i := 0 TO 3 DO BitBLT.fg[i] := SYSTEM.VAL(SHORTINT, col) END; IF mode = replace THEN bcol := BG ELSE bcol := SHORT(-col-1) END; FOR i := 0 TO 3 DO BitBLT.bg[i] := SHORT(bcol) END; IF mode = replace THEN BitBLT.Mode := SYSTEM.VAL (SHORTINT, 80H) ELSE BitBLT.Mode := SYSTEM.VAL (SHORTINT, 88H) END; IF mode = invert THEN BitBLT.Op := 59H ELSE BitBLT.Op := 0DH END; IF dh > h THEN ph := ph-SHORT(dh-h); dh := SHORT(h) END; IF dw > w THEN pw := pw-SHORT(dw-w); dw := SHORT(w) END; w := w-dw;	h := h-dh;	y := y+dh; IF (dh > 0) & (w > 0) THEN		(* lower row *) ReversePattern (pat, 0A0000H, len, 0, pw, ph-dh, ph); BitBLT.Width := pw-1;	BitBLT.Height := dh-1; dest := (Height-y)*Width + x+dw; FOR i := 1 TO SHORT(w) DIV pw DO 			BitBLT.DestLo := SYSTEM.VAL (INTEGER, dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; dest := dest + pw; END; rw := SHORT(w) MOD pw; IF rw > 0 THEN ReversePattern (pat, 0A0000H, len, 0, rw, ph-dh, ph); BitBLT.Width := rw-1; BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; END; END; IF (dw > 0) & (h > 0) THEN		(* left column *) ReversePattern (pat, 0A0000H, len, pw-dw, pw, 0, ph); BitBLT.Width := dw-1;	BitBLT.Height := ph-1; dest := (Height-y)*Width + x; 		FOR i := 1 TO SHORT(h) DIV ph DO 			dest := dest - LONG(Width)*ph; BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; END; rh := SHORT(h) MOD ph; IF rh > 0 THEN ReversePattern (pat, 0A0000H, len, pw-dw, pw, 0, rh); BitBLT.Height := rh-1; dest := dest - LONG(Width)*rh; BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; END; END; IF (dw > 0) & (dh > 0) THEN		(* bottom left corner *) ReversePattern (pat, 0A0000H, len, pw-dw, pw, ph-dh, ph); BitBLT.Width := dw-1;	BitBLT.Height := dh-1; dest := (Height-y)*Width + x; 		BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; END; x := x+dw; ReversePattern (pat, 0A0000H, len, 0, pw, 0, ph);		(* easy rectangle *)	(*********************************) row := (Height-y)*Width + x; 	BitBLT.Width := pw-1;	BitBLT.Height := ph-1; FOR i := 1 TO SHORT(w) DIV pw DO 		dest := row; FOR j := 1 TO SHORT(h) DIV ph DO 			dest := dest - LONG(Width)*ph; BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; END; row := row+pw; END; rh := SHORT(h) MOD ph; IF rh > 0 THEN			(* top line *) BitBLT.Height := rh-1; SYSTEM.MOVE (0A0000H + (ph-rh)*len, 0A0000H, rh*len); dest := (Height-y-h)*Width + x; 		FOR i := 1 TO SHORT(w) DIV pw DO 			BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; dest := dest + pw 		END; END; rw := SHORT(w) MOD pw; IF rw > 0 THEN			(* last column *) ReversePattern (pat, 0A0000H, len, 0, rw, 0, ph); BitBLT.Width := rw-1;	BitBLT.Height := ph-1; dest := (Height-y)*Width + x+w-rw; FOR i := 1 TO SHORT(h) DIV ph DO 			dest := dest - LONG(Width)*ph; BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; END; IF rh > 0 THEN BitBLT.Height := rh-1; SYSTEM.MOVE (0A0000H + (ph-rh)*((rw+7) DIV 8), 0A0000H, rh*((rw+7) DIV 8)); dest := dest - LONG(Width)*rh; BitBLT.DestLo := SHORT (dest);	BitBLT.DestHi := SHORT (SHORT (dest DIV (256*256))); BitBLT.SrcLo := patLo;	BitBLT.SrcHi := patHi; BitBLT.Start := 2; REPEAT UNTIL BitBLT.Start MOD 2 = 0; END END END FillPattern; PROCEDURE ReplPattern*(col: Color; pat: Pattern; x, y, w, h, mode: LONGINT); BEGIN FillPattern (col, pat, 0, 0, x, y, w, h, mode) END ReplPattern; PROCEDURE NewPattern*(w, h: LONGINT; VAR image: ARRAY OF SET): Pattern; VAR len, src, dest, i: LONGINT; p: PatternPtr; pl: List; BEGIN len := (w+7) DIV 8; SYSTEM.NEW(p, 4+len*h); p.w := CHR(w); p.h := CHR(h); src := SYSTEM.ADR(image); dest := SYSTEM.ADR(p.pixmap); i := 0; WHILE i < h DO SYSTEM.MOVE(src, dest, len); INC(src, 4); INC(dest, len); INC(i) END; NEW(pl); pl.pat := p;  pl.next := Pat;  Pat := pl;	(* put in list to avoid GC *) RETURN SYSTEM.ADR(p.w) END NewPattern; PROCEDURE CreatePatterns; VAR image: ARRAY 256 OF SET; BEGIN image[0] := {13}; image[1] := {12..14}; image[2] := {11..13}; image[3] := {10..12}; image[4] := {9..11}; image[5] := {8..10}; image[6] := {7..9}; image[7] := {0, 6..8}; image[8] := {0, 1, 5..7}; image[9] := {0..2, 4..6}; image[10] := {0..5}; image[11] := {0..4}; image[12] := {0..5}; image[13] := {0..6}; image[14] := {0..7}; arrow := NewPattern(15, 15, image); image[0] := {0, 10}; image[1] := {1, 9}; image[2] := {2, 8}; image[3] := {3, 7}; image[4] := {4, 6}; image[5] := {}; image[6] := {4, 6}; image[7] := {3, 7}; image[8] := {2, 8}; image[9] := {1, 9}; image[10] := {0, 10}; cross := NewPattern(11, 11, image); image[0] := {6}; image[1] := {5..7}; image[2] := {4..8}; image[3] := {3..9}; image[4] := {2..10}; image[5] := {5..7}; image[6] := {5..7}; image[7] := {5..7}; image[8] := {5..7}; image[9] := {5..7}; image[10] := {5..7}; image[11] := {5..7}; image[12] := {5..7}; image[13] := {5..7}; image[14] := {}; downArrow := NewPattern(15, 15, image); image[0] := {0, 4, 8, 12}; image[1] := {}; image[2] := {2, 6, 10, 14}; image[3] := {}; image[4] := {0, 4, 8, 12}; image[5] := {}; image[6] := {2, 6, 10, 14}; image[7] := {}; image[8] := {0, 4, 8, 12}; image[9] := {}; image[10] := {2, 6, 10, 14}; image[11] := {}; image[12] := {0, 4, 8, 12}; image[13] := {}; image[14] := {2, 6, 10, 14}; image[15] := {}; grey0 := NewPattern(16, 16, image); image[0] := {0, 2, 4, 6, 8, 10, 12, 14}; image[1] := {1, 3, 5, 7, 9, 11, 13, 15}; image[2] := {0, 2, 4, 6, 8, 10, 12, 14}; image[3] := {1, 3, 5, 7, 9, 11, 13, 15}; image[4] := {0, 2, 4, 6, 8, 10, 12, 14}; image[5] := {1, 3, 5, 7, 9, 11, 13, 15}; image[6] := {0, 2, 4, 6, 8, 10, 12, 14}; image[7] := {1, 3, 5, 7, 9, 11, 13, 15}; image[8] := {0, 2, 4, 6, 8, 10, 12, 14}; image[9] := {1, 3, 5, 7, 9, 11, 13, 15}; image[10] := {0, 2, 4, 6, 8, 10, 12, 14}; image[11] := {1, 3, 5, 7, 9, 11, 13, 15}; image[12] := {0, 2, 4, 6, 8, 10, 12, 14}; image[13] := {1, 3, 5, 7, 9, 11, 13, 15}; image[14] := {0, 2, 4, 6, 8, 10, 12, 14}; image[15] := {1, 3, 5, 7, 9, 11, 13, 15}; grey1 := NewPattern(16, 16, image); image[0] := {0, 1, 4, 5, 8, 9, 12, 13}; image[1] := {0, 1, 4, 5, 8, 9, 12, 13}; image[2] := {2, 3, 6, 7, 10, 11, 14, 15}; image[3] := {2, 3, 6, 7, 10, 11, 14, 15}; image[4] := {0, 1, 4, 5, 8, 9, 12, 13}; image[5] := {0, 1, 4, 5, 8, 9, 12, 13}; image[6] := {2, 3, 6, 7, 10, 11, 14, 15}; image[7] := {2, 3, 6, 7, 10, 11, 14, 15}; image[8] := {0, 1, 4, 5, 8, 9, 12, 13}; image[9] := {0, 1, 4, 5, 8, 9, 12, 13}; image[10] := {2, 3, 6, 7, 10, 11, 14, 15}; image[11] := {2, 3, 6, 7, 10, 11, 14, 15}; image[12] := {0, 1, 4, 5, 8, 9, 12, 13}; image[13] := {0, 1, 4, 5, 8, 9, 12, 13}; image[14] := {2, 3, 6, 7, 10, 11, 14, 15}; image[15] := {2, 3, 6, 7, 10, 11, 14, 15}; grey2 := NewPattern(16, 16, image); image[0] := {0..2, 8..11}; image[1] := {0..2, 7..10}; image[2] := {0..2, 6..9}; image[3] := {0..2, 5..8}; image[4] := {0..2, 4..7}; image[5] := {0..6}; image[6] := {0..5}; image[7] := {0..4}; image[8] := {0..3}; image[9] := {0..2}; image[10] := {0, 1}; image[11] := {0}; hook:= NewPattern(12, 12, image); image[0] := {7}; image[1] := {7}; image[2] := {2, 7, 12}; image[3] := {3, 7, 11}; image[4] := {4, 7, 10}; image[5] := {5, 7, 9}; image[6] := {6..8}; image[7] := {0..6, 8..14}; image[8] := {6..8}; image[9] := {5, 7, 9}; image[10] := {4, 7, 10}; image[11] := {3, 7, 11}; image[12] := {2, 7, 12}; image[13] := {7}; image[14] := {7}; star := NewPattern(15, 15, image); image[0] := {}; image[1] := {}; image[2] := {0}; image[3] := {}; image[4] := {}; image[5] := {}; image[6] := {}; image[7] := {}; image[8] := {}; image[9] := {}; image[10] := {}; image[11] := {}; image[12] := {}; image[13] := {}; image[14] := {}; image[15] := {}; ticks := NewPattern(16, 16, image); image[0] := -{}; image[1] := -{}; solid := NewPattern(16, 2, image); END CreatePatterns; PROCEDURE Depth*(x: LONGINT): INTEGER; BEGIN RETURN depth END Depth; PROCEDURE TrueColor*(x: LONGINT): BOOLEAN; BEGIN RETURN FALSE END TrueColor; PROCEDURE DisplayBlock*(adr, dx, dy, w, h, sx, sy, mode: LONGINT); VAR BlockLen : LONGINT; Source, Dest : LONGINT; i, j, len : INTEGER; Screen, Block, Temp : LONGINT; BitBLT : BitBLTPtr; BEGIN BlockLen := 0; SYSTEM.GET(adr+8, BlockLen); len := SHORT(w+3) DIV 4; SYSTEM.GET(adr+12, Source); Source := Source + dy*BlockLen + dx; Dest := (Height-sy-1)*Width + sx; Screen := 0A0000H; BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr); BitBLT.Width := SHORT(w-1);	BitBLT.Height := 0; BitBLT.Mode := 4; IF mode = invert THEN BitBLT.Op := 59H ELSE BitBLT.Op := 0DH END; FOR i := 0 TO SHORT(h-1) DO 		Block := Source; BitBLT.DestLo := SYSTEM.VAL (INTEGER, Dest); BitBLT.DestHi := SHORT (SHORT (Dest DIV (256*256))); BitBLT.Start := 2; FOR j := 0 TO (len-1)*4 BY 4 DO 			SYSTEM.GET(Block+j, Temp); SYSTEM.PUT(Screen+j, Temp) END; REPEAT UNTIL BitBLT.Start MOD 2 = 0; Dest := Dest-Width;	Source := Source+BlockLen; END; END DisplayBlock; PROCEDURE TransferFormat*(x: LONGINT): LONGINT; BEGIN RETURN unknown END TransferFormat; PROCEDURE TransferBlock*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, mode: LONGINT); BEGIN HALT(99) END TransferBlock; PROCEDURE InitRegister; CODE {SYSTEM.i386} MOV AX, 0017H			; map BLT engine to 0B8000H MOV DX, 03C4H OUT DX, AL 	MOV DX, 03C5H IN AL, DX						; GD5430 - map BitBLT to memory OR AX, 0044H OUT DX, AL 	MOV DispMem, 0A0000H MOV EBX, BitBLTAdr			; reset BLT engine MOV AX, 4 MOV 40H[EBX], AL END InitRegister; PROCEDURE InitBitBLT; VAR BitBLT: BitBLTPtr; BEGIN BitBLT := SYSTEM.VAL(BitBLTPtr, BitBLTAdr); BitBLT.DestLen := Width;	BitBLT.SrcLen := Width; BitBLT.Mask := 0 END InitBitBLT; (* StrToInt - Convert a string to an integer *) PROCEDURE StrToInt(VAR i: LONGINT; VAR s: ARRAY OF CHAR): LONGINT; VAR vd, vh, sgn, d: LONGINT; hex: BOOLEAN; BEGIN vd := 0; vh := 0;  hex := FALSE; IF s[i] = "-" THEN sgn := -1; INC(i) ELSE sgn := 1 END; LOOP IF (s[i] >= "0") & (s[i] <= "9") THEN d := ORD(s[i])-ORD("0") ELSIF (CAP(s[i]) >= "A") & (CAP(s[i]) <= "F") THEN d := ORD(CAP(s[i]))-ORD("A")+10; hex := TRUE ELSE EXIT END; vd := 10*vd + d; vh := 16*vh + d; 		INC(i) END; IF CAP(s[i]) = "H" THEN hex := TRUE; INC(i) END;	(* optional H *) IF hex THEN vd := vh END; RETURN sgn * vd END StrToInt; (* GetVal - Get config string and convert to integer. *) PROCEDURE GetVal(name: ARRAY OF CHAR; default: LONGINT): LONGINT; VAR v: LONGINT; s: ARRAY 10 OF CHAR;  p: LONGINT; BEGIN Kernel.GetConfig(name, s); IF s[0] = 0X THEN v := default ELSE p := 0; v := StrToInt(p, s) 	END; RETURN v END GetVal; PROCEDURE Init; CONST PatSize = 64*1024; VAR mem: LONGINT; BEGIN Width := SHORT(GetVal("DWidth", 1024));	(* assume 1024 if not specified *) Height := SHORT(GetVal("DHeight", 768));	(* assume 768 if not specified *) IF GetVal("Color", 1) = 0 THEN depth := 1 ELSE depth := 8 END; mem := GetVal("DMem", 0)*1024; IF mem = 0 THEN	(* compute default *) mem := 512*1024; WHILE LONG(Width)*Height >= mem DO mem := mem*2 END END; DEC(mem, PatSize);	(* reserve space for patterns *) UBottom := SHORT(Height - mem DIV Width); patterns := SHORT(mem DIV 4096);	(* page number of patterns *) patHi := SHORT(SHORT(mem DIV 10000H)); patLo := SHORT(mem MOD 10000H) END Init; BEGIN Init; Left:= 0; ColLeft:= 0; Bottom:= 0; Pat := NIL; ResetClip; CreatePatterns; Unit := 10000; CurBank:= patterns; SYSTEM.PORTOUT (03CEH, 09H); SYSTEM.PORTOUT (03CFH, CHR(CurBank)); PageSize := 256 * 256; InitRegister; InitBitBLT; ReplConst(1, Width DIV 2, Height DIV 2, Width DIV 2, Height DIV 2, replace); END Display. Compiler.Compile GD54xx.Display.Mod\X ~


text:
Oberon/ETH Oberon/2.3.7/OGLDisplay.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 OGLDisplay; (** AUTHOR "fkuhn"; PURPOSE "Oberon Graphics Library display base"; *) TYPE State* = POINTER TO StateDesc; StateDesc* = RECORD activate*: PROCEDURE(state, oldState: State); deactivate*: PROCEDURE(state, newState: State) END; VAR cardBase, linBase: LONGINT; cardSet, linSet: BOOLEAN; currentState* : State; (** 	 sets the address of the Graphic Registers 	this has to be done exactly once by the Display module **) PROCEDURE SetCardBase*(adr: LONGINT); BEGIN cardBase := adr; cardSet := TRUE END SetCardBase; (** 	 sets the address of the framebuffer: 	this has to be done exactly once by the Display module **) PROCEDURE SetLinearBase*(adr: LONGINT); BEGIN linBase := adr; linSet := TRUE END SetLinearBase; (** returns the address of the Graphic Card Registers **) PROCEDURE CardBase*: LONGINT; BEGIN IF cardSet THEN RETURN cardBase ELSE HALT(1000) END END CardBase; (** returns the address of the framebuffer **) PROCEDURE LinearBase*: LONGINT; BEGIN IF linSet THEN RETURN linBase ELSE HALT(1000) END END LinearBase; (** a default for the activate method of state, does nothing **) PROCEDURE ActivateState*(state, oldState: State); BEGIN END ActivateState; (** a default for the deactivate method of state, does nothing **) PROCEDURE DeactivateState*(state, newState: State); BEGIN END DeactivateState; (** ensures that the given state is active **) PROCEDURE SwitchState*(state: State); VAR current: State; BEGIN current := currentState; currentState := state; current.deactivate(current, state); state.activate(state, current) END SwitchState; (* (** ensures that the given state is active **) PROCEDURE SwitchState*(state: State); BEGIN 	currentState.deactivate(currentState, state); 	state.activate(state, currentState) END SwitchState; *) BEGIN cardSet := FALSE; linSet := FALSE; NEW(currentState); currentState.activate := ActivateState; currentState.deactivate := DeactivateState END OGLDisplay. 05.01.03 20:13:02

title: Oberon/ETH Oberon/2.3.7/OGLDisplay.Mod


text:
Oberon/ETH Oberon/2.3.7/S3C805.Display.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 Display;	(* 86C805/801 ard, eos, pjm *) IMPORT SYSTEM, Objects, Kernel; CONST BG* = 0; FG* = 15; (*background, foreground*) replace* = 0; paint* = 1; invert* = 2; (*operation modes*) remove* = 0; suspend* = 1; restore* = 2; newprinter* = 3; (*ControlMsg id*) reduce* = 0; extend* = 1; move* = 2; (*ModifyMsg id*) display* = 0; state* = 1; (*ModifyMsg mode*) screen* = 0; printer* = 1; (* DisplayMsg device *) full* = 0; area* = 1; contents* = 2; (* DisplayMsg id. *) get* = 0; set* = 1; reset* = 2; (*SelectMsg id*) drop* = 0; integrate* = 1; (*ConsumeMsg id*) unknown* = 0; index8* = 8; color555* = 16; color565* = 17; color664* = 18; color888* = 24; color8888* = 32; (* S3 Constants *) index = 3D4H; data = 3D5H; Xpos = 20H; Ypos = 80H; Ymajor = 40H; advFnCtrl = 4AE8H; curX = 86E8H; curY = 82E8H; axStep = 8AE8H; diaStep = 8EE8H; errTerm = 92E8H; majAxis = 96E8H; minAxis = 0BEE8H; gpStat = 9AE8H; cmdReg = 9AE8H; shortStroke = 9EE8H; BGcol = 0A2E8H; FGcol = 0A6E8H; wrtMask = 0AAE8H; rdMask = 0AEE8H; BGmix = 0B6E8H; FGmix = 0BAE8H; MFcont = 0BEE8H; pixTrans = 0E2E8H; TYPE Color* = LONGINT; Pattern* = LONGINT; PatternPtr = POINTER TO RECORD w, h: CHAR; pixmap: ARRAY 8192 OF CHAR END; List = POINTER TO ListDesc; ListDesc = RECORD next: List; pat: PatternPtr END; Frame* = POINTER TO FrameDesc; FrameDesc* = RECORD (Objects.ObjDesc) next*, dsc*: Frame; X*, Y*, W*, H*: INTEGER END; FrameMsg* = RECORD (Objects.ObjMsg) F*: Frame; (*target*) x*, y*, res*: INTEGER END; ControlMsg* = RECORD (FrameMsg) id*: INTEGER END; ModifyMsg* = RECORD (FrameMsg) id*, mode*: INTEGER; dX*, dY*, dW*, dH*: INTEGER; X*, Y*, W*, H*: INTEGER END; DisplayMsg* = RECORD (FrameMsg) device*: INTEGER; id*: INTEGER; u*, v*, w*, h*: INTEGER END; LocateMsg* = RECORD (FrameMsg) loc*: Frame; X*, Y*, u*, v*: INTEGER END; SelectMsg* = RECORD (FrameMsg) id*: INTEGER; time*: LONGINT; sel*: Frame; obj*: Objects.Object END; ConsumeMsg* = RECORD (FrameMsg) id*: INTEGER; u*, v*: INTEGER; obj*: Objects.Object END; MsgProc* = PROCEDURE (VAR M: FrameMsg); VAR Unit*: LONGINT; (* RasterUnit = Unit/36000 mm *) Left*, (* left margin of black-and-white maps *) ColLeft*, (* left margin of color maps *) Bottom*, (* bottom of primary map *) UBottom*, (* bottom of secondary map *) Width*, (* map width *) Height*: (* map hight*) INTEGER; arrow*, star*, cross*, downArrow*, hook*, grey0*, grey1*, grey2*, ticks*, solid*: Pattern; Broadcast*: MsgProc; dmem: LONGINT; Pat: List; clipx, clipy, clipright, cliptop, height, width: INTEGER;	(* clipping variables *) pixctrl1, pixctrl2, copycmd: LONGINT; mask: INTEGER; depth: INTEGER; palette: ARRAY 256 OF LONGINT; PROCEDURE WaitFIFOempty; CODE {SYSTEM.i386} MOV DX, 9AE8H lab1: IN AX, DX 		AND AX, 200H JNZ lab1 END WaitFIFOempty; PROCEDURE EnableRegs; BEGIN WaitFIFOempty; SYSTEM.PORTOUT(wrtMask, mask);		; (* Write mask *) SYSTEM.PORTOUT(rdMask, mask);		; (* Read mask *) END EnableRegs; PROCEDURE max (i, j: INTEGER): INTEGER; BEGIN IF i >= j THEN RETURN i ELSE RETURN j END END max; PROCEDURE min (i, j: INTEGER): INTEGER; BEGIN	IF i >= j THEN RETURN j ELSE RETURN i END END min; PROCEDURE Map*(x: LONGINT): LONGINT; BEGIN RETURN 0A0000H	(* Start of the video RAM *) END Map; PROCEDURE AdjustClip*(x, y, w, h: LONGINT); VAR right, top, left, bottom: INTEGER; BEGIN right := SHORT(x + w); top := SHORT(y + h); clipx := max(clipx, SHORT(x)); clipy := max(clipy, SHORT(y)); clipright := min(right, clipright); cliptop := min(top, cliptop); top := height-1-cliptop; left := clipx; bottom := height-1-clipy; right := clipright-1; IF top < 0 THEN top := 0 ELSIF top > height-1 THEN top := height-1 END; IF left < 0 THEN left := 0 ELSIF left > width THEN left := width END; IF bottom < 0 THEN bottom := 0 ELSIF bottom > height-1 THEN bottom := height-1 END; IF right < 0 THEN right := 0 ELSIF right > width THEN right := width END; WaitFIFOempty; SYSTEM.PORTOUT(MFcont, 1000H + top);	(* top *) SYSTEM.PORTOUT(MFcont, 2000H + left); 			 (* left *) SYSTEM.PORTOUT(MFcont, 3000H + bottom);	(* bottom *) SYSTEM.PORTOUT(MFcont, 4000H + right); 		 (* right *) END AdjustClip; PROCEDURE GetDim*(pat: Pattern; VAR w, h: INTEGER); VAR s: CHAR; BEGIN SYSTEM.GET(pat, s); w := ORD(s); SYSTEM.GET(pat+1, s); h := ORD(s); END GetDim; PROCEDURE ResetClip*; BEGIN clipx := 0; clipy := UBottom; clipright := width; cliptop := height-1; WaitFIFOempty; SYSTEM.PORTOUT(MFcont, 1000H);	(* top *) SYSTEM.PORTOUT(MFcont, 2000H);	(* left *) SYSTEM.PORTOUT(MFcont, 3000H + height-1-UBottom);	(* bottom *) SYSTEM.PORTOUT(MFcont, 4000H + width-1);	(* right *) END ResetClip; PROCEDURE SetClip*(x, y, w, h: LONGINT); VAR right, top, left, bottom: INTEGER; BEGIN clipright := SHORT(x+w); cliptop := SHORT(y+h); clipy := SHORT(y); clipx := SHORT(x); top := height-1-cliptop; left := clipx; bottom := height-1-clipy; right := clipright-1; WaitFIFOempty; SYSTEM.PORTOUT(MFcont, 1000H + top);	(* top *) SYSTEM.PORTOUT(MFcont, 2000H + left); 			 (* left *) SYSTEM.PORTOUT(MFcont, 3000H + bottom);	(* bottom *) SYSTEM.PORTOUT(MFcont, 4000H + right); 		 (* right *) END SetClip; PROCEDURE GetClip*(VAR x, y, w, h: INTEGER); BEGIN x := clipx; y := clipy; w := clipright - clipx; h := cliptop - clipy END GetClip; PROCEDURE SetColor*(col: Color; red, green, blue: LONGINT);	(* 0 <= col, red, green, blue < 256 *) VAR ch: CHAR; BEGIN palette[col] := ASH(ASH(red, 8) + green, 8) + blue; IF (col = 0) OR (col = 15) THEN	(* either 0 or 15 must be black. set the border to black. *) (* note: the S3 uses the palette for the border colour too *) SYSTEM.PORTIN(3DAH, ch); SYSTEM.PORTOUT(3C0H, 11X); IF (red = 0) & (green = 0) & (blue = 0) THEN SYSTEM.PORTOUT(3C0H, CHR(col)) ELSE SYSTEM.PORTOUT(3C0H, CHR(15-col)) END; SYSTEM.PORTOUT(3C0H, 20X) END; red := (red + 4) DIV 4 - 1; green := (green + 4) DIV 4 - 1; blue := (blue + 4) DIV 4 - 1; SYSTEM.PORTOUT(3C8H, CHR(col)); SYSTEM.PORTOUT(3C9H, CHR(red)); SYSTEM.PORTOUT(3C9H, CHR(green)); SYSTEM.PORTOUT(3C9H, CHR(blue)) END SetColor; PROCEDURE GetColor*(col: Color; VAR red, green, blue: INTEGER); BEGIN IF col >= 0 THEN col := palette[col] END; red := SHORT(ASH(col, -16) MOD 256); green := SHORT(ASH(col, -8) MOD 256); blue := SHORT(col MOD 256) END GetColor; PROCEDURE RGB*(red, green, blue: LONGINT): Color; BEGIN RETURN MIN(LONGINT) + ASH(red, 16) + ASH(green, 8) + blue END RGB; PROCEDURE Dot*(col: Color; x, y, mode: LONGINT); BEGIN y := Height-1-y; WaitFIFOempty; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(25H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(27H)) END; SYSTEM.PORTOUT(FGcol, SHORT(col)); SYSTEM.PORTOUT(MFcont, SHORT(pixctrl1)); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 121BH); SYSTEM.PORTOUT(shortStroke, LONG(10H)); END Dot; PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT); VAR xpos, ypos: INTEGER; BEGIN IF (w > 0) & (h > 0) THEN xpos := 0; ypos := 0; IF sy < dy THEN INC(sy, h-1); INC(dy, h-1); ypos := 128 END; IF sx < dx THEN INC(sx, w-1); INC(dx, w-1) ELSE xpos := 32 END; sy := Height - 1- sy; dy := Height -1- dy; DEC(w); DEC(h); WaitFIFOempty; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(65H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(67H)) END; SYSTEM.PORTOUT(MFcont, SHORT(pixctrl1)); SYSTEM.PORTOUT(curX, SHORT(sx)); SYSTEM.PORTOUT(curY, SHORT(sy)); SYSTEM.PORTOUT(diaStep, SHORT(dx)); SYSTEM.PORTOUT(axStep, SHORT(dy)); SYSTEM.PORTOUT(majAxis, SHORT(w)); SYSTEM.PORTOUT(MFcont, SHORT(h)); SYSTEM.PORTOUT(cmdReg, SHORT(copycmd) + xpos + ypos) END END CopyBlock; PROCEDURE SetMode*(x: LONGINT; s: SET); BEGIN END SetMode; PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT); VAR width, height: SHORTINT; bit16, h, ly: INTEGER; bit8: CHAR; bit24, bit32: SET; stride, p: LONGINT; BEGIN SYSTEM.GET(pat, width); SYSTEM.GET(pat+1, height); INC(pat, 2); WaitFIFOempty; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(25H)); SYSTEM.PORTOUT(BGmix, LONG(3H)) ELSIF mode = paint THEN SYSTEM.PORTOUT(FGmix, LONG(27H)); SYSTEM.PORTOUT(BGmix, LONG(3H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(27H)); SYSTEM.PORTOUT(BGmix, LONG(1H)) END; SYSTEM.PORTOUT(FGcol, SHORT(col)); SYSTEM.PORTOUT(MFcont, SHORT(pixctrl2)); y := Height-1-y; stride := ASH(width+7, -3);	(* eos1 *) width := SHORT(SHORT(ASH(stride, 3))); WHILE width > 32 DO 			INC(x, 31); h := height; ly := SHORT(y); p := pat; WHILE h > 0 DO 				SYSTEM.PORTOUT(majAxis, 31); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, ly); SYSTEM.PORTOUT(cmdReg, 239BH); SYSTEM.GET(p, bit32); bit32 := SYSTEM.ROT(bit32, 16); SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, bit32)); INC(p, stride); DEC(ly); DEC(h) END; DEC(width, 32); INC(pat, 4); INC(x) END; INC(x, LONG(LONG(width-1))); SYSTEM.PORTOUT(majAxis, LONG(width)-1); IF width <= 8 THEN WHILE height > 0 DO DEC(height); SYSTEM.GET(pat, bit8); INC(pat, stride); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 219BH); SYSTEM.PORTOUT(pixTrans, ORD(bit8)); DEC(y); END ELSIF width <= 16 THEN WHILE height > 0 DO DEC(height); SYSTEM.GET(pat, bit16); INC(pat, stride); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 239BH); SYSTEM.PORTOUT(pixTrans, bit16); DEC(y); END ELSIF width <=24 THEN WHILE height > 0 DO DEC(height); SYSTEM.GET(pat, bit24); INC(pat, stride); bit24 := SYSTEM.LSH(bit24 * {0 .. 23}, 8); bit24 := SYSTEM.ROT(bit24, 16); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 239BH); SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, bit24)); DEC(y); END ELSE WHILE height > 0 DO DEC(height); SYSTEM.GET(pat, bit32); INC(pat, stride); bit32 := SYSTEM.ROT(bit32, 16); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 239BH); SYSTEM.PORTOUT(pixTrans, SYSTEM.VAL(LONGINT, bit32)); DEC(y); END END; END CopyPattern; PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT); BEGIN IF (w > 0) & (h > 0) THEN DEC(h); DEC(w); y := Height-1-y; WaitFIFOempty; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(25H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(27H)) END; SYSTEM.PORTOUT(FGcol, SHORT(col)); SYSTEM.PORTOUT(MFcont, SHORT(pixctrl1)); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(majAxis, SHORT(w)); SYSTEM.PORTOUT(minAxis, SHORT(h)); SYSTEM.PORTOUT(cmdReg, 4073H) END END ReplConst; PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT); VAR patwidth, patheight: SHORTINT; diastep, axstep, errterm, bit16: INTEGER; offset, W0, Y0, X0: INTEGER; pat0, bit32: LONGINT; wth, hgt: INTEGER; BEGIN IF (w > 0) & (h > 0) THEN SYSTEM.GET(pat, patwidth); SYSTEM.GET(pat+1, patheight); INC(pat, 2); wth := SHORT(w+7) DIV 8 * 8;	(* nof complete bytes *) axstep := 0; diastep := -2*wth; errterm := -wth-1; INC(x, w-1); Y0 := SHORT(y); X0 := SHORT(x); y := Height-1-y; WaitFIFOempty; IF mode = invert THEN SYSTEM.PORTOUT(FGmix, LONG(25H)); SYSTEM.PORTOUT(BGmix, LONG(3H)) ELSIF mode = paint THEN SYSTEM.PORTOUT(FGmix, LONG(27H)); SYSTEM.PORTOUT(BGmix, LONG(3H)) ELSE SYSTEM.PORTOUT(FGmix, LONG(27H)); SYSTEM.PORTOUT(BGmix, LONG(1H)) END; SYSTEM.PORTOUT(FGcol, SHORT(col)); SYSTEM.PORTOUT(MFcont, SHORT(pixctrl2)); SYSTEM.PORTOUT(majAxis, SHORT(w-1)); SYSTEM.PORTOUT(diaStep, diastep); SYSTEM.PORTOUT(axStep, axstep); SYSTEM.PORTOUT(errTerm, errterm); pat0 := pat; W0 := SHORT(w); hgt := patheight - (Y0 + SHORT(py)) MOD patheight; offset := (Y0 + SHORT(py)) MOD patheight; IF patwidth = 16 THEN pat := pat + 2*offset; WHILE h > 0 DO 					w := (w + 7) DIV 8 * 4; SYSTEM.GET(pat, bit16); INC(pat, 2); bit16 := SYSTEM.ROT(bit16, SHORT(px)-X0); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 2313H); WHILE w > 0 DO 						SYSTEM.PORTOUT(pixTrans, bit16); DEC(w,2); END; DEC(y); DEC(h); DEC(hgt); w := W0; IF hgt <= 0 THEN hgt := patheight; pat := pat0 END; END ELSIF patwidth = 32 THEN pat := pat + 4*offset; WHILE h > 0 DO 					w := (w + 7) DIV 8 * 2; SYSTEM.GET(pat, bit32); INC(pat, 4); bit32 := SYSTEM.ROT(bit32, SHORT(px)-X0+16); SYSTEM.PORTOUT(curX, SHORT(x)); SYSTEM.PORTOUT(curY, SHORT(y)); SYSTEM.PORTOUT(cmdReg, 2313H); WHILE w > 0 DO 						SYSTEM.PORTOUT(pixTrans, bit32); DEC(w,4) END; DEC(y); DEC(h); DEC(hgt); w := W0; IF hgt <= 0 THEN hgt := patheight; pat := pat0 END END END END END FillPattern; PROCEDURE ReplPattern*(col: Color; pat: Pattern; x, y, w, h, mode: LONGINT); BEGIN FillPattern(col, pat, 0, 0, x, y, w, h, mode) END ReplPattern; PROCEDURE NewPattern*(w, h: LONGINT; VAR image: ARRAY OF SET): Pattern; VAR len, src, dest, i: LONGINT; p: PatternPtr;  pl: List; BEGIN len := (w+7) DIV 8; SYSTEM.NEW(p, 4+len*h); p.w := CHR(w);  p.h := CHR(h); src := SYSTEM.ADR(image[0]); dest := SYSTEM.ADR(p.pixmap[0]); i := 0; WHILE i < h DO SYSTEM.MOVE(src, dest, len); INC(src, 4);  INC(dest, len);  INC(i) END; NEW(pl); pl.pat := p;  pl.next := Pat;  Pat := pl;	(* put in list to avoid GC *) RETURN SYSTEM.ADR(p.w) 	END NewPattern; PROCEDURE CreatePatterns; VAR image: ARRAY 16 OF SET; BEGIN image[0] := {13}; image[1] := {12..14}; image[2] := {11..13}; image[3] := {10..12}; image[4] := {9..11}; image[5] := {8..10}; image[6] := {7..9}; image[7] := {0, 6..8}; image[8] := {0, 1, 5..7}; image[9] := {0..2, 4..6}; image[10] := {0..5}; image[11] := {0..4}; image[12] := {0..5}; image[13] := {0..6}; image[14] := {0..7}; arrow := NewPattern(15, 15, image); image[0] := {0, 10}; image[1] := {1, 9}; image[2] := {2, 8}; image[3] := {3, 7}; image[4] := {4, 6}; image[5] := {}; image[6] := {4, 6}; image[7] := {3, 7}; image[8] := {2, 8}; image[9] := {1, 9}; image[10] := {0, 10}; cross := NewPattern(11, 11, image); image[0] := {6}; image[1] := {5..7}; image[2] := {4..8}; image[3] := {3..9}; image[4] := {2..10}; image[5] := {5..7}; image[6] := {5..7}; image[7] := {5..7}; image[8] := {5..7}; image[9] := {5..7}; image[10] := {5..7}; image[11] := {5..7}; image[12] := {5..7}; image[13] := {5..7}; image[14] := {}; downArrow := NewPattern(15, 15, image); image[0] := {0, 4, 8, 12}; image[1] := {}; image[2] := {2, 6, 10, 14}; image[3] := {}; image[4] := {0, 4, 8, 12}; image[5] := {}; image[6] := {2, 6, 10, 14}; image[7] := {}; image[8] := {0, 4, 8, 12}; image[9] := {}; image[10] := {2, 6, 10, 14}; image[11] := {}; image[12] := {0, 4, 8, 12}; image[13] := {}; image[14] := {2, 6, 10, 14}; image[15] := {}; grey0 := NewPattern(16, 16, image); image[0] := {0, 2, 4, 6, 8, 10, 12, 14}; image[1] := {1, 3, 5, 7, 9, 11, 13, 15}; image[2] := {0, 2, 4, 6, 8, 10, 12, 14}; image[3] := {1, 3, 5, 7, 9, 11, 13, 15}; image[4] := {0, 2, 4, 6, 8, 10, 12, 14}; image[5] := {1, 3, 5, 7, 9, 11, 13, 15}; image[6] := {0, 2, 4, 6, 8, 10, 12, 14}; image[7] := {1, 3, 5, 7, 9, 11, 13, 15}; image[8] := {0, 2, 4, 6, 8, 10, 12, 14}; image[9] := {1, 3, 5, 7, 9, 11, 13, 15}; image[10] := {0, 2, 4, 6, 8, 10, 12, 14}; image[11] := {1, 3, 5, 7, 9, 11, 13, 15}; image[12] := {0, 2, 4, 6, 8, 10, 12, 14}; image[13] := {1, 3, 5, 7, 9, 11, 13, 15}; image[14] := {0, 2, 4, 6, 8, 10, 12, 14}; image[15] := {1, 3, 5, 7, 9, 11, 13, 15}; grey1 := NewPattern(16, 16, image); image[0] := {0, 1, 4, 5, 8, 9, 12, 13}; image[1] := {0, 1, 4, 5, 8, 9, 12, 13}; image[2] := {2, 3, 6, 7, 10, 11, 14, 15}; image[3] := {2, 3, 6, 7, 10, 11, 14, 15}; image[4] := {0, 1, 4, 5, 8, 9, 12, 13}; image[5] := {0, 1, 4, 5, 8, 9, 12, 13}; image[6] := {2, 3, 6, 7, 10, 11, 14, 15}; image[7] := {2, 3, 6, 7, 10, 11, 14, 15}; image[8] := {0, 1, 4, 5, 8, 9, 12, 13}; image[9] := {0, 1, 4, 5, 8, 9, 12, 13}; image[10] := {2, 3, 6, 7, 10, 11, 14, 15}; image[11] := {2, 3, 6, 7, 10, 11, 14, 15}; image[12] := {0, 1, 4, 5, 8, 9, 12, 13}; image[13] := {0, 1, 4, 5, 8, 9, 12, 13}; image[14] := {2, 3, 6, 7, 10, 11, 14, 15}; image[15] := {2, 3, 6, 7, 10, 11, 14, 15}; grey2 := NewPattern(16, 16, image); image[0] := {0..2, 8..11}; image[1] := {0..2, 7..10}; image[2] := {0..2, 6..9}; image[3] := {0..2, 5..8}; image[4] := {0..2, 4..7}; image[5] := {0..6}; image[6] := {0..5}; image[7] := {0..4}; image[8] := {0..3}; image[9] := {0..2}; image[10] := {0, 1}; image[11] := {0}; hook := NewPattern(12, 12, image); image[0] := {7}; image[1] := {7}; image[2] := {2, 7, 12}; image[3] := {3, 7, 11}; image[4] := {4, 7, 10}; image[5] := {5, 7, 9}; image[6] := {6..8}; image[7] := {0..6, 8..14}; image[8] := {6..8}; image[9] := {5, 7, 9}; image[10] := {4, 7, 10}; image[11] := {3, 7, 11}; image[12] := {2, 7, 12}; image[13] := {7}; image[14] := {7}; star := NewPattern(15, 15, image); image[0] := {}; image[1] := {}; image[2] := {0}; image[3] := {}; image[4] := {}; image[5] := {}; image[6] := {}; image[7] := {}; image[8] := {}; image[9] := {}; image[10] := {}; image[11] := {}; image[12] := {}; image[13] := {}; image[14] := {}; image[15] := {}; ticks := NewPattern(16, 16, image); image[0] := -{}; image[1] := -{}; image[2] := -{}; image[3] := -{}; image[4] := -{}; image[5] := -{}; image[6] := -{}; image[7] := -{}; solid := NewPattern(16, 8, image) END CreatePatterns; PROCEDURE Depth*(x: LONGINT): INTEGER; BEGIN RETURN depth END Depth; PROCEDURE TrueColor*(x: LONGINT): BOOLEAN; BEGIN RETURN FALSE END TrueColor; PROCEDURE DisplayBlock*(adr, dx, dy, w, h, sx, sy, mode: LONGINT); VAR BitmapWth, locW, locH: LONGINT; CODE {SYSTEM.i386} MOVSX EAX, Width MOV locW[EBP], EAX	; locW := Width MOVSX EAX, Height DEC EAX MOV locH[EBP], EAX	; locH := Height-1 MOV ESI, adr[EBP]   		; address of bitmap descriptor MOV EDI, 12[ESI] MOV ESI, 8[ESI] MOV BitmapWth[EBP], ESI MOV ECX, dy[EBP] IMUL ESI,ECX MOV EBX, dx[EBP] ADD ESI, EBX ADD ESI, EDI				; esi = source index register MOV EDI, locW[EBP] MOV EBX, locH[EBP] DEC EBX										;!!!! SUB EBX,sy[EBP] IMUL EDI,EBX MOV EBX, sx[EBP] ADD EDI, EBX				; edi = destination index register without VGAaddr MOV EAX, locH[EBP] SUB EAX, sy[EBP] MOV sy[EBP], EAX MOV DX, 9AE8H lab1: IN AX, DX 		AND AX, 100H JNZ lab1 CMP mode[EBP], 1 JL repllab JG invlab MOV AX, 4BH JMP contlab repllab: MOV AX, 47H JMP contlab invlab: MOV AX, 45H contlab: MOV DX, 0BAE8H OUT DX, AX 		MOV DX, 0BEE8H MOV AX, 0A000H OUT DX, AX 		MOV DX, 086E8H MOV AX, WORD sx[EBP] OUT DX, AX 		MOV DX, 082E8H MOV AX, WORD sy[EBP] OUT DX, AX 		MOV DX, 096E8H MOV AX, WORD w[EBP] DEC AX 		OUT DX, AX 		MOV DX, 0BEE8H MOV AX, WORD h[EBP] DEC AX 		OUT DX, AX 		MOV DX, 09AE8H MOV AX, 05331H OUT DX, AX 		MOV DX, 0E2E8H RowLoopR: MOV CX, WORD w[EBP] INC CX 		SHR CX, 1 PUSH ESI lab2: MOV AX, [ESI] OUT DX, AX 		INC ESI INC ESI DEC CX 		JNZ lab2 POP ESI ADD ESI, BitmapWth[EBP] DEC h[EBP] JNZ RowLoopR DispEnd: END DisplayBlock; PROCEDURE TransferFormat*(x: LONGINT): LONGINT; BEGIN RETURN unknown END TransferFormat; PROCEDURE TransferBlock*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, mode: LONGINT); BEGIN HALT(99) END TransferBlock; PROCEDURE GetVal(str: ARRAY OF CHAR; default: LONGINT): LONGINT; VAR i: SHORTINT; v, sgn: LONGINT;  s: ARRAY 10 OF CHAR; BEGIN Kernel.GetConfig(str, s); IF s[0] = 0X THEN v := default ELSE v := 0; i := 0; WHILE s[i] # 0X DO v := v*10+(ORD(s[i])-48); INC(i) END END; RETURN v 	END GetVal; BEGIN depth := SHORT(GetVal("Color", 1));	(* assume 1 if not specified *) IF depth = 0 THEN depth := 1 ELSE depth := 8 END; Width := SHORT(GetVal("DWidth", 1024));	(* assume 1024 if not specified *) Height := SHORT(GetVal("DHeight", 768));	(* assume 768 if not specified *) dmem := GetVal("DMem", 1024)*1024;	(* assume 1Mb if not specified *) UBottom := Height - SHORT(dmem DIV Width) + 1; Left:= 0; ColLeft:= 0; Bottom:= 0; Pat := NIL; mask := -1; pixctrl1 := 0A000H; pixctrl2 := 0A080H; copycmd := 0C053H; EnableRegs; width := Width; height := Height; ResetClip; CreatePatterns; Unit := 10000 END Display.


text:
User:Buenavistasocialme/sandbox

Success in long jump performance mainly
Success in long jump performance mainly depends on the ability of the athlete to transform his horizontal approach velocity into horizontal and vertical takeoff (TO) velocity during the support phase of the jump. Biomechanical analyses indicate that the TO is prepared by a lowering of the center of gravity (CG) during the last strides of the approach run (e.g., 1–4). It was stated by Hay/Nohara, that elite long jumpers lowered their CG during the flight phase of the second-last stride and stayed low until they raised it for the TO during the support phase of the jump itself (5). The same authors observed an inc rease of the touchdown (TD) distance for the last stride

Success in long jump performance mai
Success in long jump performance mainly depends on the ability of the athlete to transform his horizontal approach velocity into horizontal and vertical takeoff (TO) velocity during the support phase of the jump. Biomechanical analyses indicate that the TO is prepared by a lowering of the center of gravi ty (CG) during the last strides of the approach run (e.g., 1–4). It was stated by Hay/Nohara, that elite long jumpers lowered their CG during the flight phase of the second-las t stride and stayed low until they raised it for the TO during the support phase of the jump itself (5). The same authors observed an increase of the touchdown (TD) distance for the last stride

and the jump. Further, a lengthening of the second-last stride has been considered as a corresponding factor for the lowering of the CG (e.g., 4, 6, 7), but there are contradictory find ings as well (e.g., 2, 8, 9). While it is a com mon approach for biomechanical analyses, in all studies mentioned above, time discrete data such as heights or velocities of CG at TO and TD of each stride were analyzed. Therefore, the results can only serve as an indicator of what the athlete has done up to this point in his performance or of what he may be able to do from this point (see 5).

Relatively few investigations deal with the problem of how a long jumper should move his/her body segments to achieve the aspired positions. Relating to the movement technique, a backward sweeping or “active” landing of the supporting leg (that can be characterized by a negative touchdown velocity) has been recommended for the last strides as well as for the jump (10, 11). Koh/Hay (10) also stated in their study that elite long jumpers used a less “active” landing in the last stride than in the two preceding strides. Ramlow/Romanautzky concluded from a single case study that the lowering of the CG during the last stride was supported by the motion of the swinging leg that moved in a lower position than in the preceding strides (12). Those results are mainly based on mathematical simulation, the analysis of discrete parameters, or more qualitative considerations.

Methods

= baso de agua = More detailed knowledge about the movement processing is available if time continuous data are analyzed. Based on a pattern recognition approach, analyses of the time courses of kinematic and dynamic variables have been useful recently in identifying adaptations of ballistic sports movements following motor learning (13) or changes in the environment (14). Similar procedures were also used to investigate structural differences between slightly varying movements—for example, the long jump TO from various heights (15) or between following phases during a singular running movement (16). As a common result of those and several other studies, highly individual movement styles were stated for high performance level athletes as well as for subjects with quite inferior performances (e.g., students; 16–18).

The purpose of this investigation was to study long jump performance in the last strides of the approach run and the jump based on the analysis of time continuous data. Special interest was on two topics: (a) to identify differences and changes of movement patterns in the transition from approach to TO and (b) to investigate to what extent changes in the complex pattern may be explained by single variables that describe partial motions of body segments.

title: User:Buenavistasocialme/sandbox