Demonstration of Low-Res in CGA (Turbo Pascal 3 program)

[CP/M User]

Heres a little program I translated from a BASIC program in Turbo Pascal
3, so it works for DOS & CP/M-86! Since the original was written a
while ago I've also added support, so it works for later video cards (well
VGA & SVGA as far as I know). However, the effect looks even more
impressive on a CGA card. Since the file uses another file called
READKEY.LIB I have added that below this.

Cheers.

-----CGA130.PAS -----

Program CGA130;
(* Inspired from BASIC 130Color by Lary McMillin
Derived from LOWRES.BAS By PC World, April 1985
Translated to Turbo Pascal 3.x by CP/M User 2002 *)

{$I READKEY.LIB}

Const
HiRes = 1;
Video = 8;
ModeReg = $3D8;
ModeSave = $465;
CRTReg = $3D4;
ColorREG = $3D9;
ColorSave = $466;
CrtData = $3d5;
Order : Array[0..15] of Byte =
(0,8,1,9,3,11,2,10,6,14,4,12,5,13,7,15);
Choice : Array[1..19] of Byte =
(1,16,24,17,2,10,39,119,133,89,68,128,81,
87,126,58,4,19,20);
Reg6845 : Array[0..11] of Byte =
(113,80,90,10,127,6,100,112,2,1,32,0);
RegVGA : Array[0..11] of Byte =
(113,80,90,10,127,6,100,112,2,3,32,0);
Colour : Array[0..1,0..135] of Byte =
((0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,
4,4,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,6,6,6,6,6,6,6,
6,6,6,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8,8,9,9,9,9,9,9,9,10,
10,10,10,10,10,11,11,11,11,11,12,12,12,12,13,13,13,14,14,15),
(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,1,2,3,4,5,6,7,8,9,10,
11,12,13,14,15,2,3,4,5,6,7,8,9,10,11,12,13,14,15,3,4,5,6,7,
8,9,10,11,12,13,14,15,4,5,6,7,8,9,10,11,12,13,14,15,5,6,7,8,
9,10,11,12,13,14,15,6,7,8,9,10,11,12,13,14,15,7,8,9,10,11,12,
13,14,15,8,9,10,11,12,13,14,15,9,10,11,12,13,14,15,10,11,12,
13,14,15,11,12,13,14,15,12,13,14,15,13,14,15,14,15,15));

Var
BG, FG : Integer;
Mode : Integer;
AmICGA : Boolean;

Procedure SetupCGA;

Var Count1 : Byte;
Begin
Mode:=0;
Mem[$0000:Modesave]:=mode;
Port[modereg]:=mode;
Mem[$0000:ColorSave]:=0;
Port[ColorReg]:=0;
Count1:=0;
Repeat
Port[CRTReg]:=Count1;
IF AmICGA = True then
Port[CrtData]:=Reg6845[Count1]
Else
Port[CrtData]:=RegVGA[Count1];
Count1:=Count1+1;
Until Count1=11;
End; {SetupCGA}

Procedure Mode80;

Begin
Mode:=HiRes+Video;
Mem[$0000:ModeSave]:=Mode;
Port[ModeReg]:=Mode;
End; {Mode80}

Procedure ClearCGA;

Var ClearmyCGA : Integer;
Begin
ClearMyCGA:=0;
Repeat
mem[$b800:ClearMyCGA]:=$B1;
mem[$b800:ClearMyCGA+1]:=$00;
ClearMyCga:=ClearMyCGA+2;
Until ClearMyCGA=16000;
end; {ClearCGA}

Procedure PixCol(X, Y : Byte);

Var Pixel,
PixelAddr : Integer;
Begin
Pixel:=2*X+(Y*160);
PixelAddr:=(Pixel and $fffe)+1;
Mem[$B800ixelAddr]:=BG*16+FG;
End;

Procedure DrawMatrix;

Var J,I,X,Y : Integer {Byte};
Begin
For I:=1 to 31 do
Begin
For J:=1 to 63 Do
Begin
{X:=I;
Y:=J;}
BG:=Order[I Div 2 Mod 16];
FG:=Order[J Div 4 Mod 16];
X:=I;
Y:=J;
PixCol(X,Y);
End;
End;
End; {DrawMatrix}

Procedure DrawLines;

Var X,Y,I,Pick : Integer;
Begin
I:=0;
Repeat
Pick:=Choice[1+(I Div 1 Mod 19)];
BG:=Colour[0,Pick];
FG:=Colour[1,Pick];
X:=40+I Mod 19;
Y:=I;
PixCol(X,Y);
I:=I+1;
Until I=75;
End; {DrawLines}

Procedure BlinkBitDisable;

Var Regs:Registers;
Begin
With Regs Do
Begin
AX:=$1003;
BL:=$00;
BH:=$00;
Intr($10,Regs);
End;
End;

Procedure BlinkBitEnable;

Var Regs:Registers;
Begin
With Regs Do
Begin
AX:=$1003;
BL:=$01;
BH:=$00;
INTR($10,Regs);
End;
End;

Procedure SetText;

Var Regs:Registers;
Begin
Regs.AX:=$0003;
Intr($10,Regs);
End;

Procedure CheckForCGA;
Var
Regs : Registers;
Begin
With Regs do
begin
AH := $1A;
AL := 0;
end;
intr($10, Regs);
if Regs.AL <> $1A THEN
AmICGA:=TRUE
else
AmICGA:=FALSE;
END;

{Procedure SetScanlines;

Var
Regs : Registers;
Begin
With Regs Do
Begin
AX:=$1200;
BL:=$30;
Intr($10,Regs);
End;
End;}

var Dummy : Char;

Begin
CheckForCGA;
SetText;
Gotoxy(1,1);
Writeln('130 Color Demonstration');
GotoXY(1,5);
Writeln('Any Key To Enter');
Dummy:=ReadKey;
SetText;
IF AmICGA=FALSE Then BlinkBitDisable;
SetUpCGA;
Mode80;
ClearCGA;
DrawMatrix;
DrawLines;
Dummy:=ReadKey;
IF AmICGA=FALSE Then BlinkBitEnable;
SetText;
End. {Main}

---- End of CGA130.PAS ----

---- READKEY.LIB ----

CONST PendingKey : BYTE = 0;

TYPE Registers = Record
CASE Integer Of
1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer);
2 : (AL,AH,BL,BH,CL,CH,DL,DH : Byte);
END;

FUNCTION ReadKey : Char;
VAR Regs : Registers;
BEGIN
IF PendingKey<>0 THEN BEGIN
ReadKey:=CHR(PendingKey);
PendingKey:=0;
END
ELSE BEGIN
Regs.AH:=0;
INTR($16,Regs);
IF Regs.AL=0 THEN PendingKey:=Regs.AH;
ReadKey:=CHR(Regs.AL);
END;
END;

---- End of ReadKey.LIB ----

 

[CP/M User]

Re: Demonstration of Low-Res in CGA (Turbo Pascal 3 program)

"CP/M User" wrote in message:

> Heres a little program I translated from a BASIC program
> in Turbo Pascal 3, so it works for DOS & CP/M-86!
> Since the original was written a while ago I've also added s
> upport, so it works for later video cards (well VGA & SVGA as far
> as I know). However, the effect looks even more
> impressive on a CGA card. Since the file uses another file
> called READKEY.LIB I have added that below this.

I'll just stress out that I've recieved word from another
source that this program does not work on EGA card, or
could even be damaging to it. So in that event I wouldn't
recommend using this program with it. I just hope that
no-one has found out the hard way! :-(

Sorry.

P.S. Still it's an interesting program if you have a CGA or
VGA/SVGA card!

Cheers.

 

[norayr]

very interesting to try it.
Tell me please, need I egavga.bgi file to run this program???
I'll try ti try it as soon as possible

 

[CP/M User]

"norayr" wrote in message:

> very interesting to try it.
> Tell me please, need I egavga.bgi file to run this program???

No you won't need that '.bgi' file.

The story about this program was I tranlated it from GWBASIC
to TP 3, with the intention of porting it to CP/M-86 (which I did).
This is one great example where the use of an array has sped
things up from the original GWBASIC program.

> I'll try to try it as soon as possible

Think I did try it in TP 5.5, but some modifications will need to
be done in order for it to work with 'uses crt,dos' quite possibly.

There's actually some improvement I need to do for this program
because I was told it can be quite damaging for EGA users. I also
got an assembly program which changes the VGA/SVGA screen
font to the standard 8x8 which CGA used, if you test this program
you will see some full lines just before the colours seperate
themselves. Due to time constraints & working on other problems
this is less of a priority for myself.

Just note though, that this isn't some fancy demo which has an
appearling effect. What it does do, it go into the CGA low-res
mode (160x100) which the IBM BIOS never supported & draws
a table of colours (16 colours it supported) & shades those
colours to make the effect look more colourful (130 colours).
The effect looks better at the moment on CGA because it looks
slightly more natural.

Maybe one day I can use this program to create an effect using
a proper image & using shading. But at the moment, I'm just
leaving it at that (well until I can get some time to improve that
character set).

Cheers,
CP/M User.