转到内容

Oberon/ETH Oberon/2.3.7/DisplayTool.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 DisplayTool;

	IMPORT V86, SYSTEM, MathL, Kernel (*, Log, Texts, Oberon, In *);
	
	CONST
		textsDebug = TRUE;
	
	CONST
		GTFLockVF = 1;		(* Lock to vertical frequency				*)
		GTFLockHF = 2;		(* Lock to horizontal frequency			*)
		GTFLockPF = 3;		(* Lock to pixel clock frequency			*)
		
	TYPE
		GTFConstants = RECORD
			margin: LONGREAL;			(* Margin size as percentage of display		*)
			cellGran: LONGREAL;		(* Character cell granularity				*)
			minPorch: LONGREAL;		(* Minimum front porch in lines/chars		*)
			vSyncRqd: LONGREAL;		(* Width of V sync in lines					*)
			hSync: LONGREAL;			(* Width of H sync as percent of total		*)
			minVSyncBP: LONGREAL;		(* Minimum vertical sync + back porch (us)	*)
			m: LONGREAL;				(* Blanking formula gradient				*)
			c: LONGREAL;				(* Blanking formula offset					*)
			k: LONGREAL;				(* Blanking formula scaling factor			*)
			j: LONGREAL;				(* Blanking formula scaling factor weight	*)
		END;
		
		GTFHCRTC = RECORD
			hTotal: LONGINT;         	(* Horizontal total                     *)
			hDisp: LONGINT;				(* Horizontal displayed					*)
			hSyncStart: LONGINT;     	(* Horizontal sync start                *)
			hSyncEnd: LONGINT;     		(* Horizontal sync end                  *)
			hFrontPorch: LONGINT;		(* Horizontal front porch				*)
			hSyncWidth: LONGINT;			(* Horizontal sync width				*)
			hBackPorch: LONGINT;			(* Horizontal back porch				*)
		END;
		
		GTFVCRTC = RECORD
			vTotal: LONGINT;         	(* Vertical total                       *)
			vDisp: LONGINT;  			(* Vertical displayed                   *)
			vSyncStart: LONGINT;     	(* Vertical sync start                  *)
			vSyncEnd: LONGINT;       	(* Vertical sync end                    *)
			vFrontPorch: LONGINT;		(* Vertical front porch					*)
			vSyncWidth: LONGINT;			(* Vertical sync width					*)
			vBackPorch: LONGINT;			(* Vertical back porch					*)
		END;
		
		GTFTimings = RECORD
			h: GTFHCRTC;				(* Horizontal CRTC paremeters			*)
			v: GTFVCRTC;				(* Vertical CRTC parameters				*)
			hSyncPol: CHAR;		(* Horizontal sync polarity				*)
			vSyncPol: CHAR;		(* Vertical sync polarity				*)
			interlace: CHAR;		(* 'I' for Interlace, 'N' for Non		*)
			vFreq: LONGREAL;			(* Vertical frequency (Hz)				*)
			hFreq: LONGREAL;			(* Horizontal frequency (KHz)			*)
			dotClock: LONGREAL;		(* Pixel clock (Mhz)					*)
		END;
	
	VAR
		GC: GTFConstants;
		
	TYPE
		VBEString = ARRAY 32 OF CHAR;
		
		VideoMode = POINTER TO VideoModeDesc;
		VideoModeDesc = RECORD
			modeNr: LONGINT;
			(* mandatory for all VBE revisions *)
			modeAttr, winAAttr, winBAttr: SET;
			winGranularity, winSize, winASeg, winBSeg, bytesPerScanLine: LONGINT;
			winFuncPtr: LONGINT;
			(* mandatory for VBE 1.2 and above *)
			xRes, yRes, xCharSize, yCharSize, nrOfPlanes, bitsPerPixel, nrOfBanks: LONGINT;
			memoryModel, bankSize, nrOfImgPages: LONGINT;
			(* direct color fields (for direct/6 and YUV/7) *)
			redMaskSize, redFieldPos: LONGINT;
			greenMaskSize, greenFieldPos: LONGINT;
			blueMaskSize, blueFieldPos: LONGINT;
			rsvdMaskSize, rsvdFieldPos: LONGINT;
			directColorModeInfo: SET;
			(* mandatory for VBE 2.0 and above *)
			physBasePtr: LONGINT;
			(* mandatory for VBE 3.0 and above *)
			linBytesPerScanLine, bnkNrOfImgPages, linNrOfImgPages: LONGINT;
			linRedMaskSize, linRedFieldPos: LONGINT;
			linGreenMaskSize, linGreenFieldPos: LONGINT;
			linBlueMaskSize, linBlueFieldPos: LONGINT;
			linRsvdMaskSize, linRsvdFieldPos, maxPixelClock: LONGINT;
			next: VideoMode
		END;
		
		VBEControllerInfo = RECORD
			sig: ARRAY 5 OF CHAR;
			version, oemSoftwareRev, totalMem: LONGINT;
			oemString, oemVendor, oemProductName, oemProductRev: VBEString;
			dac8, vga, extDac, stereo, stereoEVC, available: BOOLEAN;
			vmodes: VideoMode
		END;
	
	VAR
		Width*, Height*, Depth*, Hz*: LONGINT;
		HSyncStart, HSyncEnd, VSyncStart, VSyncEnd: LONGINT;
		vbe: VBEControllerInfo;
(*		W: Texts.Writer;
		T: Texts.Text; *)
	
	PROCEDURE LogStr(s: ARRAY OF CHAR);
	BEGIN
(*		IF textsDebug THEN Texts.WriteString(W, s); Texts.Append(T, W.buf)
		ELSE Log.Str(s)
		END *)
	END LogStr;
	
	PROCEDURE LogHex(x: LONGINT);
	BEGIN
(*		IF textsDebug THEN Texts.WriteHex(W, x); Texts.Append(T, W.buf)
		ELSE Log.Hex(x)
		END *)
	END LogHex;
	
	PROCEDURE LogInt(x: LONGINT);
	BEGIN
(*		IF textsDebug THEN Texts.WriteInt(W, x, 0); Texts.Append(T, W.buf)
		ELSE Log.Int(x)
		END *)
	END LogInt;
	
	PROCEDURE LogLn;
	BEGIN
(*		IF textsDebug THEN Texts.WriteLn(W); Texts.Append(T, W.buf)
		ELSE Log.Ln
		END *)
	END LogLn;
	
	(* GTF *)
	PROCEDURE pow(x: LONGREAL; n: LONGINT): LONGREAL;
	VAR s: LONGREAL;
	BEGIN
		s := 1;
		WHILE n > 0 DO s := s * x; DEC(n) END;
		RETURN s
	END pow;
	
	PROCEDURE Round(v: LONGREAL): LONGREAL;
	BEGIN
		RETURN ENTIER(v + 0.5)
	END Round;

	PROCEDURE GetInternalConstants(VAR c: GTFConstants);
	BEGIN
		c.margin := GC.margin; c.cellGran := Round(GC.cellGran);
		c.minPorch := Round(GC.minPorch); c.vSyncRqd := Round(GC.vSyncRqd);
		c.hSync := GC.hSync; c.minVSyncBP := GC.minVSyncBP;
		IF GC.k = 0 THEN c.k := 0.001 ELSE c.k := GC.k END;
		c.m := (c.k / 256) * GC.m; c.c := (GC.c - GC.j) * (c.k / 256) + GC.j;
		c.j := GC.j;
	END GetInternalConstants;

	(****************************************************************************
	*
	* Function:		GTF_calcTimings
	* Parameters:	hPixels		- X resolution
	*				vLines		- Y resolution
	*				freq		- Frequency (Hz, KHz or MHz depending on type)
	*				type		- 1 - vertical, 2 - horizontal, 3 - dot clock
	*				margins		- True if margins should be generated
	*				interlace	- True if interlaced timings to be generated
	*				t			- Place to store the resulting timings
	*
	* Description:  Calculates a set of GTF timing parameters given a specified
	*				resolution and vertical frequency. The horizontal frequency
	*				and dot clock will be automatically generated by this
	*				routines.
	*
	*				For interlaced modes the CRTC parameters are calculated for
	*				a single field, so will be half what would be used in
	*				a non-interlaced mode.
	*
	****************************************************************************)
	PROCEDURE GTFCalcTimings(hPixels, vLines, freq: LONGREAL; type: LONGINT; wantMargins, wantInterlace: BOOLEAN;
				VAR t: GTFTimings);
	VAR
		interlace,vFieldRate,hPeriod: LONGREAL;
		topMarginLines,botMarginLines: LONGREAL;
		leftMarginPixels,rightMarginPixels: LONGREAL;
		hPeriodEst,vSyncBP,vBackPorch: LONGREAL;
		vTotalLines,vFieldRateEst: LONGREAL;
		hTotalPixels,hTotalActivePixels,hBlankPixels: LONGREAL;
		idealDutyCycle,hSyncWidth,hSyncBP,hBackPorch: LONGREAL;
		idealHPeriod: LONGREAL;
		vFreq,hFreq,dotClock: LONGREAL;
		c: GTFConstants;
	BEGIN
		GetInternalConstants(c);
		vFreq := freq; hFreq := freq; dotClock := freq;

		(* Round pixels to character cell granularity *)
		hPixels := Round(hPixels / c.cellGran) * c.cellGran;

		(* For interlaced mode halve the vertical parameters, and double the required field refresh rate. *)
		IF wantInterlace THEN
			vLines := Round(vLines / 2);
			vFieldRate := vFreq * 2;
			dotClock := dotClock * 2;
			interlace := 0.5;
		ELSE vFieldRate := vFreq; interlace := 0
		END;

		(* Determine the lines for margins *)
		IF wantMargins THEN
			topMarginLines := Round(c.margin / 100 * vLines);
			botMarginLines := Round(c.margin / 100 * vLines)
		ELSE topMarginLines := 0; botMarginLines := 0
		END;

		IF type # GTFLockPF THEN
			IF type = GTFLockVF THEN
				(* Estimate the horizontal period *)
				hPeriodEst := ((1/vFieldRate)-(c.minVSyncBP/1000000))/
						(vLines+(2*topMarginLines)+c.minPorch+interlace)*1000000;

				(* Find the number of lines in vSync + back porch *)
				vSyncBP := Round(c.minVSyncBP / hPeriodEst);
			ELSIF type = GTFLockHF THEN
				(* Find the number of lines in vSync + back porch *)
				vSyncBP := Round((c.minVSyncBP * hFreq) / 1000);
			END;

			(* Find the number of lines in the V back porch alone *)
			vBackPorch := vSyncBP - c.vSyncRqd;
	
			(* Find the total number of lines in the vertical period *)
			vTotalLines := vLines + topMarginLines + botMarginLines + vSyncBP
					+ interlace + c.minPorch;

			IF type = GTFLockVF THEN
				(* Estimate the vertical frequency *)
				vFieldRateEst := 1000000 / (hPeriodEst * vTotalLines);

				(* Find the actual horizontal period *)
				hPeriod := (hPeriodEst * vFieldRateEst) / vFieldRate;

				(* Find the actual vertical field frequency *)
				vFieldRate := 1000000 / (hPeriod * vTotalLines);
			ELSIF type = GTFLockHF THEN
				(* Find the actual vertical field frequency *)
				vFieldRate := (hFreq / vTotalLines) * 1000;
			END
		END;

		(* Find the number of pixels in the left and right margins *)
		IF wantMargins THEN
			leftMarginPixels := Round(hPixels * c.margin) / (100 * c.cellGran);
			rightMarginPixels := Round(hPixels * c.margin) / (100 * c.cellGran);
		ELSE leftMarginPixels := 0; rightMarginPixels := 0
		END;

		(* Find the total number of active pixels in image + margins *)
		hTotalActivePixels := hPixels + leftMarginPixels + rightMarginPixels;

		IF type = GTFLockVF THEN
			(* Find the ideal blanking duty cycle *)
			idealDutyCycle := c.c - ((c.m * hPeriod) / 1000)
		ELSIF type = GTFLockHF THEN
			(* Find the ideal blanking duty cycle *)
			idealDutyCycle := c.c - (c.m / hFreq);
		ELSIF type = GTFLockPF THEN
			(* Find ideal horizontal period from blanking duty cycle formula *)
			idealHPeriod := (((c.c - 100) + (MathL.sqrt((pow(100-c.c,2)) +
				(0.4 * c.m * (hTotalActivePixels + rightMarginPixels +
				leftMarginPixels) / dotClock)))) / (2 * c.m)) * 1000;

			(* Find the ideal blanking duty cycle *)
			idealDutyCycle := c.c - ((c.m * idealHPeriod) / 1000);
		END;

		(* Find the number of pixels in blanking time *)
		hBlankPixels := Round((hTotalActivePixels * idealDutyCycle) /
			((100 - idealDutyCycle) * c.cellGran)) * c.cellGran;

		(* Find the total number of pixels *)
		hTotalPixels := hTotalActivePixels + hBlankPixels;

		(* Find the horizontal back porch *)
		hBackPorch := Round((hBlankPixels / 2) / c.cellGran) * c.cellGran;

		(* Find the horizontal sync width *)
		hSyncWidth := Round(((c.hSync/100) * hTotalPixels) / c.cellGran) * c.cellGran;

		(* Find the horizontal sync + back porch *)
		hSyncBP := hBackPorch + hSyncWidth;

		IF type = GTFLockPF THEN
			(* Find the horizontal frequency *)
			hFreq := (dotClock / hTotalPixels) * 1000;

			(* Find the number of lines in vSync + back porch *)
			vSyncBP := Round((c.minVSyncBP * hFreq) / 1000);

			(* Find the number of lines in the V back porch alone *)
			vBackPorch := vSyncBP - c.vSyncRqd;

			(* Find the total number of lines in the vertical period *)
			vTotalLines := vLines + topMarginLines + botMarginLines + vSyncBP
				+ interlace + c.minPorch;

			(* Find the actual vertical field frequency *)
			vFieldRate := (hFreq / vTotalLines) * 1000;
		ELSE
			IF type = GTFLockVF THEN
				(* Find the horizontal frequency *)
				hFreq := 1000 / hPeriod;
			ELSIF type = GTFLockHF THEN
				(* Find the horizontal frequency *)
				hPeriod := 1000 / hFreq;
			END;

			(* Find the pixel clock frequency *)
			dotClock := hTotalPixels / hPeriod;
		END;

		(* Find the vertical frame frequency *)
		IF wantInterlace THEN vFreq := vFieldRate / 2; dotClock := dotClock / 2;
		ELSE vFreq := vFieldRate
		END;

		(* Return the computed frequencies *)
		t.vFreq := vFreq;
		t.hFreq := hFreq;
		t.dotClock := dotClock;

		(* Determine the vertical timing parameters *)
		t.h.hTotal := ENTIER(hTotalPixels);
		t.h.hDisp := ENTIER(hTotalActivePixels);
		t.h.hSyncStart := ENTIER(t.h.hTotal - hSyncBP);
		t.h.hSyncEnd := ENTIER(t.h.hTotal - hBackPorch);
		t.h.hFrontPorch := t.h.hSyncStart - t.h.hDisp;
		t.h.hSyncWidth := ENTIER(hSyncWidth);
		t.h.hBackPorch := ENTIER(hBackPorch);

		(* Determine the vertical timing parameters *)
		t.v.vTotal := ENTIER(vTotalLines);
		t.v.vDisp := ENTIER(vLines);
		t.v.vSyncStart := ENTIER(t.v.vTotal - vSyncBP);
		t.v.vSyncEnd := ENTIER(t.v.vTotal - vBackPorch);
		t.v.vFrontPorch := t.v.vSyncStart - t.v.vDisp;
		t.v.vSyncWidth := ENTIER(c.vSyncRqd);
		t.v.vBackPorch := ENTIER(vBackPorch);

		(* Mark as GTF timing using the sync polarities *)
		IF wantInterlace THEN t.interlace := 'I' ELSE t.interlace := 'N' END;
		t.hSyncPol := '-';
		t.vSyncPol := '+';
	END GTFCalcTimings;

	(* VBE *)
	
	PROCEDURE CopyVBEString(adr: LONGINT; VAR s: ARRAY OF CHAR);
	VAR adr0, i: LONGINT; adr1: INTEGER;
	BEGIN
		SYSTEM.GET(adr+2, adr1); adr0 := LONG(adr1) * 16;
		SYSTEM.GET(adr, adr1); adr0 := adr0+adr1;
		i := -1;
		REPEAT INC(i); SYSTEM.GET(adr0, s[i]); INC(adr0) UNTIL s[i] = 0X
	END CopyVBEString;
	
	PROCEDURE UpDown*;
	BEGIN
	END UpDown;
	
	PROCEDURE LeftRight*;
	BEGIN
	END LeftRight;
	
	PROCEDURE ChangeHz*;
	BEGIN
	END ChangeHz;
	
	PROCEDURE Set*;
	BEGIN
	END Set;
	
	PROCEDURE SetVideoMode*(modeNr, vFreq: LONGINT; blank, linear: BOOLEAN; VAR res: LONGINT);
	VAR vmem, adr: LONGINT; flags: SET; p: VideoMode; regs: V86.Regs; t: GTFTimings; 
	BEGIN
		modeNr := modeNr MOD 200H; res := 0;
		Kernel.NewDMA(256, adr, vmem);	(* allocate DMA buffer *)
		ASSERT(vmem MOD 16 = 0);  ASSERT(vmem < 100000H);	(* sanity *)
		ASSERT(adr = vmem);	(* implementation restriction *)
		
		p := vbe.vmodes;
		WHILE (p # NIL) & (p.modeNr # modeNr) DO p := p.next END;
		IF p # NIL THEN
			IF (vbe.version >= 300H) & (vFreq > 0) THEN
				GTFCalcTimings(p.xRes, p.yRes, vFreq, GTFLockVF, FALSE, FALSE, t);
				regs.EAX := 4F0BH; regs.EBX := 0;
				regs.ECX := vFreq*t.h.hTotal*t.v.vTotal; regs.EDX := modeNr;
				V86.Video(regs); ASSERT(regs.EAX = 4FH, 100);
				SYSTEM.PUT(vmem, SYSTEM.VAL(INTEGER, t.h.hTotal));
				SYSTEM.PUT(vmem+2, SYSTEM.VAL(INTEGER, t.h.hSyncStart));
				SYSTEM.PUT(vmem+4, SYSTEM.VAL(INTEGER, t.h.hSyncEnd));
				SYSTEM.PUT(vmem+6, SYSTEM.VAL(INTEGER, t.v.vTotal));
				SYSTEM.PUT(vmem+8, SYSTEM.VAL(INTEGER, t.v.vSyncStart));
				SYSTEM.PUT(vmem+10, SYSTEM.VAL(INTEGER, t.v.vSyncEnd));
				flags := {};
				IF t.interlace = "I" THEN INCL(flags, 1) END;
				IF t.hSyncPol = "-" THEN INCL(flags, 2) END;
				IF t.vSyncPol = "-" THEN INCL(flags, 3) END;
				SYSTEM.PUT(vmem+12, SYSTEM.VAL(CHAR, flags));
				SYSTEM.PUT(vmem+13, regs.ECX);
				SYSTEM.PUT(vmem+17, SYSTEM.VAL(INTEGER, vFreq*100));
				regs.EBX := 800H
			ELSE regs.EBX := 0
			END;
			regs.EAX := 4F02H; INC(regs.EBX, modeNr);
			IF ~blank THEN INC(regs.EBX, 8000H) END;
			IF linear THEN INC(regs.EBX, 4000H) END;
			regs.ES := SHORT(vmem DIV 16); regs.EDI := 0;
			V86.Video(regs); ASSERT(regs.EAX MOD 10000H= 4FH, 101);
		ELSE res := 1
		END;
		
		Kernel.DisposeDMA(256, vmem);	(* deallocate DMA buffer *)
	END SetVideoMode;
	
	PROCEDURE GetFrameBuffer*(modeNr: LONGINT; VAR physAdr, size: LONGINT);
	VAR p: VideoMode;
	BEGIN
		modeNr := modeNr MOD 200H;
		p := vbe.vmodes;
		WHILE (p # NIL) & (p.modeNr # modeNr) DO p := p.next END;
		IF p = NIL THEN physAdr := -1; size := 0 ELSE physAdr := p.physBasePtr; size := vbe.totalMem END
	END GetFrameBuffer;
	
	PROCEDURE SearchVideoMode*(width, height, depth: LONGINT): LONGINT;
	VAR modeNr: LONGINT; p: VideoMode;
	BEGIN
		p := vbe.vmodes;
		WHILE (p # NIL) & ((p.xRes # width) OR (p.yRes # height) OR (p.bitsPerPixel # depth)) DO p := p.next END;
		IF p # NIL THEN modeNr := p.modeNr ELSE modeNr := 0 END;
		RETURN modeNr;
	END SearchVideoMode;
	
	PROCEDURE GetCurrentVideoMode*(): LONGINT;
	VAR regs: V86.Regs;
	BEGIN
		regs.EAX := 4F03H;
		V86.Video(regs);
		RETURN regs.EBX		
	END GetCurrentVideoMode;
	
	PROCEDURE ShowVideoModes;
	VAR p: VideoMode;
	BEGIN
		LogStr("VideoModes"); LogLn;
		p := vbe.vmodes;
		WHILE p # NIL DO
			LogStr("Mode: "); LogHex(p.modeNr); LogLn;
			LogStr("mode attributes: "); LogLn;
			LogStr("   "); IF ~(0 IN p.modeAttr) THEN LogStr("no ") END; LogStr("HW support"); LogLn;
			LogStr("   "); IF ~(2 IN p.modeAttr) THEN LogStr("no ") END; LogStr("TTY output support"); LogLn;
			LogStr("   "); IF 3 IN p.modeAttr THEN LogStr("color") ELSE LogStr("monochrome") END; LogLn;
			LogStr("   "); IF 4 IN p.modeAttr THEN LogStr("graphics") ELSE LogStr("text") END; LogLn;
			LogStr("   "); IF ~(5 IN p.modeAttr) THEN LogStr("not ") END; LogStr("VGA compatible"); LogLn;
			LogStr("   "); IF 6 IN p.modeAttr THEN LogStr("no ") END; LogStr("VGA comp. windowing"); LogLn;
			LogStr("   "); IF ~(7 IN p.modeAttr) THEN LogStr("no ") END; LogStr("linear frame buffer available"); LogLn;
			LogStr("   "); IF ~(8 IN p.modeAttr) THEN LogStr("no ") END; LogStr("double scanning available"); LogLn;
			LogStr("   "); IF ~(9 IN p.modeAttr) THEN LogStr("no ") END; LogStr("interlacing available"); LogLn;
			LogStr("   "); IF ~(10 IN p.modeAttr) THEN LogStr("no ") END; LogStr("HW triple buffering support"); LogLn;
			LogStr("   "); IF ~(11 IN p.modeAttr) THEN LogStr("no ") END; LogStr("HW stereoscopic support"); LogLn;
			LogStr("   "); IF ~(12 IN p.modeAttr) THEN LogStr("no ") END; LogStr("dual display start address support"); LogLn;
			LogStr("window A attributes: "); LogLn;
			IF 0 IN p.winAAttr THEN LogStr("   relocatable window") ELSE LogStr("   single non-relocatable window") END; LogLn;
			LogStr("   Window "); IF ~(1 IN p.winAAttr) THEN LogStr("not ") END; LogStr("readable"); LogLn;
			LogStr("   Window "); IF ~(2 IN p.winAAttr) THEN LogStr("not ") END; LogStr("writeable"); LogLn;
			LogStr("window B attributes: "); LogLn;
			IF 0 IN p.winBAttr THEN LogStr("   relocatable window") ELSE LogStr("   single non-relocatable window") END; LogLn;
			LogStr("   Window "); IF ~(1 IN p.winBAttr) THEN LogStr("not ") END; LogStr("readable"); LogLn;
			LogStr("   Window "); IF ~(2 IN p.winBAttr) THEN LogStr("not ") END; LogStr("writeable"); LogLn;
			LogStr("window granularity in KB: "); LogInt(p.winGranularity); LogLn;
			LogStr("window size: "); LogInt(p.winSize); LogLn;
			LogStr("window A start segment: "); LogHex(p.winASeg); LogLn;
			LogStr("window B start segment: "); LogHex(p.winBSeg); LogLn;
			LogStr("real mode pointer to window function: "); LogHex(p.winFuncPtr); LogLn;
			LogStr("bytes per scan line: "); LogInt(p.bytesPerScanLine); LogLn;
			IF vbe.version >= 102H THEN	(* VBE 1.2 and above *)
				LogStr("horizontal resolution: "); LogInt(p.xRes); LogLn;
				LogStr("vertical resolution: "); LogInt(p.yRes); LogLn;
				LogStr("character cell width: "); LogInt(p.xCharSize); LogLn;
				LogStr("character cell height: "); LogInt(p.yCharSize); LogLn;
				LogStr("planes: "); LogInt(p.nrOfPlanes); LogLn;
				LogStr("bits per pixel: "); LogInt(p.bitsPerPixel); LogLn;
				LogStr("number of banks: "); LogInt(p.nrOfBanks); LogLn;
				LogStr("memory model: "); LogInt(p.memoryModel); LogStr(", ");
				CASE p.memoryModel OF
					0: LogStr("text mode")
				| 1: LogStr("CGA graphics")
				| 2: LogStr("Hercules graphics")
				| 3: LogStr("planar")
				| 4: LogStr("packed pixel")
				| 5: LogStr("non-chain 4, 256 color")
				| 6: LogStr("direct color")
				| 7: LogStr("YUV")
				| 8..0FH: LogStr("reserverd (VESA)")
				ELSE LogStr("OEM defined")
				END;
				LogLn;
				LogStr("bank size: "); LogInt(p.bankSize); LogLn;
				LogStr("number of images: "); LogInt(p.nrOfImgPages); LogLn;
				IF (p.memoryModel = 6) OR (p.memoryModel = 7) THEN
					LogStr("red mask size: "); LogInt(p.redMaskSize); LogLn;
					LogStr("red field position: "); LogInt(p.redFieldPos); LogLn;
					LogStr("green mask size: "); LogInt(p.greenMaskSize); LogLn;
					LogStr("green field position: "); LogInt(p.greenFieldPos); LogLn;
					LogStr("blue mask size: "); LogInt(p.blueMaskSize); LogLn;
					LogStr("blue field position: "); LogInt(p.blueFieldPos); LogLn;
					LogStr("reserved mask size: "); LogInt(p.rsvdMaskSize); LogLn;
					LogStr("reserved field position: "); LogInt(p.rsvdFieldPos); LogLn;
					LogStr("direct color mode information: "); LogLn;
					LogStr("   color ramp "); IF 0 IN p.directColorModeInfo THEN LogStr("programmable") ELSE LogStr("fixed") END; LogLn;
					LogStr("   reserved field "); IF 1 IN p.directColorModeInfo THEN LogStr("usable") ELSE LogStr("reserved") END; LogLn
				END
			END;
			IF vbe.version >= 200H THEN
				LogStr("start address of linear frame buffer: "); LogHex(p.physBasePtr); LogLn
			END;
			IF vbe.version >= 300H THEN
				LogStr("linear bytes per scan line: "); LogInt(p.linBytesPerScanLine); LogLn;
				LogStr("# images for banked modes: "); LogInt(p.bnkNrOfImgPages); LogLn;
				LogStr("# images for linear modes: "); LogInt(p.linNrOfImgPages); LogLn;
				LogStr("linear red mask size: "); LogInt(p.linRedMaskSize); LogLn;
				LogStr("linear red field position: "); LogInt(p.linRedFieldPos); LogLn;
				LogStr("linear green mask size: "); LogInt(p.linGreenMaskSize); LogLn;
				LogStr("linear green field position: "); LogInt(p.linGreenFieldPos); LogLn;
				LogStr("linear blue mask size: "); LogInt(p.linBlueMaskSize); LogLn;
				LogStr("linear blue field position: "); LogInt(p.linBlueFieldPos); LogLn;
				LogStr("linear reserved mask size: "); LogInt(p.linRsvdMaskSize); LogLn;
				LogStr("linear reserved field position: "); LogInt(p.linRsvdFieldPos); LogLn;
				LogStr("maximum pixel clock (Hz): "); LogInt(p.maxPixelClock); LogLn
			END;
			p := p.next
		END
	END ShowVideoModes;
	
	PROCEDURE ShowVesaInfo*;
	BEGIN
		LogStr("VESA signature: "); LogStr(vbe.sig); LogLn;
		LogStr("version: "); LogHex(vbe.version); LogLn;
		LogStr("OEM: "); LogStr(vbe.oemString); LogLn;
		LogStr("OEM vendor: "); LogStr(vbe.oemVendor); LogLn;
		LogStr("OEM product: "); LogStr(vbe.oemProductName); LogLn;
		LogStr("OEM product revision: "); LogStr(vbe.oemProductRev); LogLn;
		LogStr("OEM software revision: "); LogHex(vbe.oemSoftwareRev); LogLn;
		LogStr("total memory (MB): "); LogInt(vbe.totalMem DIV (1024 * 1024)); LogLn;
		LogStr("Capabilities: ");
		IF vbe.dac8 THEN LogStr("8-bit DAC") ELSE LogStr("6-bit DAC") END; LogStr(", ");
		IF ~vbe.vga THEN LogStr("not VGA comp") ELSE LogStr("VGA comp") END; LogStr(", ");
		IF vbe.extDac THEN LogStr("extended RAMDAC") ELSE LogStr("normal RAMDAC") END; LogStr(", ");
		IF vbe.stereo THEN LogStr("stereoscopic support") ELSE LogStr("no stereoscopic support") END; LogStr(", ");
		IF vbe.stereoEVC THEN LogStr("stereo. over VESA EVC") ELSE LogStr("stereo. over external VESA conn.") END; LogLn;
		ShowVideoModes
	END ShowVesaInfo;
	
	PROCEDURE GetModeInfo(p: VideoMode);
	VAR adr, vmem: LONGINT; regs: V86.Regs; vali: INTEGER; valc: CHAR;
	BEGIN
		Kernel.NewDMA(256, adr, vmem);	(* allocate DMA buffer *)
		ASSERT(vmem MOD 16 = 0);  ASSERT(vmem < 100000H);	(* sanity *)
		ASSERT(adr = vmem);	(* implementation restriction *)
		
		regs.EAX := 4F01H; regs.ECX := p.modeNr;
		regs.ES := SHORT(vmem DIV 16); regs.EDI := 0;
		V86.Video(regs);
		
		SYSTEM.GET(vmem, vali); p.modeAttr := SYSTEM.VAL(SET, vali);
		SYSTEM.GET(vmem+2, valc); p.winAAttr := SYSTEM.VAL(SET, valc);
		SYSTEM.GET(vmem+3, valc); p.winBAttr := SYSTEM.VAL(SET, valc);
		SYSTEM.GET(vmem+4, vali); p.winGranularity := vali;
		SYSTEM.GET(vmem+6, vali); p.winSize := vali;
		SYSTEM.GET(vmem+8, vali); p.winASeg := vali;
		SYSTEM.GET(vmem+10, vali); p.winBSeg := vali;
		SYSTEM.GET(vmem+12, p.winFuncPtr);
		SYSTEM.GET(vmem+16, vali); p.bytesPerScanLine := vali;
		SYSTEM.GET(vmem+18, vali); p.xRes := vali;
		SYSTEM.GET(vmem+20, vali); p.yRes := vali;
		SYSTEM.GET(vmem+22, valc); p.xCharSize := ORD(valc);
		SYSTEM.GET(vmem+23, valc); p.yCharSize := ORD(valc);
		SYSTEM.GET(vmem+24, valc); p.nrOfPlanes := ORD(valc);
		SYSTEM.GET(vmem+25, valc); p.bitsPerPixel := ORD(valc);
		SYSTEM.GET(vmem+26, valc); p.nrOfBanks := ORD(valc);
		SYSTEM.GET(vmem+27, valc); p.memoryModel := ORD(valc);
		SYSTEM.GET(vmem+28, valc); p.bankSize := ORD(valc);
		SYSTEM.GET(vmem+29, valc); p.nrOfImgPages := ORD(valc);
		SYSTEM.GET(vmem+31, valc); p.redMaskSize := ORD(valc);
		SYSTEM.GET(vmem+32, valc); p.redFieldPos := ORD(valc);
		SYSTEM.GET(vmem+33, valc); p.greenMaskSize := ORD(valc);
		SYSTEM.GET(vmem+34, valc); p.greenFieldPos := ORD(valc);
		SYSTEM.GET(vmem+35, valc); p.blueMaskSize := ORD(valc);
		SYSTEM.GET(vmem+36, valc); p.blueFieldPos := ORD(valc);
		SYSTEM.GET(vmem+37, valc); p.rsvdMaskSize := ORD(valc);
		SYSTEM.GET(vmem+38, valc); p.rsvdFieldPos := ORD(valc);
		SYSTEM.GET(vmem+39, valc); p.directColorModeInfo := SYSTEM.VAL(SET, valc);
		SYSTEM.GET(vmem+40, p.physBasePtr);
		SYSTEM.GET(vmem+50, vali); p.linBytesPerScanLine := vali;
		SYSTEM.GET(vmem+52, valc); p.bnkNrOfImgPages := ORD(valc);
		SYSTEM.GET(vmem+53, valc); p.linNrOfImgPages := ORD(valc);
		SYSTEM.GET(vmem+54, valc); p.linRedMaskSize := ORD(valc);
		SYSTEM.GET(vmem+55, valc); p.linRedFieldPos := ORD(valc);
		SYSTEM.GET(vmem+56, valc); p.linGreenMaskSize := ORD(valc);
		SYSTEM.GET(vmem+57, valc); p.linGreenFieldPos := ORD(valc);
		SYSTEM.GET(vmem+58, valc); p.linBlueMaskSize := ORD(valc);
		SYSTEM.GET(vmem+59, valc); p.linBlueFieldPos := ORD(valc);
		SYSTEM.GET(vmem+60, valc); p.linRsvdMaskSize := ORD(valc);
		SYSTEM.GET(vmem+61, valc); p.linRsvdFieldPos := ORD(valc);
		SYSTEM.GET(vmem+62, p.maxPixelClock);
		
		Kernel.DisposeDMA(256, vmem);	(* deallocate DMA buffer *)
	END GetModeInfo;
	
	PROCEDURE GetVideoModes(adr: LONGINT; VAR vmode: VideoMode);
	VAR adr0: LONGINT; adr1, vali: INTEGER; p: VideoMode;
	BEGIN
		SYSTEM.GET(adr+2, adr1); adr0 := LONG(adr1) * 16;
		SYSTEM.GET(adr, adr1); adr0 := adr0+adr1;
		LOOP
			SYSTEM.GET(adr0, vali);
			IF vali = -1 THEN EXIT END;
			NEW(p); p.next := vmode; vmode := p;
			p.modeNr := vali;
			GetModeInfo(p);
			INC(adr0, 2)
		END
	END GetVideoModes;

	PROCEDURE GetVBEControllerInfo;
	VAR adr, vmem: LONGINT; regs: V86.Regs; vali: INTEGER; vals: SET;
	BEGIN
		vbe.vmodes := NIL;
		
		Kernel.NewDMA(512, adr, vmem);	(* allocate DMA buffer *)
		ASSERT(vmem MOD 16 = 0);  ASSERT(vmem < 100000H);	(* sanity *)
		ASSERT(adr = vmem);	(* implementation restriction *)
		
		SYSTEM.MOVE(SYSTEM.ADR("VBE2"), vmem, 4);
		regs.EAX := 4F00H; regs.ES := SHORT(vmem DIV 16); regs.EDI := 0;
		V86.Video(regs);
		
		vbe.available := regs.EAX = 4FH;
		IF vbe.available THEN
			SYSTEM.MOVE(vmem, SYSTEM.ADR(vbe.sig), 4); vbe.sig[4] := 0X;
			SYSTEM.GET(vmem+4, vali); vbe.version := vali;
			CopyVBEString(vmem+6, vbe.oemString);
			SYSTEM.GET(vmem+10, vals);
			vbe.dac8 := 0 IN vals; vbe.vga := ~(1 IN vals); vbe.extDac := 2 IN vals;
			vbe.stereo := 3 IN vals; vbe.stereoEVC := 4 IN vals;
			GetVideoModes(vmem+14, vbe.vmodes);
			SYSTEM.GET(vmem+18, vali); vbe.totalMem := LONG(vali)*64*1024;
			SYSTEM.GET(vmem+20, vali); vbe.oemSoftwareRev := vali;
			CopyVBEString(vmem+22, vbe.oemVendor);
			CopyVBEString(vmem+26, vbe.oemProductName);
			CopyVBEString(vmem+30, vbe.oemProductRev)
		END;
		Kernel.DisposeDMA(512, vmem);	(* deallocate DMA buffer *)
	END GetVBEControllerInfo;
	
	PROCEDURE GetVideoBios;
	BEGIN
		GetVBEControllerInfo
	END GetVideoBios;

	PROCEDURE InitGtf;
	BEGIN
		GC.margin := 1.8; GC.cellGran := 8; GC.minPorch := 1; GC.vSyncRqd := 3;
		GC.hSync := 8; GC.minVSyncBP := 550; GC.m := 600; GC.c := 40; GC.k := 128; GC.j := 20
	END InitGtf;
	
	PROCEDURE Init;
	BEGIN
(*		IF textsDebug THEN
			NEW(T);  Texts.Open(T, "");
			Oberon.OpenText("", T, 400, 200);
			Texts.OpenWriter(W)
		END; *)
		InitGtf;
		GetVideoBios
	END Init;
	
(*	PROCEDURE DoSearch*;
	VAR w, h, d, modeNr: LONGINT;
	BEGIN
		In.Open; In.LongInt(w); In.LongInt(h); In.LongInt(d);
		IF In.Done THEN
			modeNr := SearchVideoMode(w, h, d);
			LogStr("Mode Nr: "); LogHex(modeNr); LogLn
		END
	END DoSearch;
	
	PROCEDURE DoGetCurrentVideoMode*;
	VAR modeNr: LONGINT;
	BEGIN
		modeNr := GetCurrentVideoMode();
		LogStr("Mode Nr: "); LogHex(modeNr); LogLn
	END DoGetCurrentVideoMode;
	
	PROCEDURE DoSetVideoMode*;
	VAR modeNr, res, w, h, d, vFreq: LONGINT;
	BEGIN
		In.Open; In.LongInt(w); In.LongInt(h); In.LongInt(d); In.LongInt(vFreq);
		IF In.Done THEN
			modeNr := SearchVideoMode(w, h, d); ASSERT(modeNr # 0, 100);
			SetVideoMode(modeNr, vFreq, FALSE, TRUE, res); ASSERT(res = 0, 101)
		END
	END DoSetVideoMode; *)
	
BEGIN
	Init
END DisplayTool.


DisplayTool.ShowVesaInfo
DisplayTool.DoSearch 1024 768 32
DisplayTool.DoGetCurrentVideoMode
DisplayTool.DoSetVideoMode 1024 768 32 105
DisplayTool.DoSetVideoMode 1024 768 32 100
DisplayTool.DoSetVideoMode 1600 1200 16 74
DisplayTool.DoSetVideoMode 1600 1200 16 60


华夏公益教科书