Category : Files from Magazines
Archive   : N7V11.ZIP
Filename : EGA_GRPH.PAS

PROGRAM EGA_GRAPHICS;{ primitives for fast color graphics in TURBO PASCAL. }

TYPE
RegPack = RECORD
AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer
END;
VAR
RegPak : RegPack;
{ Next 4 arrays avoid repetitive calculations }
Xaddr : ARRAY[0..639] OF Byte;
Yaddr : ARRAY[0..349] OF Integer;
Point : ARRAY[0..639] OF Byte;
HiPoint : ARRAY[0..649] OF Integer;
I, J, Color, Left : Integer;
dummy : Char;

PROCEDURE Init_graphics(BackGround : Integer);
{Sets up graphics hardware and arrays to avoid repetitive calculations.}
VAR
indx : Integer;
BEGIN
PortW[$03CE] := $1803; { Use XOR for writing to graphics memory
$1603 for OR. }
{ For Color machines let RegPak.AX:= $0010, Mono = $000F }
RegPak.AX := $0010;
Intr($10, RegPak);
FOR indx := 0 TO 349 DO Yaddr[indx] := 27920-80*indx;
{ Subtracting from 27920 makes origin at the lower left corner. }
FOR indx := 0 TO 639 DO Xaddr[indx] := indx DIV 8;
FOR indx := 0 TO 639 DO
BEGIN
Point[indx] := $80 SHR(indx MOD 8);
HiPoint[indx] := Swap(Point[indx])+8;
END;
GraphBackground(BackGround); { Standard TUBRO works fine here }
END;

PROCEDURE Plot(x, y : Integer);
VAR
total, junk : Integer;
BEGIN
total := Xaddr[x]+Yaddr[y]; { Find sequential address }
PortW[$03CE] := HiPoint[x]; { Protect bits in mask }
Junk := Mem[$A000:Total]; { Latch bit planes by reading }
Mem[$A000:total] := point[x]; { Light up pixel }
END;

PROCEDURE PixelColor(Color : Integer);
BEGIN
PortW[$03CE] := $FF01; { Enable set/reset }
PortW[$03CE] := Swap(Color); { Set color of Pixel}
END;

PROCEDURE WriteAgain(BackGround, ForeGround : Integer);
{ Reloads 8x14 font }
BEGIN
RegPak.AX := $1101;
RegPak.BX := $0002;
Intr($10, RegPak);
{ Set new background and foreground colors }
GraphBackground(BackGround);
TextColor(ForeGround);
END;

BEGIN
Init_Graphics(Green); Left := 0;
FOR Color := Black TO White DO
BEGIN
PixelColor(Color);
FOR I := 1 TO 20 DO
BEGIN
Left := Left+1;
FOR J := 0 TO 30 DO Plot(Left, J);
END;
END;
WriteAgain(Green, White);
Write('After color graphics calls you must ');
WriteLn('reload font with Procedure WriteAgain.');
WriteLn('Otherwise standard Write and WriteLn does not work.');
WriteLn;
WriteLn('Strike any key to do color graphics again.'); Read(Kbd, dummy);
WriteLn;
FOR J := 1 TO 30 DO
BEGIN
PixelColor(Random(16));
FOR I := 0 TO 349 DO Plot(J+I, I);
PixelColor(Random(16));
FOR I := 0 TO 349 DO Plot(Abs(380-I-J), I);
END;
WriteAgain(Blue, Yellow);
WriteLn('Reload font again with WriteAgain before WriteLn.'); WriteLn;
WriteLn('Strike any key to exit.');
Read(Kbd, dummy);
TextMode(C80);
END.