Oberon/ETH Oberon/2.3.7/S3Trio.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: S3 Trio64 (ard, pjm, Peter Matthias) *)

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;

	(* S3 Constants , packed MMIO *)
	curY= 0A8100H;		curX= 0A8102H;
	axStep= 0A8108H;		diaStep= 0A810AH;
	errTerm= 0A8110H;
	cmd= 0A8118H;
	shortStroke= 0A811CH;
	BGcol= 0A8120H;
	FGcol= 0A8124H;
	wrtMask= 0A8128H;
	rdMask= 0A812CH;
	ColorCMP= 0A8130H;
	BGmix= 0A8134H;	FGmix= 0A8136H;	AltMix= 0A8134H;
	ScissorsT= 0A8138H;	ScissorsL= 0A813AH;	(* clipping top, left *)
	ScissorsB= 0A813CH;	ScissorsR= 0A813EH;	(* clipping bottom, right *)
	PixCntl= 0A8140H;	MultMisc2= 0A8142H;
	MultMisc= 0A8144H;	ReadSel= 0A8146H;
	MinAxis= 0A8148H;	MajAxis= 0A814AH;

	pixTrans = 0AE2E8H;
	pixBase = 0A0000H;
	
	FBPhysAdr = 0E0000000H;
	RegPhysAdr = 0A0000H;
	RegSize = 10000H;

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

	Broadcast*: MsgProc;

	Pat: List;	(* root for patterns *)
	dmem, fbase, rbase: LONGINT;
	clipx, clipy, clipright, cliptop: LONGINT;	(* clipping variables *)

	depth: INTEGER;	(* "logical" indexed color depth 1 or 8 *)
		
	truecol: LONGINT;	(* 0 = 256-color palette, 1 = hicolor, 2 = truecolor *)
	colmap: ARRAY 256 OF LONGINT;	(* identity mapping (256-color) or soft palette (hicolor, truecolor) *)
	palette: ARRAY 256 OF LONGINT;	(* cache to speed up palette reading *)

PROCEDURE Wait;
VAR wait: INTEGER;
BEGIN
	REPEAT SYSTEM.GET( rbase+cmd, wait) UNTIL ~ODD( ASH( wait, -9));
END Wait;

PROCEDURE Map*(x: LONGINT): LONGINT;
BEGIN
	RETURN fbase		(* of linear framebuffer *)
END Map;

PROCEDURE AdjustClip*(x, y, w, h: LONGINT);
VAR right, top, left, bottom: LONGINT;
BEGIN
	right := x + w;
	IF x > clipx THEN clipx:= x END;
	IF right < clipright THEN clipright:= right END;
	left:= clipx;
	IF left < 0 THEN left := 0 ELSIF left > Width THEN left := Width-1 END;
	right := clipright-1;
	IF right < 0 THEN right := 0 ELSIF right > Width THEN right := Width-1 END;
	top := y + h;
	IF y> clipy THEN clipy:= y END;
	IF top< cliptop THEN cliptop:= top END;
	top := cliptop-1;
	IF top < 0 THEN top := 0 ELSIF top >= Height THEN top := Height-1 END;
	bottom := clipy;
	IF bottom < 0 THEN bottom := 0 ELSIF bottom > Height THEN bottom := Height-1 END;
	SYSTEM.PUT( rbase+ScissorsT, SYSTEM.VAL(INTEGER, 1000H+ Height-1-top));	(* top *)
	SYSTEM.PUT( rbase+ScissorsL, SYSTEM.VAL(INTEGER, 2000H+ left)); 	(* left *)
	SYSTEM.PUT( rbase+ScissorsB, SYSTEM.VAL(INTEGER, 3000H+ Height-1-bottom));	(* bottom *)
	SYSTEM.PUT( rbase+ScissorsR, SYSTEM.VAL(INTEGER, 4000H+ right))	(* right *)
END AdjustClip;

PROCEDURE GetDim*(pat: Pattern; VAR w, h: INTEGER);
VAR p: PatternPtr;
BEGIN
	p:= SYSTEM.VAL( PatternPtr, pat);
	w:= ORD(p^.w); h:= ORD(p^.h)
END GetDim;

PROCEDURE ResetClip*;
BEGIN 
	clipx := 0; clipy := UBottom; 
	clipright := Width;
	cliptop := Height;
	SYSTEM.PUT( rbase+ScissorsT, SYSTEM.VAL(INTEGER, 1000H));	(* top *)
	SYSTEM.PUT( rbase+ScissorsL, SYSTEM.VAL(INTEGER, 2000H));	(* left *)
	SYSTEM.PUT( rbase+ScissorsB, SYSTEM.VAL(INTEGER, 3000H+ Height-1-UBottom));	(* bottom *)
	SYSTEM.PUT( rbase+ScissorsR, SYSTEM.VAL(INTEGER, 4000H+ Width-1))	(* right *)
END ResetClip;

PROCEDURE SetClip*(x, y, w, h: LONGINT);
BEGIN	
	clipright := x+w;
	cliptop := y+h;
	clipy := y; clipx := x;
	SYSTEM.PUT( rbase+ScissorsT, SYSTEM.VAL(INTEGER, 1000H + Height-cliptop));	(* top *)
	SYSTEM.PUT( rbase+ScissorsL, SYSTEM.VAL(INTEGER, 2000H + clipx));	(* left *)
	SYSTEM.PUT( rbase+ScissorsB, SYSTEM.VAL(INTEGER, 3000H + Height-1-clipy));	(* bottom *)
	SYSTEM.PUT( rbase+ScissorsR, SYSTEM.VAL(INTEGER, 4000H + clipright-1)); 		 (* right *)
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;
	CASE truecol OF
		0:	(* indexed *)
			colmap[col] := col;
			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;
			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))
		|1:	(* 565 hicolor *)
			colmap[col] := ASH(ASH(ASH(red, -3), 6) + ASH(green, -2), 5) + ASH(blue, -3)
		|2:	(* 888 truecolor *)
			colmap[col] := ASH(ASH(red, 8) + green, 8) + blue
	END
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;

(* Translate a Color value 

	col >= 0 => index through colmap
	col < 0 & truecol = 0 => undefined
	col < 0 & truecol = 1 => translate 888 to 565
	col < 0 & truecol = 2 => keep lower 24 bits
	
	Note: when mode = invert & truecol # 0 & col = FG, the caller sets col to 80FFFFFFH.
	This is a special case for backward compatability with older viewers to invert using FG.
*)

PROCEDURE -TransColor(col: Color): LONGINT;
CODE {SYSTEM.i386}
	POP EAX
	CMP EAX, 0
	JGE index
	AND EAX, 0FFFFFFH
	CMP truecol, 1
	JNE end
	MOV EBX, EAX
	MOV ECX, EAX
	SHR EAX, 8	; 23..19 -> 15..11
	SHR EBX, 5	; 15..10 -> 10..5
	SHR ECX, 3	; 7..3 -> 4..0
	AND EAX, 0F800H	; 15..11
	AND EBX, 007E0H	; 10..5
	AND ECX, 0001FH	; 4..0
	OR EAX, EBX
	OR EAX, ECX
	JMP end
index:
	AND EAX, 0FFH
	LEA EBX, colmap
	MOV EAX, [EBX][EAX*4]
end:
END TransColor;

PROCEDURE Dot*(col: Color; x, y, mode: LONGINT);
BEGIN
	IF mode = invert THEN
		IF (truecol # 0) & (col = FG) THEN col := 80FFFFFFH END;
		SYSTEM.PUT(rbase+FGmix, LONG(25H))
	ELSE
		SYSTEM.PUT(rbase+FGmix, LONG(27H))
	END;
	SYSTEM.PUT(rbase+FGcol, TransColor(col));
	SYSTEM.PUT(rbase+PixCntl, LONG( 0));
	SYSTEM.PUT(rbase+curX, SHORT(x));
	SYSTEM.PUT(rbase+curY, SHORT(Height-1-y));
	Wait;
	SYSTEM.PUT(rbase+cmd, 121BH);
	SYSTEM.PUT(rbase+shortStroke, LONG(10H))
END Dot;

PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: LONGINT);
VAR comd: INTEGER;
BEGIN
	IF (w > 0) & (h > 0) THEN
		comd := SYSTEM.VAL(INTEGER, 0C073H);
		IF sy <= dy THEN
			INC(sy, h-1); INC(dy, h-1); INC(comd, 128);
			IF sx < dx THEN INC(sx, w-1); INC(dx, w-1); DEC(comd, 32) END
		END;
		IF mode = invert THEN 
			SYSTEM.PUT(rbase+FGmix, LONG(65H))
		ELSE
			SYSTEM.PUT(rbase+FGmix, LONG(67H))
		END;
		SYSTEM.PUT(rbase+PixCntl, LONG(0));
		SYSTEM.PUT(rbase+curX, SHORT(sx));
		SYSTEM.PUT(rbase+curY, SHORT(Height - 1 - sy));
		SYSTEM.PUT(rbase+diaStep, SHORT(dx));
		SYSTEM.PUT(rbase+axStep, SHORT(Height -1 - dy));
		SYSTEM.PUT(rbase+MajAxis, SHORT(w-1));
		SYSTEM.PUT(rbase+MinAxis, SHORT(h-1));
		Wait;
		SYSTEM.PUT(rbase+cmd, comd)
	END
END CopyBlock;

PROCEDURE SetMode*(x: LONGINT; s: SET);
BEGIN
END SetMode;

PROCEDURE CopyPattern*(col: Color; pat: Pattern; x, y, mode: LONGINT);
VAR wth, pwidth, pos: LONGINT; p: PatternPtr;
BEGIN
	p:= SYSTEM.VAL( PatternPtr, pat);
	wth:=(ORD(p.w)+7) DIV 8;
	INC(x, wth*8-1); 
	y := Height-y-ORD(p.h);
	IF mode= invert THEN
		IF (truecol # 0) & (col = FG) THEN col := 80FFFFFFH END;
		SYSTEM.PUT(rbase+AltMix, 250003H)
	ELSIF mode= replace THEN
		SYSTEM.PUT(rbase+AltMix, 270001H)
	ELSE
		SYSTEM.PUT(rbase+AltMix, 270003H)
	END;
	SYSTEM.PUT(rbase+FGcol, TransColor(col));
	SYSTEM.PUT(rbase+PixCntl, ORD( 80X));
	SYSTEM.PUT(rbase+MajAxis, SHORT( wth*8-1));
	pos:= wth*ORD(p.h);
	WHILE pos>0 DO
		SYSTEM.PUT(rbase+curX, SHORT(x));
		SYSTEM.PUT(rbase+curY, SHORT(y));
		Wait;
		SYSTEM.PUT(rbase+cmd, 219BH);
		pwidth:= wth;
		REPEAT
			DEC( pos); DEC( pwidth);
			SYSTEM.PUT( rbase+pixTrans, p.pixmap[ pos]);
		UNTIL (pwidth<=0);
		INC( y)
	END
END CopyPattern;

PROCEDURE ReplConst*(col: Color; x, y, w, h, mode: LONGINT);
BEGIN
	IF (w > 0) & (h > 0) THEN 
		IF mode = invert THEN
			IF (truecol # 0) & (col = FG) THEN col := 80FFFFFFH END;
			SYSTEM.PUT(rbase+FGmix, LONG(25H))
		ELSE
			SYSTEM.PUT(rbase+FGmix, LONG(27H))
		END;
		SYSTEM.PUT(rbase+FGcol, TransColor(col));
		SYSTEM.PUT(rbase+PixCntl, LONG( 0));
		SYSTEM.PUT(rbase+curX, SHORT(x));
		SYSTEM.PUT(rbase+curY, SHORT(Height-1-y));
		SYSTEM.PUT(rbase+MajAxis, SHORT(w-1));
		SYSTEM.PUT(rbase+MinAxis, SHORT(h-1));
		Wait;
		SYSTEM.PUT(rbase+cmd, 4073H)
	END
END ReplConst;

PROCEDURE FillPattern*(col: Color; pat: Pattern; px, py, x, y, w, h, mode: LONGINT);
VAR bit16: INTEGER;  pat0, bit32, yo, hgt, wdt: LONGINT;  p: PatternPtr;
BEGIN 
	IF (w > 0) & (h > 0) THEN
		p:= SYSTEM.VAL( PatternPtr, pat);
		INC(pat, 2);
		INC(x, w-1);
		yo:= (y + py) MOD ORD(p.h);
		y := Height-1-y;
		IF mode= invert THEN
			IF (truecol # 0) & (col = FG) THEN col := 80FFFFFFH END;
			SYSTEM.PUT( rbase+AltMix, 250003H)
		ELSIF mode= replace THEN
			SYSTEM.PUT( rbase+AltMix, 270001H)
		ELSE
			SYSTEM.PUT( rbase+AltMix, 270003H)
		END;
		SYSTEM.PUT(rbase+FGcol, TransColor(col));
		SYSTEM.PUT(rbase+PixCntl, ORD( 80X));
		SYSTEM.PUT(rbase+MajAxis, SHORT(w-1));
		pat0 := pat+ ORD(p.w) DIV 8 * yo;
		hgt := ORD(p.h) - yo;
		WHILE h > 0 DO
			wdt:= ( w + 7 ) DIV 8;
			IF ORD(p.w) = 16 THEN
				SYSTEM.GET(pat0, bit16); INC(pat0, 2);
				bit32:= LONG( bit16)* 10000H+ LONG( bit16) MOD 10000H
			ELSIF ORD(p.w) = 32 THEN SYSTEM.GET(pat0, bit32); INC(pat0, 4)
			END;
			bit32 := SYSTEM.ROT(bit32, px-x);	(* SYSTEM.ROT(bit32, pX-X0+16) ?? *)
			SYSTEM.PUT(rbase+curX, SHORT(x));
			SYSTEM.PUT(rbase+curY, SHORT(y));
			Wait;
			SYSTEM.PUT(rbase+cmd, 239BH);
			WHILE wdt >0 DO
				SYSTEM.PUT(rbase+pixTrans, bit32);
				DEC( wdt,4)
			END;
			DEC(y);
			DEC(h); DEC(hgt);
			IF hgt <= 0 THEN hgt := ORD(p.h); pat0 := pat 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); 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 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 truecol > 0
END TrueColor;

(* help procedures for DisplayBlock *)

PROCEDURE DB0( adr, bw, wdt, h: LONGINT);
CODE {SYSTEM.i386}
	MOV ESI, adr[ EBP]
	MOV EAX, bw[ EBP]
	MOV EBX, wdt[ EBP]
	ADD EBX, 3
	AND EBX, 0FFFFFFFCH
	SUB EAX, EBX
	SHR EBX, 2
	MOV EDX, h[ EBP]
	CLD
labY:
	MOV EDI, pixBase
	ADD EDI, rbase
	MOV ECX, EBX
	REP MOVSD
	ADD ESI, EAX
	DEC EDX
	JNZ labY
END DB0;

PROCEDURE DB1(adr, bw, wdt, h: LONGINT);
CODE {SYSTEM.i386}
	MOV ESI, adr[EBP]
	MOV ECX, wdt[EBP]
	INC ECX
	AND ECX, 0FFFFFFFEH
	SUB bw[EBP], ECX
	SHR ECX, 1
	MOV wdt[EBP], ECX
	LEA EDX, colmap
	CLD
labY:
	MOV EDI, pixBase
	ADD EDI, rbase
	MOV ECX, wdt[EBP]
loop:
	LODSW
	MOV EBX, EAX
	AND EAX, 0FFH
	SHR EBX, 8
	MOV EAX, [EDX][EAX*4]
	AND EBX, 0FFH
	MOV EBX, [EDX][EBX*4]
	SHL EBX, 16
	OR EAX, EBX
	STOSD
	LOOP loop
	ADD ESI, bw[EBP]
	DEC h[EBP]
	JNZ labY
END DB1;

PROCEDURE DB2(adr, bw, wdt, h: LONGINT);
CODE {SYSTEM.i386}
	MOV ESI, adr[EBP]
	MOV ECX, wdt[EBP]
	SUB bw[EBP], ECX
	LEA EDX, colmap
	CLD
labY:
	MOV EDI, pixBase
	ADD EDI, rbase
	MOV ECX, wdt[EBP]
loop:
	LODSB
	AND EAX, 0FFH
	MOV EAX, [EDX][EAX*4]
	STOSD
	LOOP loop
	ADD ESI, bw[EBP]
	DEC h[EBP]
	JNZ labY
END DB2;

(*
PROCEDURE DB0oberon( adr, bw, wdt, h: LONGINT);
VAR i, j: LONGINT;
BEGIN
	WHILE h>0 DO
		FOR i:=0 TO wdt BY 4 DO
			SYSTEM.GET( rbase+adr+i, j);
			SYSTEM.PUT( rbase+pixTrans, j);		(* pixTrans or 0A0000H..0A7FFCH *)
		END;			
		INC( adr, bw);
		DEC( h);
	END;
END DB0oberon;
*)

PROCEDURE DisplayBlock*(adr, dx, dy, w, h, sx, sy, mode: LONGINT);
VAR width, blockadr: LONGINT;
BEGIN
	SYSTEM.GET(adr+8, width);
	SYSTEM.GET(adr+12, blockadr);
	sy := Height-1-sy;
	IF mode = invert THEN
		SYSTEM.PUT(rbase+FGmix, SYSTEM.VAL(INTEGER, 45H))	(* invert *)
	ELSE
		SYSTEM.PUT(rbase+FGmix, SYSTEM.VAL(INTEGER, 47H))	(* replace, paint *)
	END;
	SYSTEM.PUT(rbase+PixCntl, SYSTEM.VAL(INTEGER, 0A000H));
	SYSTEM.PUT(rbase+curX, SHORT(sx));
	SYSTEM.PUT(rbase+curY, SHORT(sy));
	SYSTEM.PUT(rbase+MajAxis, SHORT(w-1));
	SYSTEM.PUT(rbase+MinAxis, SHORT(h-1));
	Wait;
	SYSTEM.PUT(rbase+cmd, SYSTEM.VAL(INTEGER, 5531H));
	CASE truecol OF
		0: DB0(blockadr + width*dy + dx, width, w, h)
		|1: DB1(blockadr + width*dy + dx, width, w, h)
		|2: DB2(blockadr + width*dy + dx, width, w, h)
	END
END DisplayBlock;

PROCEDURE TransferFormat*(x: LONGINT): LONGINT;
BEGIN
	CASE truecol OF
		0: x := index8
		|1: x := color565
		|2: x := color8888
	END;
	RETURN x
END TransferFormat;

PROCEDURE -Move(src, dst, size: LONGINT);
CODE {SYSTEM.i386}
	POP ECX
	POP EDI
	POP ESI
	CLD
	MOV BL, CL
	SHR ECX, 2
	AND BL, 3
	REP MOVSD
	MOV CL, BL
	REP MOVSB
END Move;

PROCEDURE TransferBlock*(VAR buf: ARRAY OF CHAR;  ofs, stride, x, y, w, h, mode: LONGINT);
VAR src, dst0, dst1, srcstride, ofs1: LONGINT;
BEGIN
	y := Height-1-y;
	IF mode = set THEN
		SYSTEM.PUT(rbase+FGmix, 47H);
		SYSTEM.PUT(rbase+PixCntl, LONG( 0H));
		SYSTEM.PUT(rbase+curX, SHORT(x));
		SYSTEM.PUT(rbase+curY, SHORT(y));
		SYSTEM.PUT(rbase+MajAxis, SHORT(w-1));
		SYSTEM.PUT(rbase+MinAxis, SHORT(h-1));
		Wait;
		SYSTEM.PUT(rbase+cmd, 5531H);
		DB0(SYSTEM.ADR(buf[ofs]), stride, ASH(w, truecol), h)
	ELSIF mode = get THEN
		ASSERT(w >= 0);
		src := fbase + ASH(y*Width + x, truecol);
		srcstride := ASH(Width, truecol);
		ofs1 := ASH(w, truecol)-1;
		WHILE h > 0 DO
			dst0 := SYSTEM.ADR(buf[ofs]);  dst1 := SYSTEM.ADR(buf[ofs+ofs1]);	(* index check *)
			Move(src, dst0, dst1-dst0+1);
			DEC(src, srcstride);  INC(ofs, stride);  DEC(h)
		END
	ELSE
		HALT(99)	(* bad mode *)
	END
END TransferBlock;

PROCEDURE GetVal(str: ARRAY OF CHAR;  default: LONGINT): LONGINT;
VAR i: SHORTINT;  v: 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;

PROCEDURE InitS3;
VAR ch: CHAR; mask, i, mode: LONGINT;
BEGIN
	FOR i := 0 TO 255 DO colmap[i] := i END;
	truecol := GetVal("DDepth", 8) DIV 16;	(* 0, 1 or 2 *)
	mode := GetVal("Color", 1);	(* assume 1 if not specified *)
	IF mode = 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 *)
	SYSTEM.PORTOUT( 3D4H, 2DH);
	SYSTEM.PORTIN( 3D5H, ch);
	IF ch= 88X THEN
		SYSTEM.PORTOUT( 3D4H, 2EH);
		SYSTEM.PORTIN( 3D5H, ch);
		IF ch= 11X THEN																(*	Trio found	*)
			Width:=0; Height:=0;
			SYSTEM.PORTOUT( 3D4H, 5DH);								(* get Width *)
			SYSTEM.PORTIN( 3D5H, ch);
			IF ODD( ORD( ch) DIV 2) THEN Width:= 256*8 END;
			SYSTEM.PORTOUT( 3D4H, 1);
			SYSTEM.PORTIN( 3D5H, ch);
			INC( Width, ( ORD( ch)+1)*8);

			IF truecol = 1 THEN Width := Width DIV 2 END;
			SYSTEM.PORTOUT( 3D4H, 5EH);									(* get Height *)
			SYSTEM.PORTIN( 3D5H, ch);
			IF ODD( ORD( ch) DIV 2) THEN Height:= 1024 END;
			SYSTEM.PORTOUT( 3D4H, 7);
			SYSTEM.PORTIN( 3D5H, ch);
			IF ODD( ORD( ch) DIV 2) THEN INC( Height, 256) END;
			IF ODD( ORD( ch) DIV 64) THEN INC( Height, 512) END;
			SYSTEM.PORTOUT( 3D4H, 12H);
			SYSTEM.PORTIN( 3D5H, ch);
			INC( Height, ORD( ch)+1);

			SYSTEM.PORTOUT( 3D4H, 36H);									(* get MemSize *)
			SYSTEM.PORTIN( 3D5H, ch);
			mask:= ASH( ORD( ch), -5);
			IF mask= 0 THEN dmem:= 4096*1024;
			ELSIF mask= 4 THEN dmem:= 2048*1024;
			ELSE dmem:= 1024*1024;
			END;
		END;
	END;
	UBottom := Height - SHORT((dmem-4096) DIV Width DIV ASH(1, truecol)) + 1;	(* Space for 4 Sprites reserved *)

	Kernel.MapPhysical(RegPhysAdr, RegSize, rbase);
	ASSERT(rbase # 0);
	DEC(rbase, RegPhysAdr);
	
	SYSTEM.PORTOUT( 3D4H, 1053H);	(*	10H: enable old MMIO 18H: old & new MMIO	*)
	mask:= -1;
	SYSTEM.PUT(rbase+wrtMask, mask);				(* Write mask *)
	SYSTEM.PUT(rbase+rdMask, mask);					(* Read mask *)
	
	Kernel.MapPhysical(FBPhysAdr, dmem, fbase);
	IF fbase # 0 THEN										(* enable lfb *)
		SYSTEM.PORTOUT( 3D4H, 0831H);		(* CR31  bit 3: enhanced mode mapping*)
		IF dmem<=1024*1024 THEN SYSTEM.PORTOUT( 3D4H, 1158H);
		ELSIF dmem<=2024*1024 THEN SYSTEM.PORTOUT( 3D4H, 1258H);
		ELSE SYSTEM.PORTOUT( 3D4H, 1358H);		(* bit 4: enable lfb, bit 0,1: size: 0= 64k, 1=1MB, 2= 2MB, 3= 4MB *)
		END;
		SYSTEM.PORTOUT( 3D4H, 59H);			(* set base adr for lfb *)
		SYSTEM.PORTOUT( 3D5H, CHR( ASH( FBPhysAdr, -24) MOD 100H));
		SYSTEM.PORTOUT( 3D4H, 5AH);
		SYSTEM.PORTOUT( 3D5H, CHR( ASH( FBPhysAdr, -16) MOD 100H));
(*
		SYSTEM.PORTOUT( 3D4H, 33H);			(* disable border *)
		SYSTEM.PORTIN( 3D5H, ch);
		SYSTEM.PORTOUT( 3D5H, SYSTEM.VAL( CHAR, SYSTEM.VAL( SET, ch)+{5}));
*)
	END;
	SYSTEM.PORTOUT( 3C4H, SYSTEM.VAL( INTEGER, 8009H));		(* disable programmed I/O *)
	
	Kernel.WriteString("S3Trio: ");  Kernel.WriteInt(Width, 1);
	Kernel.WriteChar("x");  Kernel.WriteInt(Height, 1);
	CASE truecol OF
		0: Kernel.WriteString(" 8-bit indexed")
		|1: Kernel.WriteString(" 5,6,5-bit RGB")
		|2: Kernel.WriteString(" 8,8,8-bit RGB")
	END;
	Kernel.WriteString(" (+");  Kernel.WriteInt(-UBottom, 1);
	Kernel.WriteString(" offscreen)");
	Kernel.WriteLn
END InitS3;

BEGIN
	Left:= 0; ColLeft:= 0; Bottom:= 0;
	Pat := NIL;
	InitS3;
	ResetClip;
	CreatePatterns;
	Unit := 10000
END Display.

(*
# Trio64 Display settings
#      0103   800  600  256  P8   0
#      0205  1024  768  256  P8   0
#      0107  1280 1024  256  P8   0
#      0211   640  480  64k  P16  1
#      0111   640  480  64k  P16  1
#      0114   800  600  64k  P16  1
#      0117  1024  768  64k  P16  1
#      011A  1280 1024  64k  P16  1
#      0212   640  480  16m  P24  2
#      0112   640  480  16m  P32  2
#      0115   800  600  16m  P32  2
#      0118  1024  768  16m  P32  2
*)

(*
Compiler.Compile S3Trio.Display.Mod\X ~
*)