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

IMPORT SYSTEM, AosDisplays := Displays, Kernel;

CONST
	BusCntl = 28H*4;
	GenTestCntl = 34H*4;
	DstOffPitch = 40H*4;
	(*DstX = 41H*4;*)
	(*DstY = 42H*4;*)
	DstYX = 43H*4;
	(*DstWidth = 44H*4;*)
	DstHeight = 45H*4;
	DstHeightWidth = 46H*4;
	DstBresErr = 49H*4;
	DstBresInc = 4AH*4;
	DstBresDec = 4BH*4;
	DstCntl = 4CH*4;
	SrcOffPitch = 60H*4;
	SrcYX = 63H*4;
	SrcWidth1 = 64H*4;
	SrcHeight1Width1 = 66H*4;
	SrcYXStart = 69H*4;
	SrcCntl = 6DH*4;
	SrcHeight2Width2 = 6CH*4;
	HostData0 = 80H*4;
	HostData15 = 8FH*4;
	HostCntl = 90H*4;
	PatReg0 = 0A0H*4;
	PatReg1 = 0A1H*4;
	PatCntl = 0A2H*4;
	ScLeft = 0A8H*4;
	ScRight = 0A9H*4;
	ScTop = 0ABH*4;
	ScBottom = 0ACH*4;
	DpBkgdClr = 0B0H*4;
	DpFrgdClr = 0B1H*4;
	DpWriteMsk = 0B2H*4;
	DpChainMsk = 0B3H*4;
	DpPixWidth = 0B4H*4;
	DpMix = 0B5H*4;
	DpSrc = 0B6H*4;
	DstXY = 0BAH*4;
	(*DstWidthHeight = 0BBH*4;*)
	ClrCmpClr = 0C0H*4;
	ClrCmpMsk = 0C1H*4;
	ClrCmpCntl = 0C2H*4;
	FifoStat = 0C4H*4;
	ContextMsk = 0C8H*4;
	GuiTrajCntl = 0CCH*4;
	GuiStat = 0CEH*4;

VAR
	d: Display;
	base0, truecol: LONGINT;
	
TYPE
	Display* = OBJECT (AosDisplays.Display)
	
		PROCEDURE ReplConst*(col, x, y, w, h: LONGINT);
		BEGIN
			IF (w > 0) & (h > 0) & (col >= 0) THEN	(* opaque or invert *)
				IF ASH(col, 1) >= 0 THEN
					WaitFIFO(4);
					SYSTEM.PUT(base0+DpFrgdClr, TransColor(col));
					SYSTEM.PUT(base0+DpSrc, {8});
					SYSTEM.PUT(base0+DstXY, ASH(y, 16) + x MOD 10000H);
					SYSTEM.PUT(base0+DstHeightWidth, ASH(w, 16) + h MOD 10000H)
				ELSE	(* invert *)
					WaitFIFO(6);
					SYSTEM.PUT(base0+DpFrgdClr, TransColor(col));
					SYSTEM.PUT(base0+DpMix, {0, 1, 16, 18});	(* DST xor SRC / DST *)
					SYSTEM.PUT(base0+DpSrc, {8});
					SYSTEM.PUT(base0+DstXY, ASH(y, 16) + x MOD 10000H);
					SYSTEM.PUT(base0+DstHeightWidth, ASH(w, 16) + h MOD 10000H);
					SYSTEM.PUT(base0+DpMix, {0, 1, 16, 17, 18})	(* SRC / DST *)
				END
			END
		END ReplConst;
		
		PROCEDURE Dot*(col, x, y: LONGINT);
		BEGIN
			IF col >= 0 THEN	(* opaque or invert *)
				IF ASH(col, 1) >= 0 THEN
					WaitFIFO(4);
					SYSTEM.PUT(base0+DpFrgdClr, TransColor(col));
					SYSTEM.PUT(base0+DpSrc, {8});
					SYSTEM.PUT(base0+DstXY, ASH(y, 16) + x MOD 10000H);
					SYSTEM.PUT(base0+DstHeightWidth, SYSTEM.VAL(LONGINT, 10001H))
				ELSE	(* invert *)
					WaitFIFO(6);
					SYSTEM.PUT(base0+DpFrgdClr, TransColor(col));
					SYSTEM.PUT(base0+DpMix, {0, 1, 16, 18});	(* DST xor SRC / DST *)
					SYSTEM.PUT(base0+DpSrc, {8});
					SYSTEM.PUT(base0+DstXY, ASH(y, 16) + x MOD 10000H);
					SYSTEM.PUT(base0+DstHeightWidth, SYSTEM.VAL(LONGINT, 10001H));
					SYSTEM.PUT(base0+DpMix, {0, 1, 16, 17, 18})	(* SRC / DST *)
				END
			END
		END Dot;
		
		PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy: LONGINT);
		VAR s: SET;
		BEGIN
			IF (w > 0) & (h > 0) THEN
				IF sy >= dy THEN s := {1} ELSE s := {}; INC(sy, h-1); INC(dy, h-1) END;
				IF sx >= dx THEN INCL(s, 0) ELSE INC(sx, w-1); INC(dx, w-1) END;
				WaitFIFO(8);
				SYSTEM.PUT(base0+DstCntl, s);
				SYSTEM.PUT(base0+DpSrc, {8, 9});	(* BLIT / BG *)
				SYSTEM.PUT(base0+SrcYX, ASH(sx, 16) + sy MOD 10000H);
				SYSTEM.PUT(base0+SrcWidth1, w);
				SYSTEM.PUT(base0+DstYX, ASH(dx, 16) + dy MOD 10000H);
				SYSTEM.PUT(base0+DstHeightWidth, ASH(w, 16) + h MOD 10000H);
				SYSTEM.PUT(base0+DpSrc, {8});	(* FG / BG *)
				SYSTEM.PUT(base0+DstCntl, {0, 1, 5})
				;WaitIdle
			END
		END CopyBlock;
		
		PROCEDURE PaintMask*(VAR buf: ARRAY OF CHAR; bitofs, stride, fg, bg, x, y, w, h: LONGINT);
		VAR p, i, j, out: LONGINT; ch: CHAR;
		BEGIN
			IF (w > 0) & (h > 0) THEN
				WaitFIFO(7);
				IF stride < 0 THEN
					INC(y, h-1); INC(bitofs, (h-1)*stride*8);
					stride := -stride;
					SYSTEM.PUT(base0+GuiTrajCntl, {0, 5})	(* left-to-right, bottom-to-top *)
				ELSE
					SYSTEM.PUT(base0+GuiTrajCntl, {0, 1, 5})	(* left-to-right, top-to-bottom *)
				END;
				p := SYSTEM.ADR(buf[0]) + bitofs DIV 8;
				bitofs := bitofs MOD 8;
				CASE format OF
					1: SYSTEM.PUT(base0+DpPixWidth, {1, 29})
					|2: SYSTEM.PUT(base0+DpPixWidth, {2, 30})
					|4: SYSTEM.PUT(base0+DpPixWidth, {1, 2, 29, 30})
				END;
				SYSTEM.PUT(base0+DpSrc, {8, 17});	(* FG / BG / Mono Host *)
				SYSTEM.PUT(base0+DpFrgdClr, TransColor(fg));
				SYSTEM.PUT(base0+DpBkgdClr, TransColor(bg));
				SYSTEM.PUT(base0+DstYX, ASH(x, 16) + y MOD 10000H);
				SYSTEM.PUT(base0+DstHeightWidth, ASH(w, 16) + h MOD 10000H);
				j := 0; out := 0;
				LOOP
					FOR i := 0 TO (w-1) DIV 8 DO
						SYSTEM.GET(p+i, ch);
						out := ASH(out, -8) + ASH(ORD(ch), 24);
						INC(j);
						IF j MOD 4 = 0 THEN
							WaitFIFO(1);
							SYSTEM.PUT(base0+HostData0, out);
							out := 0
						END
					END;
					DEC(h);
					IF h = 0 THEN EXIT END;
					INC(p, stride)
				END;
				IF j MOD 4 # 0 THEN
					REPEAT out := ASH(out, -8); INC(j) UNTIL j MOD 4 = 0;
					WaitFIFO(1);
					SYSTEM.PUT(base0+HostData0, out)
				END;
				WaitFIFO(3);
				SYSTEM.PUT(base0+DpSrc, {8});	(* FG / BG *)
				SYSTEM.PUT(base0+GuiTrajCntl, {0, 1, 5});	(* left-to-right, top-to-bottom *)
				CASE format OF
					1: SYSTEM.PUT(base0+DpPixWidth, {1, 9, 17, 29})
					|2: SYSTEM.PUT(base0+DpPixWidth, {2, 10, 18, 30})
					|4: SYSTEM.PUT(base0+DpPixWidth, {1, 2, 9, 10, 17, 18, 29, 30})
				END
			END
		END PaintMask;
		
		PROCEDURE Transfer*(VAR buf: ARRAY OF CHAR; ofs, stride, x, y, w, h, op: LONGINT);
		VAR bufadr, w0, dw: LONGINT; ch: CHAR;
		BEGIN
			WaitIdle;
			Transfer^(buf, ofs, stride, x, y, w, h, op)
(*
			IF op = AosDisplays.set THEN
				IF (w > 0) & (h > 0) THEN
					bufadr := SYSTEM.ADR(buf[ofs]);
					WaitFIFO(4);
					SYSTEM.PUT(base0+DpSrc, {9});	(* HOST / BG *)
					SYSTEM.PUT(base0+GuiTrajCntl, {0, 1, 5});	(* left-to-right, top-to-bottom *)
					SYSTEM.PUT(base0+DstYX, ASH(x, 16) + y MOD 10000H);
					SYSTEM.PUT(base0+DstHeightWidth, ASH(w, 16) + h MOD 10000H);
					w := w * format;	(* convert to bytes *)
					REPEAT
						w0 := w;
						WHILE w0 >= 16*4 DO
							WaitFIFO(16);
							SYSTEM.MOVE(bufadr, base0+HostData0, 16*4);
							DEC(w0, 16*4); INC(bufadr, 16*4)
						END;
						IF w0 >= 4 THEN
							WaitFIFO(w0 DIV 4);
							REPEAT
								SYSTEM.GET(bufadr, dw);
								SYSTEM.PUT(base0+HostData0, dw);
								DEC(w0, 4); INC(bufadr, 4)
							UNTIL w0 < 4
						END;
						IF w0 > 0 THEN
							WaitFIFO(w0);
							REPEAT
								SYSTEM.GET(bufadr, ch);
								SYSTEM.PUT(base0+HostData0, ch);
								DEC(w0); INC(bufadr)
							UNTIL w0 = 0
						END;
						INC(bufadr, stride-w);
						DEC(h)
					UNTIL h = 0;
					WaitFIFO(1);
					SYSTEM.PUT(base0+DpSrc, {8})	(* FG / BG *)
				END
			ELSE
				WaitIdle;
				TransferBlock^(buf, ofs, stride, x, y, w, h, op)
			END
*)
		END Transfer;
		
	END Display;

PROCEDURE WaitFIFO(n: LONGINT);
VAR x: LONGINT;
BEGIN
	REPEAT SYSTEM.GET(base0+FifoStat, x) UNTIL x MOD 10000H <= ASH(8000H, -n)
END WaitFIFO;

PROCEDURE WaitIdle;
VAR s: SET;
BEGIN
	WaitFIFO(16);
	REPEAT SYSTEM.GET(base0+GuiStat, s) UNTIL ~(0 IN s)
END WaitIdle;

(* Translate a Color value to display format. *)

PROCEDURE TransColor(col: LONGINT): LONGINT;
BEGIN
	CASE truecol OF
		0:	(* 8-bit indexed *)
			IF 30 IN SYSTEM.VAL(SET, col) THEN
				col := 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});
				IF col # 0 THEN RETURN col ELSE RETURN 15 END
			ELSE
				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
		|1:	(* 16-bit hicolor *)
			IF SYSTEM.VAL(SET, col) * {0..23,30} = {30} THEN
				RETURN 0FFFFH
			ELSE
				RETURN 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})
			END
		|2:	(* 24/32-bit truecolor *)
			IF SYSTEM.VAL(SET, col) * {0..23,30} = {30} THEN
				RETURN 0FFFFFFH
			ELSE
				RETURN col MOD 1000000H
			END
	END
END TransColor;

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 InitPalette;
VAR col: LONGINT; ch: CHAR;
BEGIN
	SYSTEM.PORTIN(3DAH, ch);
	SYSTEM.PORTOUT(3C0H, 11X);
	SYSTEM.PORTOUT(3C0H, 0X);	(* palette entry 0 is black *)
	SYSTEM.PORTOUT(3C0H, 20X);
	FOR col := 0 TO 255 DO
		SYSTEM.PORTOUT(3C8H, CHR(col));
		SYSTEM.PORTOUT(3C9H, CHR(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, col) * {5..7}) DIV 4));
		SYSTEM.PORTOUT(3C9H, CHR(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, ASH(col, 7-4)) * {5..7}) DIV 4));
		SYSTEM.PORTOUT(3C9H, CHR(SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, ASH(col, 7-1)) * {6..7}) DIV 4))
	END
END InitPalette;

PROCEDURE Init;
VAR w, h, f, mem, adr: LONGINT; s: SET;
BEGIN
	w := GetVal("DWidth", 1024);	(* assume 1024 if not specified *)
	h := GetVal("DHeight", 768);	(* assume 768 if not specified *)
	f := GetVal("DDepth", 8) DIV 8;
	truecol := f DIV 2;
	mem := GetVal("DMem", 0)*1024;
	IF mem = 0 THEN	(* compute default *)
		mem := 512*1024;
		WHILE w*h*f >= mem DO mem := mem*2 END
	END;
	Kernel.GetInit(1, adr);
	Kernel.MapPhysical(adr, 800000H, adr);
	ASSERT(adr # 0);
	base0 := adr + 7FFC00H;
	NEW(d);
	d.width := w; d.height := h; d.offscreen := mem DIV (w*f) - h;
	d.format := f; d.unit := 10000;
	d.InitFrameBuffer(adr, mem);
	IF f = 1 THEN InitPalette END;
	SYSTEM.GET(base0+38H*4, s);
	Kernel.WriteString("ConfigChipID=");
	Kernel.WriteHex(SYSTEM.VAL(LONGINT, s), 8); Kernel.WriteLn;
		(* reset the FIFO *)
	SYSTEM.GET(base0+GenTestCntl, s); SYSTEM.PUT(base0+GenTestCntl, s - {8});
	SYSTEM.GET(base0+GenTestCntl, s); SYSTEM.PUT(base0+GenTestCntl, s + {8});
	SYSTEM.GET(base0+BusCntl, s); SYSTEM.PUT(base0+BusCntl, s + {23});
		(* initialize the engine (sec. 5.5.1) *)
	WaitFIFO(14);
	SYSTEM.PUT(base0+ContextMsk, {0..31});
	SYSTEM.PUT(base0+DstOffPitch, ASH(w, 22-3));
	SYSTEM.PUT(base0+DstYX, {});
	SYSTEM.PUT(base0+DstHeight, {});
	SYSTEM.PUT(base0+DstBresErr, {});
	SYSTEM.PUT(base0+DstBresInc, {});
	SYSTEM.PUT(base0+DstBresDec, {});
	SYSTEM.PUT(base0+DstCntl, {0, 1, 5});
	SYSTEM.PUT(base0+SrcOffPitch, ASH(w, 22-3));
	SYSTEM.PUT(base0+SrcYX, {});
	SYSTEM.PUT(base0+SrcHeight1Width1, {0, 16});
	SYSTEM.PUT(base0+SrcYXStart, {});
	SYSTEM.PUT(base0+SrcHeight2Width2, {0, 16});
	SYSTEM.PUT(base0+SrcCntl, {});
	WaitFIFO(13);
	SYSTEM.PUT(base0+HostCntl, {});	(* no byte align *)
	SYSTEM.PUT(base0+PatReg0, {});
	SYSTEM.PUT(base0+PatReg1, {});
	SYSTEM.PUT(base0+PatCntl, {});
	SYSTEM.PUT(base0+ScLeft, {});
	SYSTEM.PUT(base0+ScTop, {});
	SYSTEM.PUT(base0+ScBottom, (h+d.offscreen)-1);
	SYSTEM.PUT(base0+ScRight, w-1);
	SYSTEM.PUT(base0+DpBkgdClr, {});
	SYSTEM.PUT(base0+DpFrgdClr, {0..31});
	SYSTEM.PUT(base0+DpWriteMsk, {0..31});
	SYSTEM.PUT(base0+DpMix, {0, 1, 16, 17, 18});	(* SRC / DST *)
	SYSTEM.PUT(base0+DpSrc, {8});	(* FG / BG *)
	WaitFIFO(5);
	SYSTEM.PUT(base0+ClrCmpClr, {});
	SYSTEM.PUT(base0+ClrCmpMsk, {0..31});
	SYSTEM.PUT(base0+ClrCmpCntl, {});
	CASE f OF
		1: SYSTEM.PUT(base0+DpPixWidth, {1, 9, 17, 29});
			SYSTEM.PUT(base0+DpChainMsk, SYSTEM.VAL(LONGINT, 8080H))
		|2: SYSTEM.PUT(base0+DpPixWidth, {2, 10, 18, 30});
			SYSTEM.PUT(base0+DpChainMsk, SYSTEM.VAL(LONGINT, 4210H))
		|4: SYSTEM.PUT(base0+DpPixWidth, {1, 2, 9, 10, 17, 18, 29, 30});
			SYSTEM.PUT(base0+DpChainMsk, SYSTEM.VAL(LONGINT, 8080H))
	END;
	WaitIdle
END Init;

PROCEDURE Install*;
BEGIN
	IF d # NIL THEN AosDisplays.main := d END
END Install;

BEGIN
	Init; Install
END DisplayMach64.

DisplayTools.TryDriver DisplayMach64.Install 0 ~
DisplayTools.Restore
System.Free DisplayMach64 ~

(*
to do:
1 map register aperture
*)