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 *)