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

(*
16-color VGA display driver for Native Oberon with virtual truecolor.

Config strings:
	Display="Displays."
	DDriver="DisplayVGA4"
	Init="b81200cd10"
*)

IMPORT SYSTEM, Kernel, CLUTs, Displays;

CONST
	Width = 640; Height = 480;

VAR
	d: Display;
	base: LONGINT;
	clut: POINTER TO CLUTs.CLUT;
	pal: ARRAY 16 OF LONGINT;
	shadow: POINTER TO ARRAY OF CHAR;
	pelmask: LONGINT;	(* trace *)

TYPE
	Display* = OBJECT (Displays.Display)
		
		PROCEDURE Transfer*(VAR buf: ARRAY OF CHAR;  ofs, stride, x, y, w, h, op: LONGINT);
		VAR bufadr, buflow, bufhigh, dispadr, scradr: LONGINT;
		BEGIN
			IF w > 0 THEN
				bufadr := SYSTEM.ADR(buf[ofs]);
				IF op = Displays.set THEN
					buflow := SYSTEM.ADR(shadow[0]); bufhigh := buflow + LEN(shadow^);
					dispadr := SYSTEM.ADR(shadow[0]) + ((y*Width)+x);
					scradr := base + (x DIV 8 + y*(Width DIV 8)) MOD 10000H;
					WHILE h > 0 DO
						ASSERT((dispadr >= buflow) & (dispadr+w <= bufhigh));	(* index check *)
						SYSTEM.MOVE(bufadr, dispadr, w);
						CopyLineTo(bufadr, scradr, x, w);
						INC(bufadr, stride); INC(dispadr, Width); INC(scradr, Width DIV 8);
						DEC(h)
					END
				ELSIF op = Displays.get THEN
					buflow := SYSTEM.ADR(buf[0]); bufhigh := buflow + LEN(buf);
					dispadr := SYSTEM.ADR(shadow[0]) + ((y*Width)+x);
					WHILE h > 0 DO
						ASSERT((bufadr >= buflow) & (bufadr+w <= bufhigh));	(* index check *)
						SYSTEM.MOVE(dispadr, bufadr, w);
						INC(bufadr, stride); INC(dispadr, Width);
						DEC(h)
					END
				ELSE (* skip *)
				END
			END
		END Transfer;
		
(*
		PROCEDURE Dot*(col, x, y: LONGINT);
		VAR ch: CHAR;
		BEGIN
			y := base + (x + y*Width) DIV 8 MOD 10000H;
			SYSTEM.PORTOUT(3CEH, SYSTEM.VAL(INTEGER, 8 + ASH(100H, 7-x MOD 8)));
			IF ASH(col, 1) >= 0 THEN	(* replace *)
				SYSTEM.GET(y, ch);
				SYSTEM.PUT(y, CHR(CLUTs.Match(clut^, col)))
			ELSE	(* invert *)
				SYSTEM.PORTOUT(3CEH, SYSTEM.VAL(INTEGER, 1803H));
				SYSTEM.GET(y, ch);
				SYSTEM.PUT(y, CHR(CLUTs.Match(clut^, col)));
				SYSTEM.PORTOUT(3CEH, SYSTEM.VAL(INTEGER, 0003H))
			END
		END Dot;
*)
		
		PROCEDURE ColorToIndex*(col: LONGINT): LONGINT;
		BEGIN
			RETURN CLUTs.Match(clut^, col)
		END ColorToIndex;
		
		PROCEDURE IndexToColor*(index: LONGINT): LONGINT;
		BEGIN
			RETURN pal[index MOD 16]
		END IndexToColor;
		
	END Display;

(* Copy a line of pixels to the display. *)

PROCEDURE CopyLineTo(src, dst, x, w: LONGINT);
CODE {SYSTEM.i386}
	MOV ESI, src[EBP]
	MOV EDI, dst[EBP]
	MOV EBX, x[EBP]
	MOV EDX, 3CEH
	MOV AL, 8
new:
	MOV CH, [ESI]	; CH = current pixel color
	MOV AH, 80H	; AH = mask for current pixels (at left of byte)
	MOV CL, BL
	AND CL, 7	; CL = offset to shift mask right
	JMP loop
same:
	SAR AH, 1
loop:
	DEC w[EBP]
	JZ done
	INC EBX
	INC ESI
	TEST BL, 7
	JZ edge
	CMP CH, [ESI]
	JE same
diff:
	SHR AH, CL
	OUT DX, AX
	MOV CL, [EDI]
	MOV [EDI], CH
	JMP new
edge:
	SHR AH, CL	; adjust mask
	OUT DX, AX	; set mask
	MOV CL, [EDI]	; latch
	MOV [EDI], CH	; output color
	INC EDI
	JMP new
done:
	SHR AH, CL
	OUT DX, AX
	MOV CL, [EDI]
	MOV [EDI], CH
end:
END CopyLineTo;

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

PROCEDURE InitPalette;
VAR i, col: LONGINT; ch: CHAR;
BEGIN
		(* standard Oberon colours *)
	pal[0] := 0; pal[1] := 0FF0000H; pal[2] := 000FF00H;
	pal[3] := 00000FFH; pal[4] := 0FF00FFH; pal[5] := 0FFFF00H;
	pal[6] := 000FFFFH; pal[7] := 0AA0000H; pal[9] := 000009AH;
	pal[10] := 0A6CBF3H; pal[11] := 0008282H; pal[12] := 08A8A8AH;
	pal[13] := 0BEBEBEH; pal[14] := 0DFDFDFH; pal[15] := 0FFFFFFH;
		(* set attribute controller registers *)
	SYSTEM.PORTIN(3DAH, ch);	(* clear flip/flop *)
	FOR i := 0 TO 0FH DO
		SYSTEM.PORTOUT(3C0H, CHR(i));	(* EGA palette register i *)
		SYSTEM.PORTOUT(3C0H, CHR(i))	(* maps to VGA palette i *)
	END;
	SYSTEM.PORTOUT(3C0H, 11X);	(* overscan color *)
	SYSTEM.PORTOUT(3C0H, 0X);	(* black/EGA palette 0/VGA palette 0 *)
	SYSTEM.PORTOUT(3C0H, 12X);	(* color plane enable *)
	SYSTEM.PORTOUT(3C0H, 0FX);	(* enable all planes *)
	SYSTEM.PORTOUT(3C0H, 14X);	(* color select *)
	SYSTEM.PORTOUT(3C0H, 0X);	(* use first 16 colors in VGA palette *)
	SYSTEM.PORTOUT(3C0H, 20X);	(* enable display to use palette again *)
		(* set up VGA palette and reverse lookup table *)
	NEW(clut);
	SYSTEM.PORTOUT(3C8H, 0X);	(* select index 0 *)
	FOR i := 0 TO 15 DO
		col := pal[i]; CLUTs.Set(clut^, i, col);
		SYSTEM.PORTOUT(3C9H, CHR(col DIV 10000H MOD 100H DIV 4));
		SYSTEM.PORTOUT(3C9H, CHR(col DIV 100H MOD 100H DIV 4));
		SYSTEM.PORTOUT(3C9H, CHR(col MOD 100H DIV 4))
	END;
	FOR i := 16 TO 255 DO
		SYSTEM.PORTOUT(3C9H, 0X);
		SYSTEM.PORTOUT(3C9H, 0X);
		SYSTEM.PORTOUT(3C9H, 0X)
	END;
	CLUTs.Init(clut^, 16, 3);
	SYSTEM.PORTIN(3C6H, ch); pelmask := ORD(ch)
END InitPalette;
(*
		IF i = 6 THEN j := 14H
		ELSIF i > 7 THEN j := i+30H
		ELSE j := i
		END;
*)

PROCEDURE Init;
BEGIN
	NEW(d);
	d.width := Width; d.height := Height; d.offscreen := 0;
	d.format := Displays.index8; d.unit := 10000;
	Kernel.MapPhysical(0A0000H, 10000H, base);
	NEW(shadow, Width*Height);
		(* data rotate 0 *)
	SYSTEM.PORTOUT(3CEH, SYSTEM.VAL(INTEGER, 0003H));
		(* write mode 2 *)
	SYSTEM.PORTOUT(3CEH, SYSTEM.VAL(INTEGER, 0205H));
		(* set/reset disabled *)
	SYSTEM.PORTOUT(3CEH, SYSTEM.VAL(INTEGER, 0001H));
		(* no set/reset *)
	SYSTEM.PORTOUT(3CEH, SYSTEM.VAL(INTEGER, 0000H));
		(* map mask enable all planes *)
	SYSTEM.PORTOUT(3C4H, SYSTEM.VAL(INTEGER, 0F02H));
	InitPalette
END Init;

BEGIN
	Init; Install
END DisplayVGA4.

(*
to do:
1 fix for Mach64
1 remove shadow (read from real display)
1 offscreen
*)