program CGALoRes; (*--------------------------------------------------------------------------*) (* *) (* This low resolution graphics mode provides resolution *) (* of 160 horizontal by 100 vertical pixels in 16 colors. *) (* This mode is not directly supported by the IBM PC BIOS, *) (* special programming of the CRT registers is required. *) (* The PCjr has a similar 160x200 standard graph mode. *) (* *) (* This new version incorporates the ability to write *) (* alphanumeric text using both the low and high ascii *) (* character maps that are standard in the rom of an IBM *) (* PCjr. The PC does not have the high set in rom and it *) (* must either be hard-coded or read from disk. I created *) (* both disk files ( LO_ASCII.FNT and HI_ASCII.FNT ) by *) (* copying them from the rom of an IBM PCjr. Procedures to *) (* blank the screen and disable blink were also included. *) (* *) (* The plot and draw routines are originally by Philip Burns *) (* ( see PC SIG Turbo Disk No. 7 (#427) for PIBLORES.PAS ) *) (* and the CRT controller re-programming comes from an article *) (* (using Basic) by Bernie Lawrence in PC WORLD (Apr 1985). *) (* Philip asked for a routine to do text - here it is. *) (* I took some liberties in rewriting and shortening the *) (* previous programs. This new program will run on a PCjr. *) (* It will run on a CGA, but not an EGA which does not use a *) (* 6845 CRT controller chip. This is not a very portable routine. *) (* *) (* With the Color Graphics Adapter Donald L. Pavia *) (* a satisfactory solution to the Dept. of Chemistry - WWU *) (* the problem of snow remains to be Bellingham, WA. 98225 *) (* solved. I used a 2nd graphics January 1986 *) (* page here to avoid the problem. *) (* Snow is no problem on the PCjr. *) (*--------------------------------------------------------------------------*) const ColorSeg = $B800; ColorOfs = $0000; ModeReg = $3D8; ColorReg = $3D9; { control registers } ModeSave = $465; ColorSave = $466; { BIOS saves registers here } CRTReg = $3D4; CRTData = $3D5; { 6845 CRT controller registers } RetraceReg = $3DA; PCjrVGA = $3DA; { vertical retrace register } { video gate array for PCjr } HiResMode = 1; VideoMode = 8; { lores is form of 80x25 text } OffSet = 0; RegData : array[0..11] of integer { 6845 register data } = ( 113, (* Horizontal total *) 80, (* Horizontal displayed *) 90, (* Horizontal sync position *) 10, (* Horizontal sync width *) 127, (* Vertical total *) 6, (* Vertical adjust *) 100, (* Vertical displayed *) 112, (* Vertical sync position *) 2, (* Non-interlace mode *) 1, (* Maximum scan line address *) 32, (* Disable cursor display *) 0 ); (* Cursor end *) type str20 = string[20]; ScreenType = array[0..16383] of byte; ScreenPointer = ^ScreenType; ScreenFile = file of ScreenType; var Register,Mode,Current : integer; i,PixCol,Color,X,Y,T : integer; ColorScreen : ScreenType absolute $B800:$0000; ScreenBuffer : ScreenType; LoFonts,HiFonts : array[1..1024] of byte; { in an IBM you could have } CRTStatus : byte; Wait : char; { an absolute address for } Screen : ScreenPointer; { LoFonts, rather than } { loading it from disk } {----------------------------------------------------------------------------} procedure SaveScreen (FileName : str20); var FileToSave : ScreenFile; begin Screen := ptr (ColorSeg,ColorOfs); assign (FileToSave,FileName); rewrite (FileToSave); write (FileToSave,Screen^); close (FileToSave); end; {----------------------------------------------------------------------------} procedure LoadScreen (FileName : str20); var DisplayFile : ScreenFile; begin Screen := ptr (ColorSeg,Offset); assign (DisplayFile,FileName); reset (DisplayFile); read (DisplayFile,Screen^); close (DisplayFile); end; {----------------------------------------------------------------------------} procedure AwaitVRetrace; { to eliminate snow on CGA } begin repeat CRTStatus := Port[RetraceReg]; until ((CRTStatus and 8) = 0); while ((CRTStatus and 8) = 0) do CRTStatus := Port[RetraceReg]; end; {----------------------------------------------------------------------------} procedure BlankScreen; { turn off CRT } begin MemW[CSeg : ModeSave] := Mode; Port[ModeReg] := Mode and $F7; end; {----------------------------------------------------------------------------} procedure RestoreScreen; { turn on CRT } begin MemW[CSeg : ModeSave] := Mode; Port[ModeReg] := Mode or $08; end; {----------------------------------------------------------------------------} procedure ClrLoResScreen; (* byte = { **B* ***F } *) (* sum of *'s = 222 *) begin FillChar (ColorScreen ,16383,0); for i := 0 to 7999 do ColorScreen[2*i] := 222; end; {----------------------------------------------------------------------------} procedure ClrLoResBuff; { clear the screen buffer } begin FillChar (ScreenBuffer,16383,0); for i := 0 to 7999 do ScreenBuffer[2*i] := 222; end; {----------------------------------------------------------------------------} procedure Show; { transfer to screen in bursts to prevent snow } { 50 x 320 + 384 = 16384 might be safer than } var i,k : integer; { the currently used 40 x 400 + 384 combo } begin if mem[$F000:$FFFE] = $FD then move (ScreenBuffer,ColorScreen,16383) else begin k := 0; for i := 1 to 40 do begin AwaitVRetrace; move (ScreenBuffer[k],ColorScreen[k],400); k := k + 400; end; AwaitVRetrace; move (ScreenBuffer[k],ColorScreen[k],384); end; end; {----------------------------------------------------------------------------} procedure DisableBlink; { the earlier version did NOT have 16 colors } { the blink bit must be disabled for that. } { Enable it again to see the difference. } begin if mem[$F000:$FFFE] = $FD then { PCjr } begin Port[PCjrVGA] := 3; Port[PCjrVGA] := 0; end else begin { PC } Current := mem[$0000:$465]; Port[$03D8] := Current and $DF; end; end; {----------------------------------------------------------------------------} procedure LoResGraphMode; { set lores graphics mode } begin Mode := HiResMode + VideoMode; MemW[CSeg : ModeSave] := Mode; Port[ModeReg] := Mode; for Register := 0 TO 11 do { reprogram 6845 for lores } begin Port[CrtReg] := Register; Port[CrtData] := RegData[Register]; end; DisableBlink; BlankScreen; { to prevent display of garbage } ClrLoResScreen; RestoreScreen; end; { LoResGraphMode } {----------------------------------------------------------------------------} procedure LoResPlot (X,Y,PixCol : integer); { plots to hidden screen } { to avoid snow } { Plots point in low-resolution graphics mode } { X -- Horizontal postion (0 through 159) } { Y -- Vertical position (0 through 119) } { PixCol -- Color (0 through 15) of point } { calls outside range are ignored } var Pixel,PixelAddr,Nibble : integer; Legal: boolean; begin Legal := (x >= 0) and (x <= 159) and (y >= 0) and (y <= 119) and (PixCol >= 0) and (PixCol <= 15); if Legal then begin Pixel := X + ( Y * 160 ); PixelAddr := ( Pixel and $FFFE ) + 1; Nibble := Pixel mod 2; { AwaitVRetrace; } { works great, but really slows output ! } { to see, remove SHOW's in main program } { and change ScreenBuffer to ColorScreen } { in this procedure } if Nibble = 0 then ScreenBuffer[PixelAddr] := ( ScreenBuffer[PixelAddr] and $0F ) + PixCol * 16 else ScreenBuffer[PixelAddr] := ( ScreenBuffer[PixelAddr] and $F0 ) + PixCol; end; end; { LoResPlot } {----------------------------------------------------------------------------} procedure LoResDraw (X1,Y1,X2,Y2,LineCol : integer); var X,Y,Xinc,Yinc,CorrecInc : integer; Dx,Cdx,Dy,Cdy : integer; Plotit: boolean; begin X := X1; Y := Y1; { starting point } Dx := X2 - X1; Dy := Y2 - Y1; { changes in (x,y) directions } { set increments } if Dx > 0 then Xinc := 1 else begin Xinc := -1; Dx := -Dx; end; if Dy > 0 then Yinc := 1 else begin Yinc := -1; Dy := -Dy; end; { CorrecInc is correction value } if Dy > Dx then CorrecInc := Dy else CorrecInc := Dx; Cdx := CorrecInc; Cdy := CorrecInc; LoResPlot( X, Y, LineCol ); { plot first point } while ( (X <> X2) and (Y <> Y2)) do { plot remaining points } begin PlotIt := false; Cdx := Cdx - Dx; if Cdx < 0 then begin PlotIt := true; X := X + Xinc; Cdx := Cdx + CorrecInc; end; Cdy := Cdy - Dy; if Cdy < 0 then begin PlotIt := true; Y := Y + Yinc; Cdy := Cdy + CorrecInc; end; if PlotIt then LoResPlot( X, Y, LineCol ); end; end; { LoResDraw } {----------------------------------------------------------------------------} function BitSet (InByte : byte; WhichBit : integer) : boolean; begin if ((InByte div WhichBit) mod 2) = 1 then BitSet := true else BitSet := false; end; {----------------------------------------------------------------------------} procedure LoResChar (CharNum,x,y,color : integer); var Index,i,xx,yy : integer; InByte : byte; begin if CharNum < 128 then Index := (CharNum * 8) else Index := ((CharNum - 128) * 8); xx := x - 8; yy := y - 8; for i := 1 to 8 do begin if CharNum < 128 then InByte := LoFonts[Index+i] else InByte := HiFonts[Index+i]; if BitSet (InByte,128) then LoResPlot (xx+1,yy+i,Color); if BitSet (InByte, 64) then LoResPlot (xx+2,yy+i,Color); if BitSet (InByte, 32) then LoResPlot (xx+3,yy+i,Color); if BitSet (InByte, 16) then LoResPlot (xx+4,yy+i,Color); if BitSet (InByte, 8) then LoResPlot (xx+5,yy+i,Color); if BitSet (InByte, 4) then LoResPlot (xx+6,yy+i,Color); if BitSet (InByte, 2) then LoResPlot (xx+7,yy+i,Color); if BitSet (InByte, 1) then LoResPlot (xx+8,yy+i,Color); end; end; {----------------------------------------------------------------------------} procedure LoResString (DisplayString : str20; col,row,color : integer); var i,x,y,AsciiNum : integer; Valid : boolean; begin Valid := (col >= 1) and (col <= 20) and (row >= 1) and (row <= 12); if Valid then begin x := (8 * col) ; y := (8 * row) ; for i := 1 to length(DisplayString) do begin AsciiNum := ord(DisplayString[i]); LoResChar (AsciiNum,x,y,color); x := x + 8; end; end; end; {----------------------------------------------------------------------------} procedure LoadFonts; { these files have to be on the disk ! } { or you can read then from rom if you } var FontFile : file; { have a PCjr. Only the first one is } { in rom in a PC. } begin assign (FontFile,'LO_ASCII.FNT'); reset (FontFile); { you could have an absolute } BlockRead (FontFile,LoFonts,8); { address for LoFonts if you } close (FontFile); { if you have an IBM } assign (FontFile,'HI_ASCII.FNT'); reset (FontFile); BlockRead (FontFile,HiFonts,8); close (FontFile); end; (*--------------------------------------------------------------------------*) (* NewLoRes --- Main Program *) (*--------------------------------------------------------------------------*) BEGIN (* program NewLoRes *) ClrScr; LoadFonts; gotoxy (5,5); write ('Press the key now to see 160x100 LoRes Graphics '); gotoxy (5,7); write ('Then press it again after each display.'); gotoxy (5,9); write ('After pressing there will be about a 10 sec wait '); gotoxy (5,10); write ('while I set up. '); read (Kbd,Wait); LoResGraphMode; ClrLoResBuff; LoResDraw (0,0,100,100,5); for i := 0 to 159 do LoResPlot (i,0,6); for i := 0 to 99 do LoResPlot (159,i,2); for i := 0 to 99 do LoResPlot (0,i,3); for i := 0 to 159 do LoResPlot (i,99,4); SHOW; for i := 0 to 7 do LoResString ('16 Colors',i+3,i+1,i); SHOW; LoResString ('NEW',1,5,12); LoResString ('VIDEO',1,6,11); LoResString ('MODE',1,7,14); LoResString ('LOW RES',1,8,9); LoResString ('16 COLOR',1,9,10); LoResString ('GRAPHICS',1,10,15); LoResString ('160x100',1,11,13); Delay (1500); SHOW; LoResString ('D.Pavia',3,12,8); LoResString ('Jan 86',14,1,8); LoResString (#240+#241+#242+#243+#244+#245+#246+#247,12,10,3); LoResString (#224+#225+#226+#227+#228+#229,14,12,1); Delay (2500); SHOW; read (Kbd,Wait); BlankScreen; SaveScreen ('LORES.PIC'); RestoreScreen; GraphMode; TextMode (c80); clrscr; gotoxy (5,5); write ('This is TextMode (80x25). But I Saved Your Screen in Memory.'); gotoxy (5,8); write ('Press to See It.. '); read (Kbd,Wait); LoResGraphMode; SHOW; read (Kbd,Wait); GraphMode; TextMode (c80); clrscr; gotoxy (5,5); write ('While You are Reading This I am Preparing a New Screen. '); write ('Wait Please. '); ClrLoResBuff; for i := 1 to 7 do LoResString ('This is New !',i,i+1,i); gotoxy (5,8); write ('READY ...... '); read (Kbd,Wait); LoResGraphMode; SHOW; read (Kbd,Wait); GraphMode; TextMode (c80); clrscr; gotoxy (5,5); write ('I also Saved Your Screen on Disk !!!'); gotoxy (5,8); write ('Press to See ... '); read (Kbd,Wait); LoResGraphMode; BlankScreen; LoadScreen ('LORES.PIC'); RestoreScreen; read (Kbd,Wait); GraphMode; TextMode( C80 ); clrscr; gotoxy (15,10); write ('Thank You for Watching the Show !!!'); gotoxy (40,14); write ('Donald L. Pavia'); gotoxy (40,15); write ('January 20, 1986'); gotoxy (30,24); write ('Press to Quit '); read (Kbd,Wait); GraphMode; TextMode (c80); clrscr; { exit gracefully, restore 6845 } END. (* program CGALoRes *)