Oberon/ETH Oberon/2.3.7/W32.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;	(* ET4000W32 ARD/pjm *)

	IMPORT Kernel, SYSTEM, Objects;
	
	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;
	
		(* ACL Registers, queued *)
		PatAdr = 80H;
		SrcAdr = 84H;
		PatYOff = 88H;
		SrcYOff = 8AH;
		DestYOff = 8CH;
		BusSize = 8EH;
		XYDir = 8FH;
		PatWrap = 90H;
		SrcWrap = 92H;
		XPos = 94H;
		YPos = 96H;
		XCnt = 98H;
		YCnt = 9AH;
		RoutCtrl = 9CH;
		RelCtrl = 9DH;
		BgRop = 9EH;
		FgRop = 9FH;
		DestAdr = 0A0H;
		
		(* ACL Registers, non-queued *)
		SusTerm = 30H;
		OpState = 31H;
		SyncEn = 32H;
		IntMask = 34H;
		IntStat = 35H;
		AccStat = 36H;
		
		Base = 0BFF00H;
		MMU = 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);

	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*: INTEGER; (* map hight*)
			
		arrow*, star*, cross*, downArrow*, hook*,
		grey0*, grey1*, grey2*, ticks*, solid*: Pattern;

		Broadcast*: MsgProc;

		dmem, lasty: LONGINT;
		
		pattern: List;

		palette: ARRAY 256 OF LONGINT;
		
		clipx, clipy, clipright, cliptop, height, width: LONGINT;	(* clipping variables *)
		depth: INTEGER;

	PROCEDURE max (i, j: LONGINT): LONGINT; BEGIN IF i >= j THEN RETURN i ELSE RETURN j END END max;
	PROCEDURE min (i, j: LONGINT): LONGINT; BEGIN  IF i >= j THEN RETURN j ELSE RETURN i END END min;
	
	PROCEDURE Wait;
	VAR i: SHORTINT;
	BEGIN
		REPEAT SYSTEM.GET(Base+AccStat, i) UNTIL ~ODD(i) & ~ODD(i DIV 2);
	END Wait;
	
	PROCEDURE Map*(x: LONGINT): LONGINT;
	BEGIN RETURN 0A0000H
	END Map;
	
	PROCEDURE AdjustClip*(x, y, w, h: LONGINT);
	VAR right, top: LONGINT;
	BEGIN 
		right := x + w; top := y + h; clipx := max(clipx, x); clipy := max(clipy, y); 
		clipright := min(right, clipright); cliptop := min(top, cliptop)
	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  
		clipright := x+w;
		cliptop := y+h;
		clipy := y; clipx := x
	END SetClip;
	
	PROCEDURE GetClip*(VAR x, y, w, h: INTEGER);
	BEGIN 
		x := SHORT(clipx); y := SHORT(clipy); w := SHORT(clipright - clipx); h := SHORT(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: use 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;
		SYSTEM.PORTOUT(3C8H, CHR(col));
		SYSTEM.PORTOUT(3C9H, CHR(red DIV 4));
		SYSTEM.PORTOUT(3C9H, CHR(green DIV 4));
		SYSTEM.PORTOUT(3C9H, CHR(blue DIV 4))
	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);
	VAR dest: LONGINT;
	BEGIN
		IF (y >= clipy) & (y < cliptop) & (x >= clipx) & (x < clipright) THEN
			dest := (LONG(Height)-1 - y) * Width + x;
			IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 066X) ELSE SYSTEM.PUT(Base+FgRop, 0CCX) END;
			Wait;
			SYSTEM.PUT(Base+XCnt, LONG(0));
			SYSTEM.PUT(Base+YCnt, LONG(0));
			SYSTEM.PUT(Base+RoutCtrl, 1X);
			SYSTEM.PUT(Base, dest);
			SYSTEM.PUT(MMU, col)
		END
	END Dot;

	PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT);
	VAR src, dst, top, right, dX, dY: LONGINT;
	BEGIN
		right := dx + w; top := dy + h; dX := dx; dY := dy;
		IF dx < clipx THEN w := w - (clipx - dx); dx := clipx END; 
		IF dy < clipy THEN h := h - (clipy - dy); dy := clipy END;
		IF clipright < right THEN  w :=  clipright - dx END; 
		IF cliptop  < top THEN h := cliptop - dy END;
		IF (w > 0) & (h > 0) THEN
			sx := sx - (dX - dx);
			sy := sy - (dY - dy);
			src := (LONG(Height) - sy - h) * Width + sx;
			dst := (LONG(Height) - dy - h) * Width + dx;
			IF src # dst THEN
				Wait;
				SYSTEM.PUT(Base+XCnt, LONG(0));
				SYSTEM.PUT(Base+YCnt, LONG(0));
				SYSTEM.PUT(Base+RoutCtrl, 0X);
				SYSTEM.PUT(Base+XYDir, 0X);
				SYSTEM.PUT(Base+FgRop, 0AAX);
				SYSTEM.PUT(Base+SrcAdr, dst);
				SYSTEM.PUT(Base+DestAdr, dst);
				SYSTEM.PUT(Base+OpState, 9X);
				Wait;
				SYSTEM.PUT(Base+XCnt, SHORT(w-1));
				SYSTEM.PUT(Base+YCnt, SHORT(h-1));
				IF dst > src THEN
					src := src + w-1 + Width * (h-1); 
					dst := dst + w-1 + Width * (h-1);
					SYSTEM.PUT(Base+XYDir, 3X)
				ELSE
					SYSTEM.PUT(Base+XYDir, 0X)
				END;
				SYSTEM.PUT(Base+FgRop, 0CCX);
				SYSTEM.PUT(Base+RoutCtrl, 0X);
				SYSTEM.PUT(Base+DestAdr, dst);
				SYSTEM.PUT(Base+SrcAdr, src);
				SYSTEM.PUT(Base+OpState, 9X);
				SYSTEM.PUT(Base+XYDir, 0X)
			END
		END
	END CopyBlock;

	PROCEDURE SetMode*(x: LONGINT; s: SET);
	BEGIN
	END SetMode;
	
	PROCEDURE CopyPatternAsm(cpX, cpY, cpW, cpH, pat: LONGINT;  VAR buf: ARRAY OF INTEGER);
	VAR cpw, cpsw, cph: LONGINT;
	CODE {SYSTEM.i386}
		MOV EBX,cpW[EBP]
		ADD EBX,7
		SHR EBX,3
		MOV cpw[EBP],EBX	; cpw := cpW DIV 8
		MOV ESI,pat[EBP]
		XOR EAX,EAX
		MOV AL,[ESI]
		ADD EAX,7
		SHR EAX,3
		MOV cpsw[EBP],EAX	; cpsw := p.w DIV 8
		MOV EDI,buf[EBP]
		MOV EAX,cpW[EBP]
		MOV [EDI],AL	; new p.w
		INC EDI
		MOV EAX,cpH[EBP]	; new p.h
		MOV [EDI],AL
		INC EDI
		MOV EBX,cpsw[EBP]
		MOV EAX,cpY[EBP]
		IMUL EAX,EBX
		ADD ESI,EAX
		MOV ECX,cpX[EBP]
		SHR ECX,3
		ADD ESI,ECX
		ADD ESI,2	; ESI := Sourcepos for Copyloop
		MOV cph[EBP],0	; init loop variables
		MOV EDX,cph[EBP]
		MOV  ECX,cpX[EBP]
		AND ECX,7	; cpX MOD 8
loopcp:
		CMP   cpH[EBP],EDX
		JLE l7cp	; height reached ?
		MOV   EAX,[ESI]
		SHR EAX,CL	; in proper position
		PUSH ECX
		MOV EBX,-2
		MOV ECX,cpW[EBP]
		SHL EBX,CL
		SHR EBX, 1
		NOT EBX
		AND EAX,EBX
		POP ECX
		MOV [EDI],EAX	; copy for a new pattern
		MOV EAX,cpsw[EBP]
		ADD ESI,EAX	; one line in source up
		MOV EAX,cpw[EBP]
		ADD EDI,EAX	; one line at destination up
		INC EDX
		JMP loopcp
l7cp:
	END CopyPatternAsm;
	
	PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT);
	VAR dest, i: LONGINT; 
			w, h: CHAR; 
			lx, ly, cpX, cpY, cpW, cpH, nofbytes: LONGINT;
			buf: ARRAY 256 OF INTEGER;
			onebyte: CHAR;
			doublefill: ARRAY 4 OF CHAR;
	BEGIN
		SYSTEM.GET(pat, w); SYSTEM.GET(pat+1, h);
		cpW := ORD(w) + x; cpH := ORD(h) + y; 
		lx := x; ly := y;
		IF x < clipx THEN x := clipx END;
		IF y < clipy THEN y := clipy END;
		IF cpW > clipright THEN cpW := clipright END;
		IF cpH > cliptop THEN cpH := cliptop END;
		cpW := cpW - x; cpH := cpH - y; 
		cpX := x - lx; cpY := y - ly;
		IF (cpW <= 0) OR (cpH <= 0) OR (cpX < 0) OR (cpY < 0) THEN RETURN END;
		IF (cpW # ORD(w)) OR (cpH # ORD(h)) THEN
			CopyPatternAsm(cpX, cpY, cpW, cpH, pat, buf);
			pat := SYSTEM.ADR(buf[0])
		END;
		dest := (LONG(Height)-1-y) * Width + x;
		doublefill[0] := CHR(col); doublefill[1] := CHR(col); doublefill[2] := CHR(col); doublefill[3] := CHR(col);
		SYSTEM.GET(pat, w); 
		SYSTEM.GET(pat+1, h);
		INC(pat, 2);
		nofbytes := (ORD(w)+7) DIV 8;
		
		Wait;
		SYSTEM.PUT(Base+FgRop, 0CCX);
		SYSTEM.PUT(Base+XCnt, LONG(3));
		SYSTEM.PUT(Base+YCnt, LONG(0));
		SYSTEM.PUT(Base, lasty);
		SYSTEM.PUT(Base+RoutCtrl, 1X);
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, doublefill));
				
		Wait;
		IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 05AX); SYSTEM.PUT(Base+BgRop, 0AAX)
		ELSE SYSTEM.PUT(Base+FgRop, 0F0X); SYSTEM.PUT(Base+BgRop, 0AAX) END;
		SYSTEM.PUT(Base+PatAdr, lasty);
		SYSTEM.PUT(Base+PatWrap, 2X);
		SYSTEM.PUT(Base+XYDir, 2X);
		SYSTEM.PUT(Base+YCnt, SHORT(ORD(h)-1));
		SYSTEM.PUT(Base+XCnt, SHORT(ORD(w)-1));
		SYSTEM.PUT(Base+RoutCtrl, 2X);
		SYSTEM.PUT(Base, dest);
		SYSTEM.PUT(Base+BusSize, 0X);
		FOR i := 0 TO nofbytes*ORD(h)-1 DO SYSTEM.GET(pat+i, onebyte); SYSTEM.PUT(MMU, onebyte) END;
		SYSTEM.PUT(Base+BusSize, 2X);
	END CopyPattern;

	PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT);
	VAR dest, right, top: LONGINT; 
			doublefill: ARRAY 4 OF CHAR;
	BEGIN
		top := y + h; right := x + w; 
		IF x < clipx THEN x := clipx END;
		IF y < clipy THEN y := clipy END;
		IF  clipright < right THEN right := clipright END;
		IF cliptop < top THEN top := cliptop END;
		w := right - x; h := top - y;
		IF (w <= 0) OR (h <= 0) OR (x < 0) OR (y < 0) THEN RETURN END;
		dest := (Height - y - h) * Width + x;
		doublefill[0] := CHR(col); doublefill[1] := CHR(col); doublefill[2] := CHR(col); doublefill[3] := CHR(col);
		Wait;
		SYSTEM.PUT(Base+FgRop, 0CCX);
		SYSTEM.PUT(Base+XCnt, LONG(3));
		SYSTEM.PUT(Base+YCnt, LONG(0));
		SYSTEM.PUT(Base, lasty);
		SYSTEM.PUT(Base+RoutCtrl, 1X);
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, doublefill));
				
		Wait;
		IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 066X) ELSE SYSTEM.PUT(Base+FgRop, 0CCX) END;
		SYSTEM.PUT(Base+SrcWrap, 2X);
		SYSTEM.PUT(Base+SrcAdr, lasty);
		SYSTEM.PUT(Base+DestAdr, dest);
		SYSTEM.PUT(Base+XYDir, 0X);
		SYSTEM.PUT(Base+XCnt, SHORT(w-1));
		SYSTEM.PUT(Base+YCnt, SHORT(h-1));
		SYSTEM.PUT(Base+RoutCtrl, 0X);
		SYSTEM.PUT(Base+OpState, 9X);
		SYSTEM.PUT(Base+SrcWrap, 0FFX)
	END ReplConst;

	PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT);
	VAR dest, vertoff, fourbytes, mod, pw, ph, origh, off, right, top: LONGINT; ch: CHAR;
			doublefill: ARRAY 4 OF CHAR;
	BEGIN 
		doublefill[0] := CHR(col); doublefill[1] := CHR(col); doublefill[2] := CHR(col); doublefill[3] := CHR(col);
		SYSTEM.GET(pat, ch); pw := ORD(ch);
		SYSTEM.GET(pat+1, ch); ph := ORD(ch); origh := ph; INC(pat, 2);
		IF (pw # 16) & (pw # 32) THEN RETURN END;
		top := y + h; right := x + w; 
		IF x < clipx THEN x := clipx END;
		IF y < clipy THEN y := clipy END;
		IF clipright < right THEN right := clipright END; 
		IF cliptop < top THEN top := cliptop END;
		w := right - x; h := top - y;
		IF (w <= 0) OR (h <= 0) OR (x < 0) OR (y < 0) THEN RETURN END;
		dest := (LONG(Height)-1 - y) * Width + x;
		off := (x - px) MOD 32;
		vertoff := ((y - py) MOD h) * (w DIV 8);
		Wait;	(* Foreground color *)
		SYSTEM.PUT(Base+FgRop, 0CCX);
		SYSTEM.PUT(Base+XCnt, LONG(31));
		SYSTEM.PUT(Base+YCnt, LONG(0));
		SYSTEM.PUT(Base, lasty);
		SYSTEM.PUT(Base+RoutCtrl, 1X);
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill))); 
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill))); 
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill))); 
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill))); 
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill))); 
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill))); 
		SYSTEM.PUT(MMU, SYSTEM.VAL(SET, SYSTEM.VAL(SET, doublefill)));
		mod := (w DIV 8)*origh;
		Wait;
		SYSTEM.PUT(Base+SrcWrap, 5X);
		SYSTEM.PUT(Base+PatWrap, 5X);
		SYSTEM.PUT(Base+YCnt, LONG(0));
		SYSTEM.PUT(Base+XYDir, 2X);
		SYSTEM.PUT(Base+BgRop, 0CCX);
		WHILE h > 0 DO
			SYSTEM.GET(pat+vertoff, fourbytes); 
			IF pw = 16 THEN
				vertoff := (vertoff + 2) MOD mod;
				fourbytes := fourbytes*10000H + fourbytes MOD 10000H;
			ELSE
				vertoff := (vertoff + 4) MOD mod
			END;
			fourbytes := SYSTEM.ROT(fourbytes, -off);
			Wait;
			SYSTEM.PUT(Base+FgRop, 0F0X);
			SYSTEM.PUT(Base+SrcAdr, lasty+32);
			SYSTEM.PUT(Base+PatAdr, lasty);
			SYSTEM.PUT(Base+XCnt, LONG(31));
			SYSTEM.PUT(Base+RoutCtrl, 2X);
			SYSTEM.PUT(Base, lasty + 96);
			SYSTEM.PUT(MMU, fourbytes);
			IF mode = paint THEN
				Wait;	(* clear color *)
				SYSTEM.PUT(Base+FgRop, 0FFX);
				SYSTEM.PUT(Base, lasty+64);
				SYSTEM.PUT(MMU, fourbytes)
			END;
			Wait;
			IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 066X)
			ELSIF mode = replace THEN SYSTEM.PUT(Base+FgRop, 0CCX)
			ELSE 
				SYSTEM.PUT(Base+PatAdr, lasty+64);
				SYSTEM.PUT(Base+FgRop, 0CEX)
			 END;
			SYSTEM.PUT(Base+SrcAdr, lasty+96);
			SYSTEM.PUT(Base+XCnt, SHORT(w-1));
			SYSTEM.PUT(Base+RoutCtrl, 0X);
			SYSTEM.PUT(Base+DestAdr, dest);
			SYSTEM.PUT(Base+OpState, 9X);
			DEC(h); DEC(dest, LONG(Width))
		END;
		SYSTEM.PUT(Base+SrcWrap, 0FFX)
	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 := pattern;  pattern := 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(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;
	
	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 src, dst, width, i, base: LONGINT; data: CHAR; mmu: LONGINT;
	BEGIN
		dst := Width*(LONG(Height)-1-sy) + sx;
		SYSTEM.GET(adr+8, width);
		SYSTEM.GET(adr+12, base);
		src := base + width * dy + dx;
		Wait;
		SYSTEM.PUT(Base+XCnt, SHORT(w-1));
		SYSTEM.PUT(Base+YCnt, LONG(0));
		SYSTEM.PUT(Base+RoutCtrl, 1X);
		SYSTEM.PUT(Base+XYDir, 0X);
		SYSTEM.PUT(Base+BusSize, 0X);
		IF mode = invert THEN SYSTEM.PUT(Base+FgRop, 066X)
		ELSE SYSTEM.PUT(Base+FgRop, 0CCX)
		END;
		mmu := MMU;
		WHILE h > 0 DO
			Wait;
			SYSTEM.PUT(Base, dst);
			SYSTEM.MOVE(src,mmu,w);
			DEC(dst, LONG(Width)); INC(src, width);
			DEC(h)
		END;
		SYSTEM.PUT(Base+BusSize, 2X)
	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 Init;
	BEGIN
		Wait; 		
		SYSTEM.PUT(Base+13H, 71X);
		SYSTEM.PUT(Base+SyncEn, 1X);
		SYSTEM.PUT(Base+IntMask, 0X);
		SYSTEM.PUT(Base+BusSize, 2X);
		
		SYSTEM.PUT(Base+SrcWrap, 0FFX);
		SYSTEM.PUT(Base+RelCtrl, LONG(0));
		SYSTEM.PUT(Base+XPos, LONG(0));
		SYSTEM.PUT(Base+YPos,  LONG(0));
		SYSTEM.PUT(Base+SrcYOff, Width-1);
		SYSTEM.PUT(Base+DestYOff, Width-1);
		SYSTEM.PUT(Base+PatYOff, Width-1);
		
		(* Background color *)
		SYSTEM.PUT(Base+FgRop, 0CCX);
		SYSTEM.PUT(Base+XCnt, LONG(31));
		SYSTEM.PUT(Base+YCnt, LONG(0));
		SYSTEM.PUT(Base, lasty+32);
		SYSTEM.PUT(Base+RoutCtrl, 1X);
		SYSTEM.PUT(MMU, LONG(LONG(BG))); SYSTEM.PUT(MMU, LONG(LONG(BG)));
		SYSTEM.PUT(MMU, LONG(LONG(BG))); SYSTEM.PUT(MMU, LONG(LONG(BG)));
		SYSTEM.PUT(MMU, LONG(LONG(BG))); SYSTEM.PUT(MMU, LONG(LONG(BG)));
		SYSTEM.PUT(MMU, LONG(LONG(BG))); SYSTEM.PUT(MMU, LONG(LONG(BG)));
	END Init;
	
	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;
	lasty := LONG(Height-UBottom)*Width;
	pattern := NIL;
	Init; 

	width := Width;
	height := Height;
	clipx := 0; clipy := UBottom; clipright := width; cliptop := height;
	CreatePatterns;
	Unit := 10000
END Display.