home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
VGADOC4B.ZIP
/
TABLE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-09-29
|
6KB
|
239 lines
{$i VGADECL.INC}
const
coltxt:array[1..max_mode] of string[4]=('TXT','TXT2','TXT4','HRC','CGA1'
,'CGA2','PL1','PL1E','PL2','PK2','PL4','PK4','PK4a','PK4b','P8','P15','P16'
,'P24','P24b','P32','P32b','P32c','P32d');
const
colbits:array[1..max_mode] of integer= {Bits of data per pixel}
(0,0,0,1,1,1,1,2,2,2,4,4,4,4,8,15,16,24,24,24,24,24,24);
usebits:array[1..max_mode] of integer= {Bits used per pixel}
(0,0,0,1,1,1,1,2,2,2,4,4,4,4,8,16,16,24,24,32,32,32,32);
modecols:array[1..max_mode] of longint=
(0,0,0,2,2,2,2,4,4,4,16,16,16,16,256,32768,65536
,16777216,16777216,16777216,16777216,16777216,16777216);
type
modetype=record
md,xres,yres,bytes:word;
memmode:byte;
end;
regblk=record
base:word;
nbr:word;
x:array[0..255] of byte;
end;
regtype=record
chip:byte;
mmode:byte;
mode,pixels,lins,bytes,tridold0d,tridold0e:word;
attregs:array[0..31] of byte;
seqregs,grcregs,crtcregs,xxregs:regblk;
stdregs:array[$3c0..$3df] of byte;
xgaregs:array[0..15] of byte;
dacregs:array[0..16] of byte;
dacinxd:regblk;
end;
var
f:file of regtype;
fo:text;
s:string;
xxs,ix,off:word;
mxcrtc,mxseq,mxattr,mxgrf,mxxtra,xtraix:word;
xx:array[1..40] of regtype;
const hx:array[0..15] of char='0123456789ABCDEF';
function hex2(w:word):string;
begin
hex2:=hx[(w shr 4) and 15]+hx[w and 15];
end;
function hex4(w:word):string;
begin
hex4:=hx[w shr 12]+hx[hi(w) and 15]+hx[(w shr 4) and 15]+hx[w and 15];
end;
function gtbyte(var s:string):word;
var i,j:word;
begin
while copy(s,1,1)=' ' do delete(s,1,1);
i:=(ord(s[1])-48) and 31;if i>9 then dec(i,7);
j:=(ord(s[2])-48) and 31;if j>9 then dec(j,7);
delete(s,1,2);
gtbyte:=i*16+j;
end;
function gtword(var s:string):word;
var i,j:word;
begin
i:=gtbyte(s);
j:=gtbyte(s);
gtword:=i*256+j;
end;
function gtval(var s:string):longint;
var x,z:word;
y:longint;
begin
x:=pos(': ',s);
delete(s,1,x+1);
x:=pos(' ',s);if x=0 then x:=length(s)+1;
val(copy(s,1,x-1),y,z);
delete(s,1,x);
gtval:=y;
end;
var
parms:word;
parm:array[1..256] of word;
parmsame:boolean;
parmstr:string;
procedure setstr(s:string);
begin
parms:=0;
parmstr:=s;
parmsame:=true;
end;
procedure adds(w:word);
begin
inc(parms);
parm[parms]:=w;
if parm[1]<>w then parmsame:=false;
end;
function getstr:string;
var x:word;
begin
if parmsame then parms:=1;
for x:=1 to parms do
parmstr:=parmstr+' '+hex4(parm[x]);
getstr:=parmstr;
end;
var x,y:word;
l:longint;
dacix,mxdaci:word;
begin
assign(f,'register.vga');
reset(f);
xxs:=0;ix:=0;off:=0;xtraix:=0;dacix:=0;mxdaci:=0;
mxcrtc:=0;mxattr:=31;mxseq:=0;mxgrf:=0;mxxtra:=0;
fillchar(xx,sizeof(xx),0);
while not eof(f) do
begin
inc(xxs);
read(f,xx[xxs]);
if xx[xxs].seqregs.nbr>mxseq then mxseq:=xx[xxs].seqregs.nbr;
if xx[xxs].grcregs.nbr>mxgrf then mxgrf:=xx[xxs].grcregs.nbr;
if xx[xxs].crtcregs.nbr>mxcrtc then mxcrtc:=xx[xxs].crtcregs.nbr;
if xx[xxs].xxregs.base<>0 then
begin
xtraix:=xx[xxs].xxregs.base;
if xx[xxs].xxregs.nbr>mxxtra then mxxtra:=xx[xxs].xxregs.nbr;
end;
if xx[xxs].dacinxd.base<>0 then
begin
dacix:=xx[xxs].dacinxd.base;
if xx[xxs].dacinxd.nbr>mxdaci then mxdaci:=xx[xxs].dacinxd.nbr;
end;
end;
close(f);
assign(fo,'register.tbl');
rewrite(fo);
write(fo,'Mode: ');
for y:=1 to xxs do write(fo,hex4(xx[y].mode):5);
writeln(fo);
write(fo,'Pixels: ');
for y:=1 to xxs do write(fo,xx[y].pixels:5);
writeln(fo);
write(fo,'Lines: ');
for y:=1 to xxs do write(fo,xx[y].lins:5);
writeln(fo);
write(fo,'Bytes: ');
for y:=1 to xxs do write(fo,xx[y].bytes:5);
writeln(fo);
write(fo,'Colors: ');
for y:=1 to xxs do write(fo,coltxt[xx[y].mmode]:5);
writeln(fo);
setstr('3CCh :');
for y:=1 to xxs do adds(xx[y].stdregs[$3CC]);
writeln(fo,getstr);
if xx[1].chip=__Trid then
begin
setstr('SEQ_0D :');
for y:=1 to xxs do adds(xx[y].tridold0D);
writeln(fo,getstr);
setstr('SEQ_0E :');
for y:=1 to xxs do adds(xx[y].tridold0E);
writeln(fo,getstr);
end;
for x:=0 to mxattr do
begin
setstr('ATTR '+hex2(x)+':');
for y:=1 to xxs do adds(xx[y].attregs[x]);
writeln(fo,getstr);
end;
for x:=0 to mxSEQ do
begin
setstr('SEQ '+hex2(x)+': ');
for y:=1 to xxs do adds(xx[y].seqregs.x[x]);
writeln(fo,getstr);
end;
for x:=0 to mxgrf do
begin
setstr('GRF '+hex2(x)+': ');
for y:=1 to xxs do adds(xx[y].grcregs.x[x]);
writeln(fo,getstr);
end;
for x:=0 to mxcrtc do
begin
setstr('CRTC '+hex2(x)+':');
for y:=1 to xxs do adds(xx[y].crtcregs.x[x]);
writeln(fo,getstr);
end;
if xtraix<>0 then
for x:=0 to mxxtra do
begin
setstr(hex4(xtraix)+' '+hex2(x)+':');
for y:=1 to xxs do adds(xx[y].xxregs.x[x]);
writeln(fo,getstr);
end;
for x:=0 to 16 do
begin
setstr('DAC '+hex2(x)+':');
for y:=1 to xxs do adds(xx[y].dacregs[x]);
writeln(fo,getstr);
end;
if dacix<>0 then
for x:=0 to mxdaci do
begin
setstr('DACi '+hex2(x)+':');
for y:=1 to xxs do adds(xx[y].dacinxd.x[x]);
writeln(fo,getstr);
end;
close(fo);
end.