Oberon/ETH Oberon/2.3.7/DisplayLinear.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 DisplayLinear;	(* pjm *) (* Linear framebuffer display driver for Aos. Refresh rate setting taken from Peter Ryser's Native Oberon VESA driver. Config strings: 	Display="Displays."	Generic Oberon display driver 	DDriver="DisplayLinear"	This driver 	DMem=?	Display memory size in bytes (optional) 	DMode=105H	Vesa mode (only depths 8, 16 (565), 24 and 32 supported) 	DRefresh=?	Vertical refresh rate in Hz (VESA >= 3.0 only) 		or 	DWidth=1024	Display width 	DHeight=768	Display height 	DDepth=16	Display depth 	Init=?	Init program The Init program is a 8086 machine code program in hexadecimal.  It has to initialize the specified display mode, possibly by making display BIOS calls, and leave the 32-bit physical address of the frame buffer in DX:CX. *) IMPORT SYSTEM, Kernel, Files, MathL, V86, Displays, CLUTs; CONST PalFile = "Displays.Pal";	(* physical palette for 8-bit modes - if missing, use default direct mapping *) 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 display: Display; TYPE Display = OBJECT (Displays.Display) VAR clut: POINTER TO CLUTs.CLUT; PROCEDURE ColorToIndex*(col: LONGINT): LONGINT; BEGIN IF (format = Displays.index8) & (clut # NIL) THEN IF 30 IN SYSTEM.VAL(SET, col) THEN	(* invert *) col := CLUTs.Match(clut^, col); IF col # 0 THEN RETURN col ELSE RETURN 15 END ELSE RETURN CLUTs.Match(clut^, col) END ELSE RETURN ColorToIndex^(col) END END ColorToIndex; PROCEDURE IndexToColor*(index: LONGINT): LONGINT; VAR col: LONGINT; BEGIN IF (format = Displays.index8) & (clut # NIL) THEN CLUTs.Get(clut^, index, col); RETURN col MOD 1000000H ELSE RETURN IndexToColor^(index) END END IndexToColor; END Display; (* StrToInt - Convert a string to an integer. *) PROCEDURE StrToInt(VAR i: LONGINT; VAR s: ARRAY OF CHAR): LONGINT; VAR vd, vh, sgn, d: LONGINT; hex: BOOLEAN; BEGIN vd := 0; vh := 0;  hex := FALSE; IF s[i] = "-" THEN sgn := -1; INC(i) ELSE sgn := 1 END; LOOP IF (s[i] >= "0") & (s[i] <= "9") THEN d := ORD(s[i])-ORD("0") ELSIF (CAP(s[i]) >= "A") & (CAP(s[i]) <= "F") THEN d := ORD(CAP(s[i]))-ORD("A")+10; hex := TRUE ELSE EXIT END; vd := 10*vd + d; vh := 16*vh + d; 		INC(i) END; IF CAP(s[i]) = "H" THEN hex := TRUE; INC(i) END;	(* optional H *) IF hex THEN vd := vh END; RETURN sgn * vd END StrToInt; PROCEDURE GetVal(name: ARRAY OF CHAR; default: LONGINT): LONGINT; VAR v: LONGINT; s: ARRAY 12 OF CHAR;  p: LONGINT; BEGIN Kernel.GetConfig(name, s); IF s[0] = 0X THEN v := default ELSE p := 0; v := StrToInt(p, s) 	END; RETURN v END GetVal; PROCEDURE Install*; BEGIN IF display # NIL THEN Displays.main := display END END Install; PROCEDURE InitPalette(d: Display); CONST N = 256; VAR i, col: LONGINT; f: Files.File; r: Files.Rider; ch: CHAR; BEGIN f := Files.Old(PalFile); IF f # NIL THEN NEW(d.clut); Files.Set(r, f, 0); CLUTs.Read(r, d.clut^, N); CLUTs.Init(d.clut^, N, 6) ELSE d.clut := NIL END; SYSTEM.PORTIN(3DAH, ch); SYSTEM.PORTOUT(3C0H, 11X); SYSTEM.PORTOUT(3C0H, 0X);	(* palette entry 0 is black *) SYSTEM.PORTOUT(3C0H, 20X); FOR i := 0 TO 255 DO 		col := d.IndexToColor(i); SYSTEM.PORTOUT(3C8H, CHR(i)); SYSTEM.PORTOUT(3C9H, CHR(ASH(col, -16) MOD 100H DIV 4)); SYSTEM.PORTOUT(3C9H, CHR(ASH(col, -8) MOD 100H DIV 4)); SYSTEM.PORTOUT(3C9H, CHR(col MOD 100H DIV 4)) END END InitPalette; 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); VAR GC: GTFConstants; 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; 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; (* Calculate 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. 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 *) 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; PROCEDURE SetVesaMode(mode, hz: LONGINT; VAR w, h, d, adr: LONGINT); VAR width, height, ver: INTEGER; flags: SET; bpp: SHORTINT; reg: V86.Regs; t: GTFTimings; BEGIN V86.Init; ASSERT(V86.bufsize >= 512);	(* enough for VESA *) SYSTEM.MOVE(SYSTEM.ADR("VBE2"), V86.bufadr, 4); reg.EAX := 4F00H;	(* get VESA info *) reg.ES := V86.bufadr DIV 16; reg.EDI := V86.bufadr MOD 16; V86.Video(reg); ASSERT(reg.EAX MOD 10000H = 4FH, 100);	(* vesa call ok *) SYSTEM.GET(V86.bufadr+4, ver);	(* version *) SYSTEM.MOVE(SYSTEM.ADR("VBE2"), V86.bufadr, 4); reg.EAX := 4F01H;	(* get mode info *) reg.ECX := mode; reg.ES := V86.bufadr DIV 16; reg.EDI := V86.bufadr MOD 16; V86.Video(reg); ASSERT(reg.EAX MOD 10000H = 4FH, 101);	(* vesa call ok *) SYSTEM.GET(V86.bufadr+12H, width); SYSTEM.GET(V86.bufadr+14H, height); SYSTEM.GET(V86.bufadr+19H, bpp); SYSTEM.GET(V86.bufadr+28H, adr); IF bpp = 15 THEN bpp := 16 END;	(* 15bpp not really supported currently *) w := width; h := height; d := bpp; ASSERT((adr # 0) & (adr MOD 4096 = 0), 102);	(* frame buffer address ok *) IF (ver >= 300H) & (hz > 0) THEN GTFCalcTimings(w, h, hz, GTFLockVF, FALSE, FALSE, t); reg.EAX := 4F0BH; reg.EBX := 0; reg.EDX := mode; reg.ECX := hz * t.h.hTotal * t.v.vTotal; V86.Video(reg); ASSERT(reg.EAX MOD 10000H = 4FH, 104);	(* vesa call ok *) SYSTEM.PUT(V86.bufadr, SYSTEM.VAL(INTEGER, t.h.hTotal)); SYSTEM.PUT(V86.bufadr+2, SYSTEM.VAL(INTEGER, t.h.hSyncStart)); SYSTEM.PUT(V86.bufadr+4, SYSTEM.VAL(INTEGER, t.h.hSyncEnd)); SYSTEM.PUT(V86.bufadr+6, SYSTEM.VAL(INTEGER, t.v.vTotal)); SYSTEM.PUT(V86.bufadr+8, SYSTEM.VAL(INTEGER, t.v.vSyncStart)); SYSTEM.PUT(V86.bufadr+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(V86.bufadr+12, SYSTEM.VAL(CHAR, flags)); SYSTEM.PUT(V86.bufadr+13, reg.ECX); SYSTEM.PUT(V86.bufadr+17, SYSTEM.VAL(INTEGER, SHORT(hz*100))); reg.EBX := 800H ELSE reg.EBX := 0 END; reg.EAX := 4F02H; 	(* set mode *) reg.EBX := reg.EBX + mode + 4000H;	(* enable linear fb *) reg.ES := V86.bufadr DIV 16; reg.EDI := V86.bufadr MOD 16; V86.Video(reg); ASSERT(reg.EAX MOD 10000H = 4FH, 103);	(* vesa call ok *) Kernel.traceConsole := FALSE; V86.Cleanup END SetVesaMode; PROCEDURE Init; VAR w, h, d, f, mem, adr, vmode: LONGINT; BEGIN vmode := GetVal("DMode", 0); IF vmode # 0 THEN	(* attempt V86 call to VESA BIOS *) SetVesaMode(vmode, GetVal("DRefresh", 0), w, h, d, adr) ELSE	(* assume mode was set with Init= *) w := GetVal("DWidth", 1024); h := GetVal("DHeight", 768); d := GetVal("DDepth", 16); Kernel.GetInit(1, adr);	(* DX:CX from Init code *) ASSERT((adr # 0) & (adr MOD 4096 = 0)) END; CASE d DIV 8 OF 		1: f := Displays.index8 |2: f := Displays.color565 |3: f := Displays.color888 |4: f := Displays.color8888 END; mem := GetVal("DMem", 0)*1024; IF mem = 0 THEN mem := w*h*f END; Kernel.MapPhysical(adr, mem + (-mem) MOD 4096, adr); NEW(display); display.width := w; display.height := h; 	display.offscreen := mem DIV (w*f) - h; 	display.format := f; display.unit := 10000; IF f = Displays.index8 THEN InitPalette(display) END; display.InitFrameBuffer(adr, mem) END Init; BEGIN Init; Install END DisplayLinear.