home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / VGADOC4B.ZIP / TABLE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-09-29  |  6KB  |  239 lines

  1. {$i VGADECL.INC}
  2.  
  3. const
  4.  
  5.   coltxt:array[1..max_mode] of string[4]=('TXT','TXT2','TXT4','HRC','CGA1'
  6.        ,'CGA2','PL1','PL1E','PL2','PK2','PL4','PK4','PK4a','PK4b','P8','P15','P16'
  7.        ,'P24','P24b','P32','P32b','P32c','P32d');
  8.  
  9.  
  10.  
  11.  
  12. const
  13.   colbits:array[1..max_mode] of integer=   {Bits of data per pixel}
  14.                (0,0,0,1,1,1,1,2,2,2,4,4,4,4,8,15,16,24,24,24,24,24,24);
  15.   usebits:array[1..max_mode] of integer=   {Bits used per pixel}
  16.                (0,0,0,1,1,1,1,2,2,2,4,4,4,4,8,16,16,24,24,32,32,32,32);
  17.   modecols:array[1..max_mode] of longint=
  18.                (0,0,0,2,2,2,2,4,4,4,16,16,16,16,256,32768,65536
  19.                ,16777216,16777216,16777216,16777216,16777216,16777216);
  20.  
  21.  
  22.  
  23. type
  24.   modetype=record
  25.              md,xres,yres,bytes:word;
  26.              memmode:byte;
  27.            end;
  28.  
  29.   regblk=record
  30.            base:word;
  31.            nbr:word;
  32.            x:array[0..255] of byte;
  33.          end;
  34.  
  35.   regtype=record
  36.             chip:byte;
  37.             mmode:byte;
  38.             mode,pixels,lins,bytes,tridold0d,tridold0e:word;
  39.             attregs:array[0..31] of byte;
  40.             seqregs,grcregs,crtcregs,xxregs:regblk;
  41.             stdregs:array[$3c0..$3df] of byte;
  42.             xgaregs:array[0..15] of byte;
  43.             dacregs:array[0..16] of byte;
  44.             dacinxd:regblk;
  45.           end;
  46.  
  47.  
  48.  
  49. var
  50.   f:file of regtype;
  51.   fo:text;
  52.   s:string;
  53.  
  54.   xxs,ix,off:word;
  55.   mxcrtc,mxseq,mxattr,mxgrf,mxxtra,xtraix:word;
  56.   xx:array[1..40] of regtype;
  57.  
  58. const hx:array[0..15] of char='0123456789ABCDEF';
  59.  
  60. function hex2(w:word):string;
  61. begin
  62.   hex2:=hx[(w shr 4) and 15]+hx[w and 15];
  63. end;
  64.  
  65. function hex4(w:word):string;
  66. begin
  67.   hex4:=hx[w shr 12]+hx[hi(w) and 15]+hx[(w shr 4) and 15]+hx[w and 15];
  68. end;
  69.  
  70. function gtbyte(var s:string):word;
  71. var i,j:word;
  72. begin
  73.   while copy(s,1,1)=' ' do delete(s,1,1);
  74.   i:=(ord(s[1])-48) and 31;if i>9 then dec(i,7);
  75.   j:=(ord(s[2])-48) and 31;if j>9 then dec(j,7);
  76.   delete(s,1,2);
  77.   gtbyte:=i*16+j;
  78. end;
  79.  
  80. function gtword(var s:string):word;
  81. var i,j:word;
  82. begin
  83.   i:=gtbyte(s);
  84.   j:=gtbyte(s);
  85.   gtword:=i*256+j;
  86. end;
  87.  
  88. function gtval(var s:string):longint;
  89. var x,z:word;
  90.   y:longint;
  91. begin
  92.   x:=pos(': ',s);
  93.   delete(s,1,x+1);
  94.   x:=pos(' ',s);if x=0 then x:=length(s)+1;
  95.   val(copy(s,1,x-1),y,z);
  96.   delete(s,1,x);
  97.   gtval:=y;
  98. end;
  99.  
  100.  
  101. var
  102.   parms:word;
  103.   parm:array[1..256] of word;
  104.   parmsame:boolean;
  105.   parmstr:string;
  106.  
  107. procedure setstr(s:string);
  108. begin
  109.   parms:=0;
  110.   parmstr:=s;
  111.   parmsame:=true;
  112. end;
  113.  
  114. procedure adds(w:word);
  115. begin
  116.   inc(parms);
  117.   parm[parms]:=w;
  118.   if parm[1]<>w then parmsame:=false;
  119. end;
  120.  
  121. function getstr:string;
  122. var x:word;
  123. begin
  124.   if parmsame then parms:=1;
  125.   for x:=1 to parms do
  126.     parmstr:=parmstr+' '+hex4(parm[x]);
  127.   getstr:=parmstr;
  128. end;
  129.  
  130.  
  131. var x,y:word;
  132.     l:longint;
  133.  
  134.     dacix,mxdaci:word;
  135. begin
  136.   assign(f,'register.vga');
  137.   reset(f);
  138.   xxs:=0;ix:=0;off:=0;xtraix:=0;dacix:=0;mxdaci:=0;
  139.   mxcrtc:=0;mxattr:=31;mxseq:=0;mxgrf:=0;mxxtra:=0;
  140.   fillchar(xx,sizeof(xx),0);
  141.   while not eof(f) do
  142.   begin
  143.     inc(xxs);
  144.     read(f,xx[xxs]);
  145.     if xx[xxs].seqregs.nbr>mxseq then mxseq:=xx[xxs].seqregs.nbr;
  146.     if xx[xxs].grcregs.nbr>mxgrf then mxgrf:=xx[xxs].grcregs.nbr;
  147.     if xx[xxs].crtcregs.nbr>mxcrtc then mxcrtc:=xx[xxs].crtcregs.nbr;
  148.     if xx[xxs].xxregs.base<>0 then
  149.     begin
  150.       xtraix:=xx[xxs].xxregs.base;
  151.       if xx[xxs].xxregs.nbr>mxxtra then mxxtra:=xx[xxs].xxregs.nbr;
  152.     end;
  153.     if xx[xxs].dacinxd.base<>0 then
  154.     begin
  155.       dacix:=xx[xxs].dacinxd.base;
  156.       if xx[xxs].dacinxd.nbr>mxdaci then mxdaci:=xx[xxs].dacinxd.nbr;
  157.     end;
  158.   end;
  159.   close(f);
  160.  
  161.   assign(fo,'register.tbl');
  162.   rewrite(fo);
  163.   write(fo,'Mode:   ');
  164.   for y:=1 to xxs do write(fo,hex4(xx[y].mode):5);
  165.   writeln(fo);
  166.   write(fo,'Pixels: ');
  167.   for y:=1 to xxs do write(fo,xx[y].pixels:5);
  168.   writeln(fo);
  169.   write(fo,'Lines:  ');
  170.   for y:=1 to xxs do write(fo,xx[y].lins:5);
  171.   writeln(fo);
  172.   write(fo,'Bytes:  ');
  173.   for y:=1 to xxs do write(fo,xx[y].bytes:5);
  174.   writeln(fo);
  175.   write(fo,'Colors: ');
  176.   for y:=1 to xxs do write(fo,coltxt[xx[y].mmode]:5);
  177.   writeln(fo);
  178.   setstr('3CCh   :');
  179.   for y:=1 to xxs do adds(xx[y].stdregs[$3CC]);
  180.   writeln(fo,getstr);
  181.  
  182.   if xx[1].chip=__Trid then
  183.   begin
  184.     setstr('SEQ_0D :');
  185.     for y:=1 to xxs do adds(xx[y].tridold0D);
  186.     writeln(fo,getstr);
  187.     setstr('SEQ_0E :');
  188.     for y:=1 to xxs do adds(xx[y].tridold0E);
  189.     writeln(fo,getstr);
  190.   end;
  191.  
  192.   for x:=0 to mxattr do
  193.   begin
  194.     setstr('ATTR '+hex2(x)+':');
  195.     for y:=1 to xxs do adds(xx[y].attregs[x]);
  196.     writeln(fo,getstr);
  197.   end;
  198.   for x:=0 to mxSEQ do
  199.   begin
  200.     setstr('SEQ '+hex2(x)+': ');
  201.     for y:=1 to xxs do adds(xx[y].seqregs.x[x]);
  202.     writeln(fo,getstr);
  203.   end;
  204.   for x:=0 to mxgrf do
  205.   begin
  206.     setstr('GRF '+hex2(x)+': ');
  207.     for y:=1 to xxs do adds(xx[y].grcregs.x[x]);
  208.     writeln(fo,getstr);
  209.   end;
  210.   for x:=0 to mxcrtc do
  211.   begin
  212.     setstr('CRTC '+hex2(x)+':');
  213.     for y:=1 to xxs do adds(xx[y].crtcregs.x[x]);
  214.     writeln(fo,getstr);
  215.   end;
  216.   if xtraix<>0 then
  217.     for x:=0 to mxxtra do
  218.     begin
  219.       setstr(hex4(xtraix)+' '+hex2(x)+':');
  220.       for y:=1 to xxs do adds(xx[y].xxregs.x[x]);
  221.       writeln(fo,getstr);
  222.     end;
  223.   for x:=0 to 16 do
  224.   begin
  225.     setstr('DAC  '+hex2(x)+':');
  226.     for y:=1 to xxs do adds(xx[y].dacregs[x]);
  227.     writeln(fo,getstr);
  228.   end;
  229.   if dacix<>0 then
  230.     for x:=0 to mxdaci do
  231.     begin
  232.       setstr('DACi '+hex2(x)+':');
  233.       for y:=1 to xxs do adds(xx[y].dacinxd.x[x]);
  234.       writeln(fo,getstr);
  235.     end;
  236.   close(fo);
  237. end.
  238.  
  239.