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.