2962 lines
74 KiB
ObjectPascal
2962 lines
74 KiB
ObjectPascal
|
|
uses dos,crt,supervga,idvga;
|
|
|
|
const
|
|
copyright=' 29/Sep/95 Copyright 1991-95 Finn Thoegersen';
|
|
|
|
SWversion = 2000; {1495 = 1.49e, 1500 = 1.50, 2000 = 2.00}
|
|
|
|
menuchars:array[1..55] of char=
|
|
'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!@#$%^&()[]{}-_=+/?';
|
|
|
|
beta_ver=true;
|
|
|
|
|
|
max_clk=17;
|
|
clkname:array[0..max_clk] of string[20]=('','Internal','4 Ext Clks'
|
|
,'8 Ext Clks','16 Ext Clks','32 Ext Clks','64 Ext Clks'
|
|
,'32 Ext Clks (Sigma)','ICD20c61','ICD20c61A','S3 SDAC','TVP302x'
|
|
,'ICS2595','SC11412','CH8391/8','STG1703','MUSIC','IBM RGB52x');
|
|
|
|
|
|
|
|
var
|
|
af_fil:file;
|
|
af_buf:array[0..2048] of byte;
|
|
af_pos:word;
|
|
af_rec:_AT2;
|
|
af_cmt:string;
|
|
af_tst:_AT3;
|
|
af_fail:boolean;
|
|
af_filename:string[12];
|
|
|
|
{Displays the copyright & version info}
|
|
function wrVersionNbr:string;
|
|
var s:string;
|
|
begin
|
|
str(SWVersion div 1000,s);
|
|
s:=s+'.'+chr((SWversion div 100) mod 10+48)+chr((SWversion div 10) mod 10+48);
|
|
if (SWversion mod 10)>0 then s:=s+chr(SWversion mod 10+$60);
|
|
if (beta_ver) then s:=s+' (BETA)';
|
|
wrVersionNbr:='WHATVGA v. '+s;
|
|
end;
|
|
|
|
function freq(frq:longint):string;
|
|
var w:word;
|
|
st:string[5];
|
|
begin
|
|
w:=frq mod 1000;
|
|
str(frq div 1000:3,st);
|
|
freq:=st+'.'+chr((w div 100)+48)+chr(((w div 10) mod 10)+48)+chr((w mod 10)+48);
|
|
end;
|
|
|
|
{Appends a datablock to the AF buffer}
|
|
procedure AddAFbuf(var b;bytes:word);
|
|
begin
|
|
move(b,af_buf[af_pos],bytes);
|
|
inc(af_pos,bytes);
|
|
end;
|
|
|
|
{Writes an AF record to the AF file}
|
|
procedure WrAFbuf(typ:byte);
|
|
begin
|
|
af_buf[0]:=typ;
|
|
move(af_pos,af_buf[1],2);
|
|
blockwrite(af_fil,af_buf,af_pos);
|
|
close(af_fil);
|
|
reset(af_fil,1); {Flushes file output}
|
|
seek(af_fil,filesize(af_fil));
|
|
af_pos:=3;
|
|
end;
|
|
|
|
function Rtext(str:string;wid:integer):string;
|
|
begin
|
|
while str[length(str)]=' ' do dec(str[0]);
|
|
Rtext:=copy(' ',1,wid-length(str))+str;
|
|
end;
|
|
|
|
function getComment(tx:string):string;
|
|
var s,s1:string;
|
|
begin
|
|
writeln('Please enter '+tx+' (max 3 lines):');
|
|
s:='';s1:='';
|
|
readln(s1);
|
|
s1:=strip(s1);
|
|
if s1<>'' then
|
|
begin
|
|
s:=s1;
|
|
readln(s1);s1:=strip(s1);
|
|
if s1<>'' then
|
|
begin
|
|
s:=s+' '+s1;
|
|
readln(s1);s1:=strip(s1);
|
|
if s1<>'' then
|
|
begin
|
|
s:=s+' '+s1;
|
|
writeln;
|
|
end;
|
|
end;
|
|
end;
|
|
getComment:=s;
|
|
end;
|
|
|
|
function getYN:boolean;
|
|
const YN:array[0..1] of string[3]=('No','Yes');
|
|
var ret:integer;
|
|
begin
|
|
ret:=-1;
|
|
repeat
|
|
case getkey of
|
|
ord('y'),ord('Y'):ret:=1;
|
|
ord('n'),ord('N'):ret:=0;
|
|
ch_esc:ret:=0;
|
|
end;
|
|
until ret>-1;
|
|
getYn:=boolean(ret);
|
|
writeln(YN[ret]);
|
|
if ret=0 then af_fail:=true;
|
|
end;
|
|
|
|
|
|
procedure InitAFFile(cursel:word);
|
|
var x:word;
|
|
hdr:_AT0;
|
|
mm:byte;
|
|
begin
|
|
x:=0;
|
|
repeat
|
|
inc(x); {Find first free file number}
|
|
af_filename:='WHVGA'+istr(x)+'.TST';
|
|
assign(af_fil,af_filename);
|
|
{$i-}
|
|
reset(af_fil,1);
|
|
{$i+}
|
|
if ioresult=0 then close(af_fil) else x:=0;
|
|
until x=0;
|
|
rewrite(af_fil,1);
|
|
af_pos:=3;
|
|
af_fail:=false;
|
|
|
|
hdr.SWvers := SWversion;
|
|
hdr.vid_sys:= Vids;
|
|
hdr.cur_vid:= cursel;
|
|
getFtime(af_fil,hdr.curtime);
|
|
AddAFbuf(hdr,sizeof(hdr));
|
|
|
|
af_cmt:=getComment('your Email address');
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
|
|
af_cmt:=getComment('your name & address');
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
af_cmt:=getComment('your video&monitor description');
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
af_cmt:=getComment('your system description');
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
|
|
af_cmt:='';
|
|
for mm:=_text to _p32d do {Build the Mode Name table}
|
|
af_cmt:=af_cmt+copy(mmodenames[mm]+' ',1,4);
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
|
|
for x:=1 to max_clk do
|
|
AddAFbuf(clkname[x],length(clkname[x])+1);
|
|
|
|
af_cmt:='';
|
|
AddAFbuf(af_cmt,1);
|
|
|
|
WrAFbuf(AF_header);
|
|
end;
|
|
|
|
|
|
function getmenkey:integer;
|
|
var x,c:word;
|
|
begin
|
|
c:=getkey;
|
|
if (c>=ord('a')) and (c<=ord('z')) then c:=c-32;
|
|
getmenkey:=0;
|
|
for x:=1 to 55 do
|
|
if chr(c)=menuchars[x] then getmenkey:=x;
|
|
if c=Ch_Esc then getmenkey:=-1;
|
|
end;
|
|
|
|
|
|
procedure clearmemory;
|
|
var x,y,maxbank:word;
|
|
begin
|
|
case memmode of
|
|
_text,_txt2,_txt4:
|
|
begin
|
|
{mov es,[vseg] cld xor di,di mov ax,$720 mov cx,$4000 rep stosw}
|
|
inline($8e/6/>vseg/$fc/$31/$ff/$B8/>$720/$B9/>$4000/$f3/$ab);
|
|
end;
|
|
_cga1,_cga2:
|
|
fillchar(mem[SegB800:0],$8000,0);
|
|
_pl2,_pl4:begin
|
|
wrinx(GRC,0,0);
|
|
wrinx(GRC,1,15); (* planar modes *)
|
|
wrinx(GRC,8,255);
|
|
modinx(GRC,5,3,0);
|
|
maxbank:=pred(cv.mm div 256);
|
|
end;
|
|
else maxbank:=pred(cv.mm div 64);
|
|
end;
|
|
if memmode>_cga2 then
|
|
for x:=0 to maxbank do
|
|
begin
|
|
setbank(x);
|
|
{mov es,[vseg] cld xor di,di xor ax,ax mov cx,$8000 rep stosw}
|
|
inline($8e/6/>vseg/$fc/$31/$ff/$31/$C0/$B9/>$8000/$f3/$ab);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure setpix(x,y:word;col:longint);
|
|
const
|
|
msk:array[0..7] of byte=(128,64,32,16,8,4,2,1);
|
|
plane :array[0..1] of byte=(5,10);
|
|
plane4:array[0..3] of byte=(1,2,4,8);
|
|
mscga4:array[0..3] of byte=($3f,$cf,$f3,$fc);
|
|
shcga4:array[0..3] of byte=(6,4,2,0);
|
|
var l:longint;
|
|
m,z:word;
|
|
begin
|
|
case memmode of
|
|
_cga1:begin
|
|
z:=(y shr 1)*bytes+(x shr 3);
|
|
if odd(y) then inc(z,8192);
|
|
mem[SegB800:z]:=(mem[SegB800:z] and (255 xor msk[x and 7]))
|
|
or ((col and 1) shl (7-(x and 7)));
|
|
end;
|
|
_cga2:begin
|
|
z:=(y shr 1)*bytes+(x shr 2);
|
|
if odd(y) then inc(z,8192);
|
|
mem[SegB800:z]:=(mem[SegB800:z] and mscga4[x and 3])
|
|
or (col and 3) shl shcga4[x and 3];
|
|
end;
|
|
_pl1:begin
|
|
l:=y*bytes+(x shr 3);
|
|
wrinx(GRC,3,0);
|
|
wrinx(GRC,5,2);
|
|
wrinx(SEQ,2,1);
|
|
wrinx(GRC,8,msk[x and 7]);
|
|
setbank(l shr 16);
|
|
z:=mem[vseg:word(l)];
|
|
mem[vseg:word(l)]:=col;
|
|
end;
|
|
_pl1e:begin
|
|
l:=y*bytes+(x shr 3);
|
|
modinx(GRC,5,3,0);
|
|
wrinx(SEQ,2,15);
|
|
wrinx(GRC,0,col*3);
|
|
wrinx(GRC,1,3);
|
|
wrinx(GRC,8,msk[x and 7]);
|
|
z:=mem[vseg:word(l)];
|
|
mem[vseg:word(l)]:=0;
|
|
end;
|
|
_pl2:begin
|
|
l:=y*bytes+(x shr 4);
|
|
wrinx(GRC,3,0);
|
|
wrinx(GRC,5,2);
|
|
wrinx(SEQ,2,plane[(x shr 3) and 1]);
|
|
wrinx(GRC,8,msk[x and 7]);
|
|
setbank(l shr 16);
|
|
z:=mem[vseg:word(l)];
|
|
mem[vseg:word(l)]:=col;
|
|
end;
|
|
_pk2:begin
|
|
l:=y*bytes+(x shr 2);
|
|
setbank(l shr 16);
|
|
z:=mem[vseg:word(l)] and mscga4[x and 3];
|
|
mem[vseg:word(l)]:=z or (col shl shcga4[x and 3]);
|
|
end;
|
|
_pl4:begin
|
|
l:=y*bytes+(x shr 3);
|
|
wrinx(GRC,3,0);
|
|
wrinx(GRC,5,2);
|
|
wrinx(GRC,8,msk[x and 7]);
|
|
setbank(l shr 16);
|
|
z:=mem[vseg:word(l)];
|
|
mem[vseg:word(l)]:=col;
|
|
end;
|
|
_pk4:begin
|
|
l:=y*bytes+(x shr 1);
|
|
setbank(l shr 16);
|
|
z:=mem[vseg:word(l)];
|
|
if odd(x) then z:=z and $f0+col
|
|
else z:=z and $f+(col shl 4);
|
|
mem[vseg:word(l)]:=z;
|
|
end;
|
|
_pk4a:begin
|
|
l:=y*bytes+(x shr 1);
|
|
setbank(l shr 16);
|
|
z:=mem[vseg:word(l)];
|
|
if odd(x) then z:=z and $f+(col shl 4)
|
|
else z:=z and $f0+col;
|
|
mem[vseg:word(l)]:=z;
|
|
end;
|
|
_pk4b:begin
|
|
case x and 6 of
|
|
2:inc(x,2);
|
|
4:dec(x,2);
|
|
end;
|
|
l:=y*bytes+(x shr 1);
|
|
setbank(l shr 16);
|
|
z:=mem[vseg:word(l)];
|
|
if odd(x) then z:=z and $f+(col shl 4)
|
|
else z:=z and $f0+col;
|
|
mem[vseg:word(l)]:=z;
|
|
end;
|
|
_p8:begin
|
|
l:=y*bytes+x;
|
|
setbank(l shr 16);
|
|
mem[vseg:word(l)]:=col;
|
|
end;
|
|
_p15,_p16:
|
|
begin
|
|
l:=y*bytes+(x shl 1);
|
|
setbank(l shr 16);
|
|
memw[vseg:word(l)]:=col;
|
|
end;
|
|
_p24,_p24b:
|
|
begin
|
|
l:=y*bytes+(x*3);
|
|
z:=word(l);
|
|
m:=l shr 16;
|
|
setbank(m);
|
|
if z<$fffe then move(col,mem[vseg:z],3)
|
|
else begin
|
|
mem[vseg:z]:=lo(col);
|
|
if z=$ffff then setbank(m+1);
|
|
mem[vseg:z+1]:=lo(col shr 8);
|
|
if z=$fffe then setbank(m+1);
|
|
mem[vseg:z+2]:=col shr 16;
|
|
end;
|
|
end;
|
|
_p32,_p32b,_p32c,_p32d:
|
|
begin
|
|
l:=y*bytes+(x shl 2);
|
|
setbank(l shr 16);
|
|
meml[vseg:word(l)]:=col;
|
|
end;
|
|
else ;
|
|
end;
|
|
end;
|
|
|
|
function whitecol:longint;
|
|
var col:longint;
|
|
begin
|
|
case memmode of
|
|
_cga1,_pl1e,
|
|
_pl1:col:=1;
|
|
_cga2,_pk2
|
|
,_pl2:col:=3;
|
|
_pk4,_pl4,_PK4a,_pk4b:
|
|
col:=15;
|
|
_p8:col:=255;
|
|
_p15:col:=$7fff;
|
|
_p16:col:=$ffff;
|
|
_p24,_p24b,_p32,_p32b:
|
|
col:=$ffffff;
|
|
_p32c,_p32d:col:=$ffffff00;
|
|
else
|
|
end;
|
|
whitecol:=col;
|
|
end;
|
|
|
|
|
|
procedure wrtext(x,y:word;txt:string); {write TXT to pos (X,Y)}
|
|
type
|
|
pchar=array[char] of array[0..15] of byte;
|
|
var
|
|
p:^pchar;
|
|
c:char;
|
|
i,j,z,b,lns:integer;
|
|
ad,bk:word;
|
|
l,v,col:longint;
|
|
begin
|
|
lns:=15; {Assume full height chars}
|
|
ad:=(cv.mm*longint(1024)) div bytes;
|
|
if y+14>ad then lns:=ad-y; {Check if we're past the bottom}
|
|
rp.bh:=6;
|
|
vio($1130);
|
|
col:=whitecol;
|
|
p:=ptr(rp.es,rp.bp);
|
|
for z:=1 to length(txt) do
|
|
begin
|
|
c:=txt[z];
|
|
for j:=0 to lns do
|
|
begin
|
|
b:=p^[c][j];
|
|
for i:=0 to 7 do
|
|
begin
|
|
if (b and 128)<>0 then v:=col else v:=0;
|
|
setpix(x+i,y+j,v);
|
|
b:=b shl 1;
|
|
end;
|
|
end;
|
|
inc(x,8);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure plotchar(x,y,ch:word);
|
|
begin
|
|
mem[vseg:(y*pixels+x) shl 1]:=ch;
|
|
end;
|
|
|
|
procedure plotchat(x,y,ch,at:word);
|
|
begin
|
|
memw[vseg:(y*pixels+x) shl 1]:=at shl 8+ch;
|
|
end;
|
|
|
|
procedure plotstr(x,y:word;s:string);
|
|
var z:word;
|
|
begin
|
|
for z:=1 to length(s) do
|
|
plotchar(x+z-1,y,ord(s[z]));
|
|
end;
|
|
|
|
|
|
procedure drawtestpattern(nam:string);
|
|
{Draw Test pattern.}
|
|
var s:string;
|
|
l:longint;
|
|
x,y,yst:word;
|
|
white:longint;
|
|
|
|
procedure wline(stx,sty,ex,ey:integer;col:longint);
|
|
var x,y,d,mx,my:longint;
|
|
l:longint;
|
|
begin
|
|
if sty>ey then
|
|
begin
|
|
x:=stx;stx:=ex;ex:=x;
|
|
x:=sty;sty:=ey;ey:=x;
|
|
end;
|
|
y:=0;
|
|
mx:=abs(ex-stx);
|
|
my:=ey-sty;
|
|
d:=0;
|
|
repeat
|
|
if col=0 then l:=rgb(y,y,y) else l:=col;
|
|
y:=(y+1) and 255;
|
|
setpix(stx,sty,l);
|
|
if abs(d+mx)<abs(d-my) then
|
|
begin
|
|
inc(sty);
|
|
d:=d+mx;
|
|
end
|
|
else begin
|
|
d:=d-my;
|
|
if ex>stx then inc(stx)
|
|
else dec(stx);
|
|
end;
|
|
until (stx=ex) and (sty=ey);
|
|
|
|
end;
|
|
|
|
begin
|
|
if memmode<=_TXT4 then
|
|
begin
|
|
{Text modes}
|
|
|
|
{ ClearMemory; }
|
|
for x:=0 to pixels-1 do
|
|
begin
|
|
plotchar(x,0,(x mod 10)+ord('0'));
|
|
if (x mod 10)=0 then
|
|
plotchar(x,1,((x div 10) mod 10)+ord('0'));
|
|
plotchar(x,lins-1,ord('.'));
|
|
end;
|
|
for x:=0 to lins-1 do
|
|
begin
|
|
plotchar(0,x,(x mod 10)+ord('0'));
|
|
if (x mod 10)=0 then
|
|
plotstr(0,x,istr(x));
|
|
plotchar(pixels-1,x,ord('.'));
|
|
end;
|
|
plotstr(5,5,nam);
|
|
for x:=0 to 255 do
|
|
plotchat(x and 15+10,x shr 4+7,65,x);
|
|
plotstr((pixels-30) div 2,lins,'This line shouldn''t be seen!!');
|
|
end
|
|
else begin
|
|
|
|
white:=whitecol;
|
|
|
|
wline(50,30,pixels-50,30 ,0);
|
|
wline(50,lins-30,pixels-50,lins-30 ,0);
|
|
|
|
wline(50,30,50,lins-30 ,0);
|
|
wline(pixels-50,30,pixels-50,lins-30 ,0);
|
|
wline(50,30,pixels-50,lins-30 ,0);
|
|
|
|
wline(pixels-50,30,50,lins-30 ,0);
|
|
|
|
if lins>200 then yst:=50 else yst:=18;
|
|
wrtext(10,yst,cv.name+' with '+istr(cv.mm)+' Kb.');
|
|
wrtext(10,yst+25,nam);
|
|
|
|
for x:=1 to (pixels-10) div 100 do
|
|
begin
|
|
for y:=1 to 10 do
|
|
setpix(x*100,y,white);
|
|
wrtext(x*100+3,1,istr(x));
|
|
end;
|
|
|
|
for x:=1 to (lins-10) div 100 do
|
|
begin
|
|
for y:=1 to 10 do
|
|
setpix(y,x*100,white);
|
|
wrtext(1,x*100+2,istr(x));
|
|
end;
|
|
|
|
case colbits[memmode] of
|
|
2:for x:=0 to 63 do
|
|
for y:=0 to 63 do
|
|
setpix(30+x,yst+y+50,y shr 3);
|
|
4:for x:=0 to 127 do
|
|
if lins<250 then
|
|
for y:=0 to 63 do
|
|
setpix(30+x,yst+y+50,y shr 2)
|
|
else
|
|
for y:=0 to 127 do
|
|
setpix(30+x,yst+y+50,y shr 3);
|
|
8:for x:=0 to 127 do
|
|
if lins<250 then
|
|
for y:=0 to 63 do
|
|
setpix(30+x,yst+50+y,((y shl 2) and 240) +(x shr 3))
|
|
else
|
|
for y:=0 to 127 do
|
|
setpix(30+x,yst+50+y,((y shl 1) and 240)+(x shr 3));
|
|
|
|
15,16,24,32:if pixels<600 then
|
|
begin
|
|
for x:=0 to 63 do
|
|
begin
|
|
for y:=0 to 63 do
|
|
begin
|
|
setpix(30+x,100+y,rgb(x*4,y*4,0));
|
|
setpix(110+x,100+y,rgb(x*4,0,y*4));
|
|
setpix(190+x,100+y,rgb(0,x*4,y*4));
|
|
end;
|
|
end;
|
|
for x:=0 to 255 do
|
|
for y:=170 to 179 do
|
|
begin
|
|
setpix(x,y ,rgb(x,0,0));
|
|
setpix(x,y+10,rgb(0,x,0));
|
|
setpix(x,y+20,rgb(0,0,x));
|
|
end;
|
|
end
|
|
else begin
|
|
for x:=0 to 127 do
|
|
for y:=0 to 127 do
|
|
begin
|
|
setpix( 30+x,120+y,rgb(x*2,y*2,0));
|
|
setpix(200+x,120+y,rgb(x*2,0,y*2));
|
|
setpix(370+x,120+y,rgb(0,x*2,y*2));
|
|
end;
|
|
for x:=0 to 511 do
|
|
for y:=260 to 269 do
|
|
begin
|
|
setpix(x,y ,rgb(x shr 1,0,0));
|
|
setpix(x,y+10,rgb(0,x shr 1,0));
|
|
setpix(x,y+20,rgb(0,0,x shr 1));
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
wline(0,0,10, 0 ,whitecol);
|
|
wline(0,0, 0,10 ,whitecol);
|
|
wline(0,0,10,10 ,whitecol);
|
|
|
|
wline(pixels-11, 0,pixels-1, 0 ,whitecol);
|
|
wline(pixels-1 , 0,pixels-1,10 ,whitecol);
|
|
wline(pixels-11,10,pixels-1, 0 ,whitecol);
|
|
|
|
wline(0,lins-11, 0,lins-1 ,whitecol);
|
|
wline(0,lins-1 ,10,lins-1 ,whitecol);
|
|
wline(0,lins-1 ,10,lins-11 ,whitecol);
|
|
|
|
wline(pixels-11,lins-1 ,pixels-1,lins-1 ,whitecol);
|
|
wline(pixels-1 ,lins-11,pixels-1,lins-1 ,whitecol);
|
|
wline(pixels-11,lins-11,pixels-1,lins-1 ,whitecol);
|
|
end;
|
|
end;
|
|
|
|
(* Writes the string s to 1. line of the mono. screen *)
|
|
procedure wrmono(s:string);
|
|
var x:word;
|
|
begin
|
|
for x:=1 to length(s) do
|
|
mem[SegB000:x+x]:=ord(s[x]);
|
|
end;
|
|
|
|
(* Ensures that xlow<=x<=xhigh *)
|
|
procedure chkrange(var x:integer;xlow,xhigh:integer);
|
|
begin
|
|
if x<xlow then x:=xlow
|
|
else if x>xhigh then x:=xhigh;
|
|
end;
|
|
|
|
|
|
var
|
|
CurModeIndex:integer; {Index into the ModeTbl array for the current mode}
|
|
|
|
function testvmode:boolean;
|
|
const iltxt:array[boolean] of string[4]=('',' (i)');
|
|
var
|
|
s:string;
|
|
r13,sclins,scpixs,scbytes:word;
|
|
x0,y0,x,dlay:integer;
|
|
ch:word;
|
|
stop,scrollable,nxt:boolean;
|
|
|
|
begin
|
|
testvmode:=true;
|
|
s:='Mode: '+hex4(curmode)+'h: '+istr(pixels)+'x'+istr(lins)+' '+mmodenames[memmode];
|
|
drawtestpattern(s);
|
|
|
|
if auto_test then af_rec.flag:=AFF_testok; {Mode Supported}
|
|
|
|
scrollable:=false;
|
|
ch:=getkey;
|
|
if (ch<>Ch_Esc) and not (chr(ch) in ['D','F','d','f']) then
|
|
begin
|
|
if memmode>=_pl4 then
|
|
begin
|
|
scrollable:=true;
|
|
{ Scroll test }
|
|
sclins:=lins;
|
|
scpixs:=pixels;
|
|
scbytes:=bytes;
|
|
r13:=rdinx(crtc,$13);
|
|
if ((cv.flags and FLG_StdVGA)>0) and ((bytes*lins*planes*5 div 2)<cv.mm*longint(1024))
|
|
and (r13<128) and (r13>0) and ((bytes div r13) in [1,2,4,8,16])
|
|
and (memmode<>_cga1) and (memmode<>_cga2) then
|
|
begin {Can we double the screen?}
|
|
wrinx(crtc,$13,r13*2);
|
|
bytes:=bytes*2;
|
|
pixels:=pixels*2;
|
|
end;
|
|
case memmode of
|
|
_text,_txt2,_txt4:
|
|
lins:=32768 div bytes;
|
|
_cga1,_cga2:
|
|
lins:=16384 div bytes;
|
|
_pl1:lins:=cv.mm*longint(256) div bytes;
|
|
else lins:=cv.mm*longint(1024) div (bytes*planes);
|
|
end;
|
|
case memmode of
|
|
_cga1,_pl1,
|
|
_pl4:pixels:=bytes*8;
|
|
_cga2:pixels:=bytes*4;
|
|
_pk4,_PK4a,_pk4b:
|
|
pixels:=bytes*2;
|
|
_p8:pixels:=bytes;
|
|
_p15,_p16:pixels:=bytes shr 1;
|
|
_p24,_P24b:pixels:=bytes div 3;
|
|
_p32,_p32b,_p32c,_p32d:
|
|
pixels:=bytes shr 2;
|
|
end;
|
|
|
|
Clearmemory;
|
|
|
|
drawtestpattern(s);
|
|
x0:=0;
|
|
y0:=0;
|
|
stop:=false;
|
|
|
|
dlay:=100; {100ms}
|
|
if auto_test then pushkey(ord('a'));
|
|
repeat
|
|
setvstart(x0,y0);
|
|
case getkey of
|
|
ord('>'):inc(x0);
|
|
ord('<'):dec(x0);
|
|
Ch_ArUp:y0:=y0-16;
|
|
Ch_ArLeft:x0:=x0-16;
|
|
Ch_ArRight:x0:=x0+16;
|
|
Ch_ArDown:y0:=y0+16;
|
|
Ch_PgUp:dec(y0);
|
|
Ch_PgDn:inc(y0);
|
|
ord('A'),ord('a'):begin
|
|
x0:=0;y0:=0;x:=0;
|
|
repeat
|
|
delay(dlay);
|
|
nxt:=false;
|
|
case x of
|
|
0:if x0+16<=pixels-scpixs then inc(x0,16)
|
|
else begin
|
|
nxt:=true;
|
|
x0:=pixels-scpixs;
|
|
end;
|
|
1:if y0+16<=lins-sclins then inc(y0,16)
|
|
else begin
|
|
nxt:=true;
|
|
y0:=lins-sclins;
|
|
dlay:=50; {Speed up for return trip}
|
|
end;
|
|
2:if x0>=16 then dec(x0,16)
|
|
else begin
|
|
nxt:=true;
|
|
x0:=0;
|
|
dlay:=25; {Speed up for return trip}
|
|
end;
|
|
3:if y0>=16 then dec(y0,16)
|
|
else begin
|
|
nxt:=true;
|
|
stop:=true;
|
|
y0:=0;
|
|
end;
|
|
end;
|
|
setvstart(x0,y0);
|
|
if nxt then
|
|
begin
|
|
inc(x);
|
|
delay(500);
|
|
end;
|
|
if peekkey=Ch_Esc then stop:=true;
|
|
until stop;
|
|
delay(500);
|
|
end;
|
|
ord('D'),ord('d'),ord('F'),ord('f'):begin
|
|
stop:=true;
|
|
repeatkey;
|
|
end;
|
|
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
ord('R'),ord('r'):begin
|
|
stop:=true;
|
|
repeatkey;
|
|
end;
|
|
|
|
end;
|
|
chkrange(x0,0,pixels-scpixs+10000);
|
|
chkrange(y0,0,lins-sclins);
|
|
|
|
until stop;
|
|
setvstart(0,0); {Reset start, some chipsets NEED this}
|
|
pixels:=scpixs;
|
|
lins:=sclins;
|
|
bytes:=scbytes;
|
|
end;
|
|
SetTextMode;
|
|
|
|
writeln('Values for mode '+hex4(curmode)+':');
|
|
writeln;
|
|
writeln(' List: Calc: BlnkS: RetrS: RetrE: BlnkE: Frame:');
|
|
writeln('Pixels per scan line:',pixels:6,calcpixels:7,calchblks:7,calchrtrs:7
|
|
,calchrtre:7,calchblke:7,calchtot:8);
|
|
writeln('Lines in image: ',lins:6 ,calclines:7,calcvblks:7,calcvrtrs:7
|
|
,calcvrtre:7,calcvblke:7,calcvtot:8,iltxt[ilace]);
|
|
writeln('Bytes per scanline: ',bytes:6 ,calcbytes:7);
|
|
writeln('Memory mode: ',strip(mmodenames[memmode]):6,strip(mmodenames[calcmmode]):7);
|
|
if memmode<_herc then
|
|
writeln('Character cell: ',charwid,'x',charhigh);
|
|
if vclk>0 then
|
|
begin
|
|
writeln;
|
|
write('Clocks: Pixel: '+freq(vclk)+' MHz, Line: '+freq(hclk)
|
|
,' KHz, Frame: '+freq(fclk)+' Hz');
|
|
if ilace then write(' (i)');
|
|
writeln;
|
|
writeln('Required bandwidth: '+freq(BWlow)+' -'+freq(BWhigh)+' Mb/s');
|
|
end;
|
|
if auto_test then
|
|
begin
|
|
pushkey(ch);
|
|
writeln;
|
|
write('Did the mode display properly (y/n): ');
|
|
if getYN then inc(af_rec.flag,AFF_dispok);
|
|
if scrollable then
|
|
begin
|
|
writeln;
|
|
write('Did the mode scroll properly (y/n): ');
|
|
if getYN then inc(af_rec.flag,AFF_scrollok)
|
|
else inc(af_rec.flag,AFF_scroll);
|
|
end;
|
|
if (af_rec.flag and AFF_dispok)=0 then
|
|
begin
|
|
write('Disable the mode (y/n): ');
|
|
if getYN then inc(af_rec.flag,AFF_canceled);
|
|
end;
|
|
|
|
af_cmt:=GetComment('any comments to the test');
|
|
|
|
af_rec.vseg :=vseg;
|
|
af_rec.Cpixels :=calcpixels;
|
|
af_rec.Clins :=calclines;
|
|
af_rec.Cbytes :=calcbytes;
|
|
af_rec.CMmode :=calcmmode;
|
|
af_rec.ChWidth :=charwid;
|
|
af_rec.ChHeight:=charhigh;
|
|
af_rec.Cvseg :=calcvseg;
|
|
af_rec.ExtPixf :=Extpixfact;
|
|
af_rec.Extlinf :=Extlinfact;
|
|
af_rec.vclk :=vclk;
|
|
af_rec.hclk :=hclk;
|
|
af_rec.fclk :=fclk;
|
|
af_rec.ilace :=ilace;
|
|
|
|
pushkey(ch_cr);
|
|
end;
|
|
|
|
ch:=getkey;
|
|
end;
|
|
if (ch=ord('D')) or (ch=ord('d')) then ch:=dumpVGAregs;
|
|
|
|
case ch of
|
|
Ch_Esc:testvmode:=false;
|
|
ord('f'),ord('F'):
|
|
dumpVGAregfile;
|
|
ord('r'),ord('R'):
|
|
modetbl[CurModeIndex].flags:=
|
|
modetbl[CurModeIndex].flags and (not MFL_enabled);
|
|
end;
|
|
end;
|
|
|
|
|
|
function InitMode(md:integer):boolean;
|
|
begin
|
|
CurModeIndex:=md;
|
|
memmode:=modetbl[md].memmode;
|
|
pixels :=modetbl[md].xres;
|
|
lins :=modetbl[md].yres;
|
|
bytes :=modetbl[md].bytes;
|
|
InitMode:=setmode(modetbl[md].md,true);
|
|
end;
|
|
|
|
|
|
|
|
procedure testcursor; {Test HardWare Cursor}
|
|
var m,x:word;
|
|
md:integer;
|
|
|
|
procedure setXY(x0,y0:word);
|
|
begin
|
|
SetHWcurpos(x0,y0);
|
|
SetHWcurcol(((x0*longint(256) div pixels)*256
|
|
+(y0*longint(256) div lins))*256+$ff,0);
|
|
end;
|
|
|
|
procedure tmode(m:word);
|
|
const
|
|
CurMap:CursorType= {Snipers sight}
|
|
($00f81f00,$00800130,$00800130,$00800100
|
|
,$00f00f00,$008c3100,$00824100,$00818100
|
|
,$80800101,$40800102,$20800104,$21800184
|
|
,$11800188,$11800188,$11800188,$ffffffff
|
|
,$ffffffff,$11800188,$11800188,$11800188
|
|
,$21800184,$20800104,$40800102,$80800101
|
|
,$00818100,$00824100,$008C3100,$00f00f00
|
|
,$00800100,$00800100,$00800100,$00f81f00);
|
|
|
|
var x,x0,y0:integer;
|
|
fgcol,bkcol:longint;
|
|
stop:boolean;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Mode: '+hex4(curmode)+'h: '+istr(pixels)+'x'
|
|
+istr(lins)+' '+istr(modecols[memmode])+' colors');
|
|
|
|
SetHWcurmap(CurMap);
|
|
|
|
if auto_test then pushkey(ord('A'));
|
|
stop:=false;
|
|
x0:=100;y0:=150; {Place it in the palette}
|
|
repeat
|
|
if y0<0 then y0:=0;
|
|
if x0+32>pixels then x0:=pixels-32;
|
|
if y0+32>lins then y0:=lins-32;
|
|
|
|
SetXY(x0,y0);
|
|
case getkey of
|
|
Ch_ArUp:dec(y0,17);
|
|
Ch_ArLeft:dec(x0,17);
|
|
Ch_ArRight:inc(x0,17);
|
|
Ch_ArDown:inc(y0,17);
|
|
ord('a'),ord('A'):
|
|
begin
|
|
x0:=0;
|
|
repeat
|
|
SetXY(x0,150);
|
|
delay(200);
|
|
inc(x0,17);
|
|
until x0>pixels-32;
|
|
x0:=0;
|
|
repeat
|
|
SetXY(200,x0);
|
|
delay(200);
|
|
inc(x0,17);
|
|
until x0>lins-32;
|
|
stop:=true;
|
|
end;
|
|
Ch_Cr,Ch_Esc:stop:=true;
|
|
end;
|
|
until stop;
|
|
HWcuronoff(false);
|
|
if auto_test then
|
|
begin
|
|
repeat until keypressed;
|
|
SetTextMode;
|
|
write('Did the Hardware Cursor work properly (y/n) ?');
|
|
af_tst.Flag :=ord(getYN)*AFF_testok;
|
|
af_cmt:=getComment('any comments to the test');
|
|
|
|
af_tst.mode :=modetbl[m].md;
|
|
af_tst.Mmode:=modetbl[m].memmode;
|
|
AddAFbuf(af_tst,sizeof(af_tst));
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
WrAFbuf(AF_Tcursor);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
textmode($103); {43/50 line text mode}
|
|
writeln('Hardware Cursor test.');
|
|
writeln;
|
|
|
|
if auto_test then
|
|
begin
|
|
delay(1000);
|
|
pushkey(ord('*'));
|
|
end
|
|
else begin
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to nomodes do
|
|
if (modetbl[m].flags AND MFL_enGr)=MFL_enGr then
|
|
writeln(' '+menuchars[m]+' '+hex4(modetbl[m].md)+'h '+istr(modetbl[m].xres)
|
|
+'x'+istr(modetbl[m].yres)+' '+mdtxt[modetbl[m].memmode]);
|
|
writeln;
|
|
|
|
writeln(' * All modes');
|
|
writeln;
|
|
end;
|
|
|
|
x:=getmenkey;
|
|
for m:=1 to nomodes do
|
|
if ((x=0) or (x=m)) and ((modetbl[m].flags AND MFL_enGr)=MFL_enGr) then
|
|
tmode(m);
|
|
|
|
end;
|
|
|
|
|
|
|
|
procedure testblit; {Test BitBLT functions}
|
|
var m,x:word;
|
|
md:integer;
|
|
|
|
procedure tmode(m:word);
|
|
var x,y,x0,y0,siz:integer;
|
|
stop:boolean;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Mode: '+hex4(curmode)+'h: '+istr(pixels)+'x'
|
|
+istr(lins)+' '+istr(modecols[memmode])+' colors');
|
|
if lins>=400 then siz:=8 else siz:=4;
|
|
x0:=pixels div 2-8*siz;
|
|
y0:=lins div 2-8*siz;
|
|
|
|
case colbits[memmode] of
|
|
4:for x:=0 to 15 do
|
|
fillrect(x0,y0+x*siz,16*siz,siz,x);
|
|
8:for x:=0 to 255 do
|
|
fillrect(x0+(x and 15)*siz,y0+(x div 16)*siz,siz,siz,x);
|
|
15,16,24,32:for x:=0 to 63 do
|
|
begin
|
|
fillrect(x0+(x and 15)*siz,y0+(x div 16)*siz,siz,siz,rgb(x*4,0,0));
|
|
fillrect(x0+(x and 15)*siz,y0+siz*4+(x div 16)*siz,siz,siz,rgb(0,x*4,0));
|
|
fillrect(x0+(x and 15)*siz,y0+siz*8+(x div 16)*siz,siz,siz,rgb(0,0,x*4));
|
|
fillrect(x0+(x and 15)*siz,y0+siz*12+(x div 16)*siz,siz,siz,rgb(x*4,x*4,x*4));
|
|
end;
|
|
end;
|
|
copyrect(x0,y0,x0-siz*15,y0-5 ,siz*16-1,siz*16+1);
|
|
copyrect(x0,y0,x0+5 ,y0-siz*15,siz*16-1,siz*16+1);
|
|
copyrect(x0,y0,x0+siz*15,y0+5 ,siz*16-1,siz*16+1);
|
|
copyrect(x0,y0,x0-5 ,y0+siz*15,siz*16-1,siz*16+1);
|
|
|
|
|
|
if memmode<=_pl4 then {special 16c test pattern}
|
|
begin
|
|
for y:=1 to 8 do
|
|
begin
|
|
y0:=y*10+250;
|
|
fillrect(100,y0,y,8,y);
|
|
x0:=101+y;
|
|
for x:=1 to 15 do
|
|
begin
|
|
fillrect(x0,y0,x,8,y);
|
|
x0:=x0+x+1;
|
|
end;
|
|
fillrect(x0,y0,9-y,8,y);
|
|
y0:=y0+10;
|
|
end;
|
|
{ if readkey='' then; }
|
|
|
|
for x:=0 to 19 do
|
|
begin
|
|
x0:=96+x*8;
|
|
for y:=0 to 8 do
|
|
setpix(x0,259+10*y,15);
|
|
end;
|
|
end;
|
|
|
|
if auto_test then
|
|
begin
|
|
repeat until keypressed;
|
|
SetTextMode;
|
|
write('Did the BitBLT test work properly (y/n) ?');
|
|
af_tst.Flag :=ord(getYN)*AFF_testok;
|
|
af_cmt:=getComment('any comments to the test');
|
|
|
|
af_tst.mode :=modetbl[m].md;
|
|
af_tst.Mmode:=modetbl[m].memmode;
|
|
AddAFbuf(af_tst,sizeof(af_tst));
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
WrAFbuf(AF_Tbitblt);
|
|
end
|
|
else if getkey=0 then;
|
|
end;
|
|
settextmode;
|
|
end;
|
|
|
|
begin
|
|
textmode($103);
|
|
writeln('Hardware BitBLT test.');
|
|
writeln;
|
|
|
|
if auto_test then
|
|
begin
|
|
delay(1000);
|
|
pushkey(ord('*'));
|
|
end
|
|
else begin
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to nomodes do
|
|
if (modetbl[m].flags AND MFL_enGr)=MFL_enGr then
|
|
writeln(' '+menuchars[m]+' '+hex4(modetbl[m].md)+'h '+istr(modetbl[m].xres)
|
|
+'x'+istr(modetbl[m].yres)+' '+mdtxt[modetbl[m].memmode]);
|
|
writeln;
|
|
|
|
writeln(' * All modes');
|
|
writeln;
|
|
end;
|
|
|
|
x:=getmenkey;
|
|
for m:=1 to nomodes do
|
|
if ((x=0) or (x=m)) and ((modetbl[m].flags AND MFL_enGr)=MFL_enGr) then
|
|
tmode(m);
|
|
end;
|
|
|
|
|
|
|
|
procedure testline; {Test Line Draw functions}
|
|
var x,m:word;
|
|
md:integer;
|
|
|
|
procedure tmode(m:word);
|
|
var x,x0,y0,linl:integer;
|
|
stop:boolean;
|
|
col:longint;
|
|
zz:array[-10..10] of integer;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Mode: '+hex4(curmode)+'h: '+istr(pixels)+'x'
|
|
+istr(lins)+' '+istr(modecols[memmode])+' colors');
|
|
|
|
x0:=pixels div 2;
|
|
y0:=lins div 2;
|
|
linl:=lins div 3;
|
|
for x:=-10 to 9 do
|
|
begin
|
|
case colbits[memmode] of
|
|
4:col:=(x+11) and 15;
|
|
8:col:=x*12+128;
|
|
15,16,24,32:col:=rgb(128-x*10,x+128,128+x*5);
|
|
end;
|
|
line(x0,y0,x0+x*(linl div 10),y0-linl,col);
|
|
line(x0,y0,x0+linl ,y0+x*(linl div 10),col);
|
|
line(x0,y0,x0-x*(linl div 10),y0+linl,col);
|
|
line(x0,y0,x0-linl ,y0-x*(linl div 10),col);
|
|
end;
|
|
if auto_test then
|
|
begin
|
|
repeat until keypressed;
|
|
SetTextMode;
|
|
write('Did the Line Draw test work properly (y/n): ?');
|
|
af_tst.Flag :=ord(getYN)*AFF_testok;
|
|
af_cmt:=getComment('any comments to the test');
|
|
|
|
af_tst.mode :=modetbl[m].md;
|
|
af_tst.Mmode:=modetbl[m].memmode;
|
|
AddAFbuf(af_tst,sizeof(af_tst));
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
WrAFbuf(AF_Tline);
|
|
end
|
|
else if getkey=0 then;
|
|
end;
|
|
settextmode;
|
|
end;
|
|
|
|
begin
|
|
textmode($103);
|
|
writeln('Hardware Line Draw test.');
|
|
writeln;
|
|
|
|
if auto_test then
|
|
begin
|
|
delay(1000);
|
|
pushkey(ord('*'));
|
|
end
|
|
else begin
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to nomodes do
|
|
if (modetbl[m].flags AND MFL_enGr)=MFL_enGr then
|
|
writeln(' '+menuchars[m]+' '+hex4(modetbl[m].md)+'h '+istr(modetbl[m].xres)
|
|
+'x'+istr(modetbl[m].yres)+' '+mdtxt[modetbl[m].memmode]);
|
|
writeln;
|
|
|
|
writeln(' * All modes');
|
|
writeln;
|
|
end;
|
|
|
|
x:=getmenkey;
|
|
for m:=1 to nomodes do
|
|
if ((x=0) or (x=m)) and ((modetbl[m].flags AND MFL_enGr)=MFL_enGr) then
|
|
tmode(m);
|
|
end;
|
|
|
|
|
|
procedure testRWbank; {Test R/W bank functions}
|
|
var x,m:word;
|
|
md:integer;
|
|
|
|
procedure CopyLin(x0,y0,x1,y1,pix:word);
|
|
var
|
|
pxs,px,x,y:word;
|
|
src,dst:longint;
|
|
begin
|
|
x:=usebits[memmode] div planes;
|
|
src:=y0*bytes+(x0*x) div 8;
|
|
dst:=y1*bytes+(x1*x) div 8;
|
|
pxs:=(pix*x) div 8;
|
|
if planes>1 then
|
|
begin
|
|
wrinx(GRC,3,0);
|
|
wrinx(GRC,5,1);
|
|
end;
|
|
repeat
|
|
px:=pxs;
|
|
x:=$8000-(src and $7FFF);
|
|
if px>x then px:=x;
|
|
x:=$8000-(dst and $7FFF);
|
|
if px>x then px:=x;
|
|
setbank(dst shr 16);
|
|
setrbank(src shr 16);
|
|
move(mem[vseg:src],mem[vseg:dst],px);
|
|
inc(src,px);
|
|
inc(dst,px);
|
|
dec(pxs,px);
|
|
until pxs=0;
|
|
end;
|
|
|
|
procedure tmode(m:word);
|
|
var x,wid:integer;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Mode: '+hex4(curmode)+'h: '+istr(pixels)+'x'
|
|
+istr(lins)+' '+istr(modecols[memmode])+' colors');
|
|
|
|
wid:=(pixels div 2)-40;
|
|
for x:=0 to lins-1 do
|
|
CopyLin(30,x,wid+50,lins-x,wid);
|
|
|
|
if auto_test then
|
|
begin
|
|
repeat until keypressed;
|
|
SetTextMode;
|
|
write('Did the Read/Write bank test work properly (y/n) ?');
|
|
af_tst.Flag :=ord(getYN)*AFF_testok;
|
|
af_cmt:=getComment('any comments to the test');
|
|
|
|
af_tst.mode :=modetbl[m].md;
|
|
af_tst.Mmode:=modetbl[m].memmode;
|
|
AddAFbuf(af_tst,sizeof(af_tst));
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
WrAFbuf(AF_TRWbank);
|
|
end
|
|
else if getkey=0 then;
|
|
end;
|
|
settextmode;
|
|
end;
|
|
|
|
begin
|
|
textmode($103);
|
|
writeln('Seperate Read/Write bank test.');
|
|
|
|
if auto_test then
|
|
begin
|
|
delay(1000);
|
|
pushkey(ord('*'));
|
|
end
|
|
else begin
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to nomodes do
|
|
if (modetbl[m].flags AND MFL_enGr)=MFL_enGr then
|
|
writeln(' '+menuchars[m]+' '+hex4(modetbl[m].md)+'h '+istr(modetbl[m].xres)
|
|
+'x'+istr(modetbl[m].yres)+' '+mdtxt[modetbl[m].memmode]);
|
|
writeln;
|
|
|
|
writeln(' * All modes');
|
|
writeln;
|
|
end;
|
|
|
|
x:=getmenkey;
|
|
for m:=1 to nomodes do
|
|
if ((x=0) or (x=m)) and ((modetbl[m].flags AND MFL_enGr)=MFL_enGr) then
|
|
tmode(m);
|
|
end;
|
|
|
|
procedure testZoom; {Test Pan & Zoom functions}
|
|
var x,m:word;
|
|
md:integer;
|
|
|
|
procedure tmode(m:word);
|
|
var Xf,Yf,wXs,wXe,wYs,wYe,srcX,srcY:integer;
|
|
dirty,stop:boolean;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Mode: '+hex4(curmode)+'h: '+istr(pixels)+'x'
|
|
+istr(lins)+' '+istr(modecols[memmode])+' colors');
|
|
|
|
Xf:=0;Yf:=0;srcX:=0;srcY:=0;
|
|
wXs:=100;wXe:=150;wYs:=50;wYe:=75;
|
|
|
|
ZoomOnOff(true);
|
|
stop:=false;dirty:=true;
|
|
|
|
repeat
|
|
if dirty then
|
|
begin
|
|
if Xf<0 then Xf:=0;
|
|
if Xf>3 then Xf:=3;
|
|
if Yf<0 then Yf:=0;
|
|
if Yf>3 then Yf:=3;
|
|
SetZoomFactor(Xf,Yf);
|
|
|
|
if wXs>wXe then wXe:=wXs;
|
|
if wYs>wYe then wYe:=wYs;
|
|
SetZoomWindow(wXs,wYs,wXe,wYe);
|
|
|
|
if srcX<0 then srcX:=0;
|
|
if srcX>=pixels then srcX:=pixels-1;
|
|
if srcY<0 then srcY:=0;
|
|
if srcY>=lins then srcY:=lins-1;
|
|
setZoomAdr(srcX,srcY);
|
|
end;
|
|
dirty:=true;
|
|
case getkey of
|
|
ord('-'):dec(Yf);
|
|
ord('+'):inc(Yf);
|
|
ord('/'):dec(Xf);
|
|
ord('*'):inc(Xf);
|
|
Ch_ArUp:dec(srcY);
|
|
Ch_ArLeft:dec(srcX);
|
|
Ch_ArRight:inc(srcX);
|
|
Ch_ArDown:inc(srcY);
|
|
Ch_F1:dec(wXs);
|
|
Ch_F2:inc(wXs);
|
|
Ch_F3:dec(wXe);
|
|
Ch_F4:inc(wXe);
|
|
Ch_F5:dec(wYs);
|
|
Ch_F6:inc(wYs);
|
|
Ch_F7:dec(wYe);
|
|
Ch_F8:inc(wYe);
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
else dirty:=false;
|
|
end;
|
|
|
|
until stop;
|
|
ZoomOnOff(false);
|
|
|
|
if auto_test then
|
|
begin
|
|
repeat until keypressed;
|
|
SetTextMode;
|
|
write('Did the Pan & Zoom test work properly (y/n) ?');
|
|
af_tst.Flag :=ord(getYN)*AFF_testok;
|
|
af_cmt:=getComment('any comments to the test');
|
|
|
|
af_tst.mode :=modetbl[m].md;
|
|
af_tst.Mmode:=modetbl[m].memmode;
|
|
AddAFbuf(af_tst,sizeof(af_tst));
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
WrAFbuf(AF_Tzoom);
|
|
end
|
|
else if getkey=0 then;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
textmode($103);
|
|
writeln('Pan & Zoom test.');
|
|
|
|
if auto_test then
|
|
begin
|
|
delay(1000);
|
|
pushkey(ord('*'));
|
|
end
|
|
else begin
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to nomodes do
|
|
if (modetbl[m].flags AND MFL_enGr)=MFL_enGr then
|
|
writeln(' '+menuchars[m]+' '+hex4(modetbl[m].md)+'h '+istr(modetbl[m].xres)
|
|
+'x'+istr(modetbl[m].yres)+' '+mdtxt[modetbl[m].memmode]);
|
|
writeln;
|
|
|
|
writeln(' * All modes');
|
|
writeln;
|
|
end;
|
|
|
|
x:=getmenkey;
|
|
for m:=1 to nomodes do
|
|
if ((x=0) or (x=m)) and ((modetbl[m].flags AND MFL_enGr)=MFL_enGr) then
|
|
tmode(m);
|
|
end;
|
|
|
|
procedure testbits; {Test register bits}
|
|
var m,pt,ix,msk:word;
|
|
md,x:integer;
|
|
s:string;
|
|
|
|
function tmode(m:word):boolean;
|
|
const
|
|
mask:array[0..7] of byte=(1,2,4,8,16,32,64,128);
|
|
var
|
|
stop:boolean;
|
|
x:word;
|
|
begin
|
|
tmode:=true;
|
|
if InitMode(m) then
|
|
begin
|
|
case memmode of
|
|
_text,_txt2,_txt4:
|
|
lins:=32768 div bytes;
|
|
_cga1,_cga2:
|
|
lins:=16384 div bytes;
|
|
_pl1:lins:=cv.mm*longint(256) div bytes;
|
|
else lins:=cv.mm*longint(1024) div (bytes*planes);
|
|
end;
|
|
|
|
Clearmemory;
|
|
|
|
clrinx(crtc,$11,$80);
|
|
drawtestpattern(s);
|
|
stop:=false;
|
|
repeat
|
|
wrtext(10,180,'Reg '+hex4(pt)+'h index '+hex2(ix)+'h bit '+chr(msk+48));
|
|
x:=rdinx(pt,ix);
|
|
wrinx(pt,ix,x xor mask[msk]);
|
|
wrtext(220,180,'= '+chr(48+(rdinx(pt,ix) shr msk) and 1));
|
|
delay(500);
|
|
wrinx(pt,ix,x);
|
|
wrtext(220,180,'= '+chr(48+(rdinx(pt,ix) shr msk) and 1));
|
|
delay(500);
|
|
|
|
if keypressed then
|
|
case getkey of
|
|
ord('-'):if msk>0 then dec(msk)
|
|
else begin
|
|
msk:=7;
|
|
dec(ix);
|
|
end;
|
|
ord('+'):begin
|
|
inc(msk);
|
|
if msk>7 then
|
|
begin
|
|
msk:=0;
|
|
inc(ix);
|
|
end;
|
|
end;
|
|
ord('*'):begin
|
|
inc(ix);
|
|
msk:=0;
|
|
end;
|
|
Ch_Esc:stop:=true;
|
|
end;
|
|
until stop;
|
|
SetTextmode;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
textmode($103);
|
|
writeln('Test register bits.');
|
|
writeln;
|
|
write('Base register (hex): ');
|
|
readln(s);
|
|
pt:=dehex(s);
|
|
write('Start Index (hex 0-FFh): ');
|
|
readln(s);
|
|
ix:=dehex(s);
|
|
write('Start Bit (0-7): ');
|
|
readln(s);
|
|
msk:=ord(s[1]) and 7;
|
|
writeln;
|
|
writeln('Testing register bits, starting with '+hex4(pt)+'h index '+hex2(ix)+'h bit '+chr(msk+48)+'.');
|
|
writeln;
|
|
writeln(' + Steps up to the next bit (and possibly next index)');
|
|
writeln(' - Steps back to the last bit');
|
|
writeln(' * Steps to the next index, bit 0');
|
|
writeln(' Esc Terminates the test');
|
|
writeln;
|
|
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to nomodes do
|
|
begin
|
|
writeln(' '+menuchars[m]+' '+hex4(modetbl[m].md)+'h '+istr(modetbl[m].xres)
|
|
+'x'+istr(modetbl[m].yres)+' '+mdtxt[modetbl[m].memmode]);
|
|
end;
|
|
writeln;
|
|
x:=getmenkey;
|
|
for m:=1 to nomodes do
|
|
if (x=m) then
|
|
if not tmode(m) then x:=-1; {stop}
|
|
|
|
end;
|
|
|
|
|
|
procedure testregs; {Test register Read/Writable}
|
|
var m,pt,ix,msk:word;
|
|
md,x:integer;
|
|
s,IM:string;
|
|
|
|
function tmode(md:word):boolean;
|
|
const
|
|
bit:array[0..7] of byte=(1,2,4,8,16,32,64,128);
|
|
var
|
|
x,y,z,i:word;
|
|
msk:array[0..2047] of char;
|
|
v0:array[0..255] of byte;
|
|
imsk:array[0..7] of char;
|
|
|
|
procedure writelog;
|
|
var x:word;
|
|
begin
|
|
wrlog('Register test for index '+hex4(pt)+'h Index mask: '
|
|
+imsk[0]+imsk[1]+imsk[2]+imsk[3]+imsk[4]+imsk[5]+imsk[6]+imsk[7]);
|
|
writeln(' 01234567 01234567 01234567 01234567 01234567 01234567 01234567 01234567');
|
|
for x:=0 to 2047 do
|
|
begin
|
|
if (x and 63)=0 then s:=' '+hex2(x shr 3)+':';
|
|
if (x and 7)=0 then s:=s+' ';
|
|
s:=s+msk[x];
|
|
if (x and 63)=63 then wrlog(s);
|
|
end;
|
|
closelog;
|
|
end;
|
|
|
|
begin
|
|
tmode:=true;
|
|
if setMode(md,true) then
|
|
begin
|
|
clrinx(crtc,$11,$80);
|
|
drawtestpattern(s);
|
|
fillchar(imsk,8,'W');
|
|
y:=inp(pt);z:=0;
|
|
for x:=0 to 7 do {Check if each bit of the index register is RW}
|
|
begin
|
|
outp(pt,y and not bit[x and 7]);
|
|
if (inp(pt) and bit[x and 7])>0 then imsk[x]:='1';
|
|
outp(pt,y or bit[x and 7]);
|
|
if (inp(pt) and bit[x and 7])=0 then imsk[x]:='0';
|
|
outp(pt,y);
|
|
if IM[x+1]=' ' then im[x+1]:=imsk[x];
|
|
end;
|
|
|
|
z:=0;y:=0;
|
|
for x:=1 to 8 do
|
|
begin
|
|
if (im[x]='0') or (im[x]='1') then z:=z or bit[x-1]*8;
|
|
if (im[x]='1') then y:=y or bit[x-1]*8;
|
|
end;
|
|
|
|
|
|
|
|
fillchar(msk,sizeof(msk),'W'); {Set all bits off}
|
|
for x:=0 to 2047 do
|
|
if ((x xor y) and z)>0 then msk[x]:='.';
|
|
|
|
for y:=0 to 255 do v0[y]:=rdinx(pt,y);
|
|
for x:=1 to 10 do
|
|
for y:=0 to 255 do {Find any bits that changes if read again}
|
|
begin
|
|
z:=v0[y] xor rdinx(pt,y);
|
|
for i:=0 to 7 do {Check each bit}
|
|
if (z and bit [i])>0 then msk[y*8+i]:='A';
|
|
end;
|
|
openlog(false);
|
|
wrlog('After re-read test');
|
|
writelog;
|
|
|
|
for x:=0 to 2047 do {Check that each bit is R/W}
|
|
if msk[x]='W' then
|
|
begin
|
|
y:=x shr 3;
|
|
wrinx(pt,y,v0[y] and not bit[x and 7]);
|
|
if (rdinx(pt,y) and bit[x and 7])>0 then msk[x]:='1';
|
|
wrinx(pt,y,v0[y] or bit[x and 7]);
|
|
if (rdinx(pt,y) and bit[x and 7])=0 then msk[x]:='0';
|
|
wrinx(pt,y,v0[y]);
|
|
end;
|
|
openlog(false);
|
|
wrlog('After R/W test');
|
|
writelog;
|
|
|
|
for x:=1 to 2047 do {Try to change one of the other bits}
|
|
if msk[x]='W' then {and see if we changes with it}
|
|
begin
|
|
y:=x shr 3;
|
|
wrinx(pt,y,v0[y] xor bit[x and 7]);
|
|
for z:=0 to x-1 do
|
|
if (msk[z]='W') and (((v0[z shr 3] xor rdinx(pt,z shr 3))
|
|
and bit[z and 7])>0) then msk[z]:='C';
|
|
wrinx(pt,y,v0[y]);
|
|
for z:=0 to x-1 do
|
|
if (msk[z]='W') and (((v0[z shr 3] xor rdinx(pt,z shr 3))
|
|
and bit[z and 7])>0) then msk[z]:='C';
|
|
end;
|
|
openlog(true);
|
|
writelog;
|
|
if readkey='' then;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
SetTextMode;
|
|
writeln('Test register bits.');
|
|
writeln;
|
|
write('Base register (hex): ');
|
|
readln(s);
|
|
pt:=dehex(s);
|
|
writeln;
|
|
Write('Index mask (low bit first: 0/1/x/ ): ');
|
|
readln(IM);IM:=copy(IM+' ',1,8);
|
|
for m:=1 to 8 do
|
|
if (IM[m]<>'x') and (IM[m]<>'0') and (IM[m]<>'1') then IM[m]:=' ';
|
|
|
|
writeln('Testing indexed registers for base='+hex4(pt)+'h.');
|
|
writeln;
|
|
|
|
if (nomodes=0) and tmode($12) then
|
|
else begin
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to nomodes do
|
|
begin
|
|
writeln(' '+menuchars[m]+' '+hex4(modetbl[m].md)+'h '+istr(modetbl[m].xres)
|
|
+'x'+istr(modetbl[m].yres)+' '+mdtxt[modetbl[m].memmode]);
|
|
end;
|
|
writeln;
|
|
x:=getmenkey;
|
|
if (x>0) and (x<=nomodes) and tmode(modetbl[x].md) then; {stop}
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure testDACgamma;
|
|
var i,j,x,colorsh,
|
|
redi,redc,grni,grnc,blui,bluc,
|
|
gamm,oldgam:integer;
|
|
stop:boolean;
|
|
red,grn,blu:array[0..255] of byte;
|
|
begin
|
|
SetTextMode;
|
|
writeln('Mode for gamma test:');
|
|
for i:=1 to nomodes do
|
|
if ((modetbl[i].flags and MFL_enGr)=MFL_enGr)
|
|
and (modetbl[i].memmode>_P8) then
|
|
writeln(' '+menuchars[i]+' '+hex4(modetbl[i].md)+'h '
|
|
+istr(modetbl[i].xres)+'x'+istr(modetbl[i].yres)
|
|
+' '+mdtxt[modetbl[i].memmode]);
|
|
write('Select mode: ');
|
|
i:=getmenkey;
|
|
if (i<=0) or (i>nomodes) or (modetbl[i].memmode<=_P8) then i:=0;
|
|
if InitMode(i) then
|
|
begin
|
|
drawtestpattern('Test DAC gamma correction');
|
|
wrtext(30,120,'Press + to toggle the gamma correction off/red/green/blue');
|
|
wrtext(30,140,'One of the scales will be inverted, the other two unchanged.');
|
|
stop:=false;
|
|
gamm:=0;
|
|
oldgam:=-1;
|
|
repeat
|
|
if gamm<>oldgam then
|
|
begin
|
|
if gamm=0 then x:=setDACgamma(false)
|
|
else begin
|
|
x:=setDACgamma(true);
|
|
if (x and GAM_8bit)=0 then colorsh:=4 else colorsh:=1;
|
|
redi:=0;grni:=0;
|
|
if memmode>=_P24 then
|
|
begin
|
|
redc:=1;grnc:=1;
|
|
end
|
|
else begin
|
|
redc:=8;grnc:=8;
|
|
if (memmode=_P16) then grnc:=4;
|
|
if (x and GAM_Left8)>0 then redi:=3;
|
|
if (x and GAM_Left8)>0 then redi:=1;
|
|
grni:=redi;
|
|
if (grni>0) and (memmode=_P16) then dec(grni);
|
|
|
|
end;
|
|
|
|
blui:=redi;bluc:=redc;
|
|
for i:=0 to 255 do
|
|
begin
|
|
if gamm=1 then j:=255-i else j:=i; {Check for inversion}
|
|
red[i]:=((j shr redi)*redc) div colorsh;
|
|
if gamm=2 then j:=255-i else j:=i;
|
|
grn[i]:=((j shr grni)*grnc) div colorsh;
|
|
if gamm=3 then j:=255-i else j:=i;
|
|
blu[i]:=((j shr blui)*bluc) div colorsh;
|
|
end;
|
|
SetRGBPal(0,0,0,0); {Keep (0,0,0) as black for background}
|
|
for i:=1 to 255 do
|
|
SetRGBPal(i,red[i],grn[i],blu[i]);
|
|
end;
|
|
oldgam:=gamm;
|
|
end;
|
|
if keypressed then
|
|
case getkey of
|
|
ord('+'):gamm:=(gamm+1) and 3;
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
end;
|
|
until stop;
|
|
x:=setDACgamma(false); {Remove Gamma}
|
|
setdac8(false); {Return to 6bit DAC mode}
|
|
|
|
SetTextMode;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure testdac8(m:word); {Test 8bit DAC mode}
|
|
var
|
|
stop,dac8,olddac:boolean;
|
|
x,y,cmd:word;
|
|
mm:byte;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Test 6/8 bit DAC');
|
|
wrtext(30,230,'Press + to toggle the DAC mode');
|
|
wrtext(30,245,'6bit DAC mode should show the color scales breaking 3 times each');
|
|
wrtext(30,260,'8bit DAC mode should show unbroken color scales');
|
|
for y:=0 to 127 do
|
|
for x:=0 to 255 do
|
|
setpix(x+30,y+100,(x shr 2)+(y and $60)*2);
|
|
cmd:=0;
|
|
stop:=false;
|
|
dac8:=false;
|
|
olddac:=not dac8;
|
|
repeat
|
|
if dac8<>olddac then
|
|
begin
|
|
setdac8(dac8);
|
|
|
|
for x:=0 to 63 do SetRGBPal(x,x*4,0,0);
|
|
for x:=0 to 63 do SetRGBPal(x+$40,0,x*4,0);
|
|
for x:=0 to 63 do SetRGBPal(x+$80,0,0,x*4);
|
|
for x:=0 to 63 do SetRGBPal(x+$C0,x*4,x*4,x*4);
|
|
olddac:=dac8;
|
|
end;
|
|
if keypressed then
|
|
case getkey of
|
|
ord('+'):dac8:=not dac8;
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
end;
|
|
until stop;
|
|
setdac8(false);
|
|
|
|
SetTextMode;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure testdac15(m:word); {Test 8bit DAC mode}
|
|
var
|
|
stop,dac8,olddac:boolean;
|
|
x,y,cmd:word;
|
|
mm:byte;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Test 15bit (32Kcolor) DAC mode');
|
|
wrtext(30,230,'Press + to toggle the DAC mode');
|
|
wrtext(30,248,'The image above is for normal (palette) mode and the one');
|
|
wrtext(30,266,'below is for 15bit mode. Both should have the Red stripe');
|
|
wrtext(30,284,'at the top, then green, blue and finally white.');
|
|
for y:=0 to 127 do
|
|
for x:=0 to 255 do
|
|
setpix(x+30,y+100,(x shr 2)+(y and $60)*2);
|
|
memmode:=_p15;
|
|
for y:=0 to 15 do
|
|
for x:=0 to 255 do
|
|
begin
|
|
setpix(x+30,y+305,RGB(x,0,0));
|
|
setpix(x+30,y+321,RGB(0,x,0));
|
|
setpix(x+30,y+337,RGB(0,0,x));
|
|
setpix(x+30,y+353,RGB(x,x,x));
|
|
end;
|
|
|
|
memmode:=_P8;
|
|
stop:=false;
|
|
dac8:=false;
|
|
olddac:=not dac8;
|
|
repeat
|
|
if dac8<>olddac then
|
|
begin
|
|
if not dac8 then setDACstd
|
|
else if setdac15 then;
|
|
olddac:=dac8;
|
|
end;
|
|
if keypressed then
|
|
case getkey of
|
|
ord('+'):dac8:=not dac8;
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
end;
|
|
until stop;
|
|
setdacstd;
|
|
|
|
SetTextMode;
|
|
end;
|
|
end;
|
|
|
|
procedure testdac16(m:word); {Test 8bit DAC mode}
|
|
var
|
|
stop,dac8,olddac:boolean;
|
|
x,y,cmd:word;
|
|
mm:byte;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Test 16bit (64Kcolor) DAC mode');
|
|
wrtext(30,230,'Press + to toggle the DAC mode');
|
|
wrtext(30,248,'The image above is for normal (palette) mode and the one');
|
|
wrtext(30,266,'below is for 16bit mode. Both should have the Red stripe');
|
|
wrtext(30,284,'at the top, then green, blue and finally white.');
|
|
for y:=0 to 127 do
|
|
for x:=0 to 255 do
|
|
setpix(x+30,y+100,(x shr 2)+(y and $60)*2);
|
|
memmode:=_p16;
|
|
for y:=0 to 15 do
|
|
for x:=0 to 255 do
|
|
begin
|
|
setpix(x+30,y+305,RGB(x,0,0));
|
|
setpix(x+30,y+321,RGB(0,x,0));
|
|
setpix(x+30,y+337,RGB(0,0,x));
|
|
setpix(x+30,y+353,RGB(x,x,x));
|
|
end;
|
|
|
|
memmode:=_P8;
|
|
stop:=false;
|
|
dac8:=false;
|
|
olddac:=not dac8;
|
|
repeat
|
|
if dac8<>olddac then
|
|
if not dac8 then setDACstd
|
|
else if setdac16 then;
|
|
olddac:=dac8;
|
|
case getkey of
|
|
ord('+'):dac8:=not dac8;
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
end;
|
|
until stop;
|
|
setdacstd;
|
|
SetTextMode;
|
|
end;
|
|
end;
|
|
|
|
procedure testdac24(m:word); {Test 8bit DAC mode}
|
|
var
|
|
stop,dac8,olddac:boolean;
|
|
x,y,cmd:word;
|
|
mm:byte;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Test 24bit (16Mcolor) DAC mode');
|
|
wrtext(30,230,'Press + to toggle the DAC mode');
|
|
wrtext(30,248,'The image above is for normal (palette) mode and the one');
|
|
wrtext(30,266,'below is for 24bit mode. Both should have the Red stripe');
|
|
wrtext(30,284,'at the top, then green, blue and finally white.');
|
|
for y:=0 to 127 do
|
|
for x:=0 to 255 do
|
|
setpix(x+30,y+100,(x shr 2)+(y and $60)*2);
|
|
memmode:=_p24;
|
|
for y:=0 to 15 do
|
|
for x:=0 to 255 do
|
|
begin
|
|
setpix(x+30,y+305,RGB(x,0,0));
|
|
setpix(x+30,y+321,RGB(0,x,0));
|
|
setpix(x+30,y+337,RGB(0,0,x));
|
|
setpix(x+30,y+353,RGB(x,x,x));
|
|
end;
|
|
|
|
memmode:=_P8;
|
|
stop:=false;
|
|
dac8:=false;
|
|
olddac:=not dac8;
|
|
repeat
|
|
if dac8<>olddac then
|
|
begin
|
|
if not dac8 then setDACstd
|
|
else if setdac24 then;
|
|
olddac:=dac8;
|
|
end;
|
|
if keypressed then
|
|
case getkey of
|
|
ord('+'):dac8:=not dac8;
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
end;
|
|
until stop;
|
|
setdacstd;
|
|
|
|
SetTextMode;
|
|
end;
|
|
end;
|
|
|
|
procedure testdac32(m:word); {Test 8bit DAC mode}
|
|
var
|
|
stop,dac8,olddac:boolean;
|
|
x,y,cmd:word;
|
|
mm:byte;
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Test 32bit (16Mcolor - RGBa) DAC mode');
|
|
wrtext(30,230,'Press + to toggle the DAC mode');
|
|
wrtext(30,248,'The image above is for normal (palette) mode and the one');
|
|
wrtext(30,266,'below is for 32bit mode. Both should have the Red stripe');
|
|
wrtext(30,284,'at the top, then green, blue and finally white.');
|
|
for y:=0 to 127 do
|
|
for x:=0 to 255 do
|
|
setpix(x+30,y+100,(x shr 2)+(y and $60)*2);
|
|
memmode:=_p32;
|
|
for y:=0 to 15 do
|
|
for x:=0 to 255 do
|
|
begin
|
|
setpix(x+30,y+305,RGB(x,0,0));
|
|
setpix(x+30,y+321,RGB(0,x,0));
|
|
setpix(x+30,y+337,RGB(0,0,x));
|
|
setpix(x+30,y+353,RGB(x,x,x));
|
|
end;
|
|
|
|
memmode:=_P8;
|
|
stop:=false;
|
|
dac8:=false;
|
|
olddac:=not dac8;
|
|
repeat
|
|
if dac8<>olddac then
|
|
begin
|
|
if not dac8 then setDACstd
|
|
else if setdac32 then;
|
|
olddac:=dac8;
|
|
end;
|
|
if keypressed then
|
|
case getkey of
|
|
ord('+'):dac8:=not dac8;
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
end;
|
|
until stop;
|
|
setdacstd;
|
|
|
|
SetTextMode;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{Test the DAC Cmd register}
|
|
procedure testdaccmd(m:word);
|
|
var
|
|
stop:boolean;
|
|
x,y,cmd,pel:word;
|
|
function bin(w:word):string;
|
|
var s:string[10];
|
|
i:integer;
|
|
begin
|
|
s:='';
|
|
for i:=7 downto 0 do
|
|
s:=s+chr(((w shr i) and 1) +48);
|
|
bin:=s;
|
|
end;
|
|
|
|
procedure newcmd(cmd:word);
|
|
var x,pel:word;
|
|
begin
|
|
if cv.chip=__cir54 then
|
|
begin
|
|
pel:=inp($3C6);
|
|
outp($3C6,0);
|
|
end;
|
|
|
|
outp(setDACpage(dacHIcmd),cmd);
|
|
clearDACpage;
|
|
x:=inp(setDACpage(dacHIcmd)) xor cmd;
|
|
clearDACpage;
|
|
wrtext(10,10,'DAC Command: '+hex2(cmd)+'h, '+bin(cmd)+'b XOR: '+hex2(x)+'h, '+bin(x)+'b:');
|
|
for x:=0 to 63 do
|
|
begin
|
|
SetRGBPal(x,x*4,0,0);
|
|
SetRGBPal(x+$40,0,x*4,0);
|
|
SetRGBPal(x+$80,0,0,x*4);
|
|
SetRGBPal(x+$C0,x*4,x*4,x*4);
|
|
end;
|
|
if cv.chip=__cir54 then outp($3C6,pel);
|
|
end;
|
|
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
drawtestpattern('Test DAC Command register');
|
|
|
|
for y:=100 to 230 do
|
|
for x:=30 to 170 do
|
|
setpix(x,y,0);
|
|
|
|
for y:=0 to 63 do
|
|
for x:=0 to 255 do
|
|
setpix(x+30,y+100,(x shr 2)+(y and $30)*4);
|
|
|
|
memmode:=_p15;
|
|
for y:=0 to 15 do
|
|
for x:=0 to 255 do
|
|
begin
|
|
setpix(x+30,y+180,RGB(x,0,0));
|
|
setpix(x+30,y+196,RGB(0,x,0));
|
|
setpix(x+30,y+212,RGB(0,0,x));
|
|
setpix(x+30,y+228,RGB(x,x,x));
|
|
end;
|
|
|
|
memmode:=_p16;
|
|
for y:=0 to 15 do
|
|
for x:=0 to 255 do
|
|
begin
|
|
setpix(x+30,y+260,RGB(x,0,0));
|
|
setpix(x+30,y+276,RGB(0,x,0));
|
|
setpix(x+30,y+292,RGB(0,0,x));
|
|
setpix(x+30,y+308,RGB(x,x,x));
|
|
end;
|
|
|
|
memmode:=_p24;
|
|
for y:=0 to 15 do
|
|
for x:=0 to 127 do
|
|
begin
|
|
setpix(x+24,y+340,RGB(x*2,0,0));
|
|
setpix(x+24,y+356,RGB(0,x*2,0));
|
|
setpix(x+24,y+372,RGB(0,0,x*2));
|
|
setpix(x+24,y+388,RGB(x*2,x*2,x*2));
|
|
end;
|
|
|
|
memmode:=_p32;
|
|
for y:=0 to 15 do
|
|
for x:=0 to 127 do
|
|
begin
|
|
setpix(x+24,y+420,RGB(x*2,0,0));
|
|
setpix(x+24,y+436,RGB(0,x*2,0));
|
|
setpix(x+24,y+452,RGB(0,0,x*2));
|
|
setpix(x+24,y+468,RGB(x*2,x*2,x*2));
|
|
end;
|
|
|
|
memmode:=_P8;
|
|
wrtext(5,180,'15');
|
|
wrtext(5,260,'16');
|
|
wrtext(5,340,'24');
|
|
wrtext(5,420,'32');
|
|
wrtext(50,30,'Press F1..F8 to toggle the DAC mode bits 0..7');
|
|
|
|
stop:=false;
|
|
|
|
if cv.chip=__cir54 then
|
|
begin
|
|
pel:=inp($3C6);
|
|
outp($3C6,0);
|
|
end;
|
|
cmd:=inp(SetDACpage(dacHIcmd));
|
|
clearDACpage;
|
|
if cv.chip=__cir54 then outp($3C6,pel);
|
|
repeat
|
|
newcmd(cmd);
|
|
case getkey of
|
|
Ch_F1:cmd:=cmd xor 1;
|
|
Ch_F2:cmd:=cmd xor 2;
|
|
Ch_F3:cmd:=cmd xor 4;
|
|
Ch_F4:cmd:=cmd xor 8;
|
|
Ch_F5:cmd:=cmd xor 16;
|
|
Ch_F6:cmd:=cmd xor 32;
|
|
Ch_F7:cmd:=cmd xor 64;
|
|
Ch_F8:cmd:=cmd xor 128;
|
|
ord('A'),ord('a'):for x:=0 to 255 do
|
|
begin
|
|
newcmd(x);
|
|
delay(1000);
|
|
end;
|
|
Ch_Esc,Ch_Cr:stop:=true;
|
|
end;
|
|
until stop;
|
|
clearDACpage;
|
|
setdacstd;
|
|
|
|
SetTextMode;
|
|
end;
|
|
end;
|
|
|
|
|
|
{Analyse the DAC Cmd register}
|
|
procedure testdaccmdAnal(m:word);
|
|
const
|
|
msk:array[0..3] of byte=($55,$AA,$5A,$A5);
|
|
var
|
|
stop:boolean;
|
|
mask,x,y,z,i,mk,cmd,chg:word;
|
|
res0:array[0..39] of byte;
|
|
res:array[byte] of byte;
|
|
t:text;
|
|
s:string;
|
|
|
|
function DacBit(cmd:integer):integer;
|
|
begin
|
|
dac2comm;
|
|
outp($3C6,cmd);
|
|
dac2pel;
|
|
dac2comm;
|
|
DacBit:=inp($3C6);
|
|
dac2pel;
|
|
end;
|
|
|
|
begin
|
|
if InitMode(m) then
|
|
begin
|
|
for x:=0 to 3 do
|
|
begin
|
|
dac2pel;
|
|
outp($3C6,msk[x]);
|
|
dac2pel;
|
|
for y:=0 to 9 do res0[x*10+y]:=inp($3C6);
|
|
dac2pel;
|
|
end;
|
|
dac2pel;
|
|
outp($3C6,$FF);
|
|
setdacstd;
|
|
SetTextMode;
|
|
|
|
x:=DacBit(0);
|
|
mk:=0;
|
|
for x:=0 to 7 do
|
|
begin
|
|
y:=1 shl x;
|
|
z:=DacBit(y);
|
|
mk:=mk+(z and y);
|
|
end;
|
|
clearDACpage;
|
|
setdacstd; {Write the data several times in case we lock up...}
|
|
SetTextMode;
|
|
|
|
if cv.chip=__cir54 then i:=$FD else i:=$FF;
|
|
if cv.dactype=_dacTR8001 then i:=$FB;
|
|
x:=0;y:=255;z:=255;
|
|
for cmd:=0 to 255 do
|
|
begin
|
|
res[cmd]:=DacBit(cmd and i);
|
|
x:=x or res[cmd];
|
|
y:=y and res[cmd];
|
|
z:=z and (res[cmd] xor not cmd);
|
|
end;
|
|
chg:=z and (x and not y);
|
|
mask:=i;
|
|
end;
|
|
clearDACpage;
|
|
setdacstd;
|
|
SetTextMode;
|
|
OpenLog(true);
|
|
wrlog( ' DAC Command register read test:');
|
|
wrlog( 'Read: $55 $AA $5A $A5');
|
|
for i:=0 to 9 do
|
|
wrlog(' '+chr(i+48)+' '+hex2(res0[i])+' '+hex2(res0[i+10])
|
|
+' '+hex2(res0[i+20])+' '+hex2(res0[i+30]));
|
|
wrlog('');
|
|
wrlog('Dac Single Bit Mask: '+hex2(mk));
|
|
wrlog('');
|
|
wrlog('DAC mask: '+hex2(mask)+'h R/W: '+hex2(z)+'h Chg: '+hex2(chg)
|
|
+' Set: '+hex2(y)+'h Clear: '+hex2(not x)+'h');
|
|
z:=z or chg;
|
|
s:='';
|
|
for i:=0 to 255 do
|
|
if ((res[i] xor i) and z)<>0 then
|
|
s:=s+' '+hex2(i)+' = '+hex2(res[i])+' ';
|
|
wrlog(s);
|
|
closelog;
|
|
if readkey='' then;
|
|
end;
|
|
|
|
{DAC test master menu}
|
|
procedure testdac;
|
|
var i,md:word;
|
|
stop:boolean;
|
|
begin
|
|
md:=0;
|
|
for i:=1 to nomodes do
|
|
if ((modetbl[i].flags AND MFL_enGr)=MFL_enGr) AND (modetbl[i].memmode=_p8)
|
|
and (modetbl[i].xres=640) and (modetbl[i].yres=480) then md:=i;
|
|
stop:=false;
|
|
repeat
|
|
SetTextMode;
|
|
writeln('DAC test options:');
|
|
writeln(' 2 - Test 24bit (16Mcolor) mode');
|
|
writeln(' 3 - Test 32bit (16Mcolor RGBa) mode');
|
|
writeln(' 5 - Test 15bit (32Kcolor) mode');
|
|
writeln(' 6 - Test 16bit (64Kcolor) mode');
|
|
writeln(' 8 - Test 6/8bit mode');
|
|
writeln(' A - DAC Cmd register Analysis');
|
|
writeln(' C - Test Command register');
|
|
writeln(' G - Test Gamma Correction');
|
|
writeln(' M - Select base mode');
|
|
writeln(' 0 - Return to main menu');
|
|
|
|
case getkey of
|
|
ord('2'):testdac24(md);
|
|
ord('3'):testdac32(md);
|
|
ord('5'):testdac15(md);
|
|
ord('6'):testdac16(md);
|
|
ord('8'):testdac8(md);
|
|
ord('a'),ord('A'):testdaccmdAnal(md);
|
|
ord('c'),ord('C'):testdaccmd(md);
|
|
ord('g'),ord('G'):testDACgamma;
|
|
ord('m'),ord('M'):begin
|
|
writeln;
|
|
for i:=1 to nomodes do
|
|
if ((modetbl[i].flags and MFL_enGr)=MFL_enGr)
|
|
and (modetbl[i].memmode=_P8) then
|
|
writeln(' '+menuchars[i]+' '+hex4(modetbl[i].md)+'h '
|
|
+istr(modetbl[i].xres)+'x'+istr(modetbl[i].yres)
|
|
+' '+mdtxt[modetbl[i].memmode]);
|
|
write('Select mode: ');
|
|
i:=getmenkey;
|
|
if (i>0) and (i<=nomodes) and (modetbl[i].memmode=_P8) then md:=i;
|
|
end;
|
|
ord('0'),Ch_Esc:stop:=true;
|
|
end;
|
|
until stop;
|
|
|
|
end;
|
|
|
|
|
|
procedure testvgamodes; {Test extended modes}
|
|
var m:word;
|
|
md,x:integer;
|
|
|
|
function tmode(m:word):boolean;
|
|
begin
|
|
tmode:=true;
|
|
|
|
if auto_test then
|
|
begin
|
|
fillchar(af_rec,sizeof(af_rec),0);
|
|
af_cmt:='';
|
|
end;
|
|
|
|
if InitMode(m) then tmode:=testvmode;
|
|
|
|
if auto_test then
|
|
begin
|
|
af_rec.mode :=modetbl[m].md;
|
|
af_rec.Mmode :=memmode;
|
|
af_rec.pixels:=pixels;
|
|
af_rec.lins :=lins;
|
|
af_rec.bytes :=bytes;
|
|
af_rec.crtc :=crtc;
|
|
AddAFBuf(af_rec,sizeof(af_rec));
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
inc(af_pos,FormatRgs(af_buf[af_pos]));
|
|
|
|
WrAFbuf(AF_modeinfo);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
textmode($103);
|
|
writeln('Test extended VGA modes.');
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to nomodes do {Not the Std VGA modes}
|
|
if ((modetbl[m].flags and MFL_enVGA)=MFL_enabled) then
|
|
writeln(' '+menuchars[m]+' '+hex4(modetbl[m].md)+'h '+istr(modetbl[m].xres)
|
|
+'x'+istr(modetbl[m].yres)+' '+mdtxt[modetbl[m].memmode]);
|
|
writeln;
|
|
|
|
writeln(' * All modes');
|
|
if auto_test then pushkey(ord('*'));
|
|
writeln;
|
|
x:=getmenkey;
|
|
for m:=1 to nomodes do
|
|
if ((x=0) or (x=m)) and ((modetbl[m].flags and MFL_enGrVGA)=MFL_enGr) then
|
|
if not tmode(m) then x:=-1; {stop}
|
|
end;
|
|
|
|
procedure teststdvgamodes; {Test standard VGA modes}
|
|
var m:word;
|
|
md,x:integer;
|
|
|
|
function tmode(m:word):boolean;
|
|
begin
|
|
|
|
if auto_test then
|
|
begin
|
|
fillchar(af_rec,sizeof(af_rec),0);
|
|
af_cmt:='';
|
|
end;
|
|
|
|
|
|
if InitMode(m) then tmode:=testvmode;
|
|
|
|
if auto_test then
|
|
begin
|
|
af_rec.mode :=stdmodetbl[m].md;
|
|
af_rec.Mmode :=memmode;
|
|
af_rec.pixels:=pixels;
|
|
af_rec.lins :=lins;
|
|
af_rec.bytes :=bytes;
|
|
af_rec.crtc :=crtc;
|
|
AddAFBuf(af_rec,sizeof(af_rec));
|
|
AddAFbuf(af_cmt,length(af_cmt)+1);
|
|
inc(af_pos,FormatRgs(af_buf[af_pos]));
|
|
WrAFbuf(AF_modeinfo);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
textmode($103);
|
|
writeln('Standard VGA mode test.');
|
|
writeln;
|
|
writeln('Modes:');
|
|
writeln;
|
|
for m:=1 to novgamodes do
|
|
begin
|
|
writeln(' '+menuchars[m]+' '+hex4(stdmodetbl[m].md)+'h '+istr(stdmodetbl[m].xres)
|
|
+'x'+istr(stdmodetbl[m].yres)+' '+mdtxt[stdmodetbl[m].memmode]);
|
|
end;
|
|
writeln;
|
|
writeln(' * All modes');
|
|
|
|
writeln;
|
|
if auto_test then pushkey(ord('*'));
|
|
x:=getmenkey;
|
|
for m:=1 to novgamodes do
|
|
if (x=0) or (x=m) then
|
|
if not tmode(m) then x:=-1;
|
|
|
|
end;
|
|
|
|
|
|
procedure searchformodes; {Run through all possible modes
|
|
and try to id any new ones}
|
|
type
|
|
regblk=record
|
|
base:word;
|
|
nbr:word;
|
|
x:array[0..255] of byte;
|
|
end;
|
|
var
|
|
md,m,hig,wid,x,y,oldbytes,wordadr:word;
|
|
c:char;
|
|
ofil:text;
|
|
attregs:array[0..31] of byte;
|
|
seqregs,grcregs,crtcregs,xxregs:regblk;
|
|
stdregs:array[$3C0..$3DF] of byte;
|
|
l:longint;
|
|
s:string;
|
|
stop:boolean;
|
|
|
|
|
|
procedure dumprg(base:word;var rg:regblk);
|
|
var six,ix:word;
|
|
begin
|
|
rg.base:=base;
|
|
six:=inp(base);
|
|
outp(base,0);
|
|
ix:=inp(base) xor 255;
|
|
outp(base,255);
|
|
ix:=ix and inp(base);
|
|
|
|
if ix>127 then rg.nbr:=255
|
|
else if ix>63 then rg.nbr:=127
|
|
else if ix>31 then rg.nbr:=63
|
|
else if ix>15 then rg.nbr:=31
|
|
else if ix>7 then rg.nbr:=15
|
|
else rg.nbr:=7;
|
|
for ix:=0 to rg.nbr do
|
|
rg.x[ix]:=rdinx(base,ix);
|
|
outp(base,six);
|
|
end;
|
|
|
|
|
|
|
|
|
|
begin
|
|
md:=$14;
|
|
stop:=false;
|
|
while (md<$80) and not stop do
|
|
begin
|
|
textmode(3);
|
|
gotoxy(10,10);
|
|
write('Testing mode: '+hex2(md));
|
|
delay(500);
|
|
if setmode(md,true) then
|
|
begin
|
|
pixels :=calcpixels;
|
|
lins :=calclines;
|
|
bytes :=calcbytes;
|
|
vseg :=calcvseg;
|
|
memmode:=calcmmode;
|
|
repeat
|
|
oldbytes:=bytes;
|
|
|
|
if setmode(md,true) and testvmode then
|
|
begin
|
|
{ drawtestpattern('Mode: '+hex2(md)+' ('+istr(pixels)+'x'+istr(lins)+' '
|
|
+mmodenames[memmode]+') '+istr(bytes)+' bytes.'); }
|
|
end;
|
|
|
|
(* case getkey of
|
|
Ch_PgUp:bytes:=bytes shl 1;
|
|
Ch_PgDn:bytes:=bytes shr 1;
|
|
Ch_ArUp:inc(bytes);
|
|
Ch_ArDown:dec(bytes);
|
|
Ch_Esc:stop:=true;
|
|
end; *)
|
|
until bytes=oldbytes;
|
|
end;
|
|
inc(md);
|
|
end;
|
|
textmode(3);
|
|
end;
|
|
|
|
|
|
|
|
var
|
|
stop:boolean;
|
|
|
|
function ljust(s:string;lnn:word):string;
|
|
begin
|
|
ljust:=copy(s+' ',1,lnn);
|
|
end;
|
|
|
|
function rjust(s:string;lnn:word):string;
|
|
begin
|
|
if length(s)<lnn then s:=copy(' ',1,lnn-length(s))+s;
|
|
rjust:=s;
|
|
end;
|
|
|
|
function chkptr(w:word):word;
|
|
begin
|
|
if memw[Seg0000:w+2]=biosseg then chkptr:=memw[Seg0000:w]
|
|
else chkptr:=0;
|
|
end;
|
|
|
|
function fntadr(BH:word):word;
|
|
begin
|
|
rp.bh:=BH;
|
|
vio($1130);
|
|
if rp.es=biosseg then fntadr:=rp.bp
|
|
else fntadr:=0;
|
|
end;
|
|
|
|
procedure wrAFff;
|
|
var
|
|
rhdr:_ATff;
|
|
x,y,z,v:word;
|
|
begin
|
|
if {af_fail and} (biosseg<>0) then
|
|
begin
|
|
fillchar(rhdr,sizeof(rhdr),0);
|
|
rhdr.base :=biosseg;
|
|
rhdr.size :=mem[biosseg:2];
|
|
rhdr.int10:=chkptr($40);
|
|
rhdr.int6D:=chkptr($1B4);
|
|
rhdr.m4A8 :=chkptr($4A8);
|
|
rhdr.fnt14 :=fntadr(2);
|
|
rhdr.fnt8l :=fntadr(3);
|
|
rhdr.fnt8h :=fntadr(4);
|
|
rhdr.fnt14x9:=fntadr(5);
|
|
rhdr.fnt16 :=fntadr(6);
|
|
rhdr.fnt16x9:=fntadr(7);
|
|
AddAFbuf(rhdr,sizeof(rhdr));
|
|
WrAFbuf(AF_BIOSdmp);
|
|
y:=0;z:=0;
|
|
for x:=0 to (rhdr.size*512-1) do
|
|
begin
|
|
v:=mem[biosseg:x];
|
|
af_buf[z]:=v-y;
|
|
y:=v;
|
|
inc(z);
|
|
if z>=2000 then
|
|
begin
|
|
blockwrite(af_fil,af_buf,z);
|
|
z:=0;
|
|
end;
|
|
end;
|
|
blockwrite(af_fil,af_buf,z);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure ReCalc(rfil:string);
|
|
var f:file;
|
|
t:text;
|
|
at0:_AT0;
|
|
at2:_AT2;
|
|
buf:array[0..2000] of byte;
|
|
hdr:record
|
|
typ:byte;
|
|
lnn:word;
|
|
end;
|
|
fpos:longint;
|
|
ix,x,y,z,w:word;
|
|
s:string[5];
|
|
|
|
function popb:word;
|
|
begin
|
|
popb:=buf[ix];
|
|
inc(ix);
|
|
end;
|
|
|
|
function popw:word;
|
|
var w:word;
|
|
begin
|
|
move(buf[ix],w,2);
|
|
inc(ix,2);
|
|
popw:=w;
|
|
end;
|
|
|
|
procedure stinx(base,ix,vl:word);
|
|
begin
|
|
case base of
|
|
$3C0:rgs.attregs[ix]:=vl;
|
|
$3C4:begin
|
|
rgs.seqregs.x[ix]:=vl;
|
|
if ix>rgs.seqregs.nbr then rgs.seqregs.nbr:=ix;
|
|
end;
|
|
$3CE:begin
|
|
rgs.grcregs.x[ix]:=vl;
|
|
if ix>rgs.grcregs.nbr then rgs.grcregs.nbr:=ix;
|
|
end;
|
|
$3B4,
|
|
$3D4:begin
|
|
rgs.crtcregs.x[ix]:=vl;
|
|
if ix>rgs.crtcregs.nbr then rgs.crtcregs.nbr:=ix;
|
|
end;
|
|
else
|
|
rgs.xxregs.base:=base;
|
|
rgs.xxregs.x[ix]:=vl;
|
|
if ix>rgs.xxregs.nbr then rgs.xxregs.nbr:=ix;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if pos('.',rfil)=0 then rfil:=rfil+'.tst';
|
|
assign(f,rfil);
|
|
{$i-}
|
|
reset(f,1);
|
|
{$i+}
|
|
if ioresult=0 then
|
|
begin
|
|
rfil[0]:=chr(pred(pos('.',rfil)));
|
|
assign(t,rfil+'.tt');
|
|
rewrite(t);
|
|
fpos:=0;vids:=0;
|
|
repeat
|
|
blockread(f,hdr,3);
|
|
case hdr.typ of
|
|
0:blockread(f,at0,sizeof(_AT0));
|
|
1:begin
|
|
inc(vids);
|
|
blockread(f,vid[vids],sizeof(vid[1]));
|
|
if vids=at0.cur_vid then SelectVideo(vids);
|
|
end;
|
|
2:begin
|
|
blockread(f,at2,sizeof(at2));
|
|
blockread(f,buf,hdr.lnn-sizeof(at2)-3);
|
|
ix:=buf[0]+1;
|
|
repeat
|
|
w:=popw;
|
|
case w of
|
|
1:begin
|
|
w:=popw;
|
|
x:=popb;y:=popb;
|
|
for x:=x to y do stinx(w,x,popb);
|
|
end;
|
|
2..$FE:begin
|
|
x:=popw;
|
|
for x:=x to x+w-1 do
|
|
begin
|
|
y:=popb;
|
|
if (x>=$3C0) and (x<$3DF) then rgs.stdregs[x]:=y;
|
|
if (x>=$3B0) and (x<$3BF) then rgs.stdregs[x+$20]:=y;
|
|
end;
|
|
end;
|
|
$ff:begin
|
|
w:=popw;
|
|
x:=popb;
|
|
case w of
|
|
0:rgs.tridold0d:=x;
|
|
1:rgs.tridold0e:=x;
|
|
end;
|
|
end;
|
|
else
|
|
x:=popb;
|
|
if (w>=$3C0) and (w<$3DF) then rgs.stdregs[w]:=x;
|
|
if (w>=$3B0) and (w<$3BF) then rgs.stdregs[w+$20]:=x;
|
|
end;
|
|
until w=0;
|
|
if (at2.flag and 1)>0 then
|
|
begin
|
|
CalcRegisters;
|
|
if (at2.mmode=rgs.mmode) and (at2.pixels=rgs.pixels)
|
|
and (at2.lins=rgs.lins) and (at2.bytes=rgs.bytes) then s:=' Ok' else s:='';
|
|
writeln(t,hex4(at2.mode),at2.pixels:5,at2.lins:5,at2.bytes:5
|
|
,' '+mmodenames[at2.mmode]+' vs. '
|
|
,rgs.pixels:5,rgs.lins:5,rgs.bytes:5
|
|
,' '+mmodenames[rgs.mmode]+s);
|
|
end;
|
|
end;
|
|
end;
|
|
inc(fpos,hdr.lnn);
|
|
seek(f,fpos);
|
|
until hdr.typ>2;
|
|
close(t);
|
|
close(f);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure testdacbits;
|
|
var
|
|
dac0,dac1,dac2,dac3:byte;
|
|
pt,ix,i,old:integer;
|
|
s:string;
|
|
begin
|
|
settextmode;
|
|
write('Base register (hex): ');
|
|
readln(s);
|
|
pt:=dehex(s);
|
|
write('Index (hex 0-FFh): ');
|
|
readln(s);
|
|
ix:=dehex(s);
|
|
dac0:=inp($3C8);
|
|
dac1:=inp($3C9);
|
|
dac2:=inp($3C6);
|
|
dac3:=inp($3C7);
|
|
old:=rdinx(pt,Ix);
|
|
writeln('Original: '+hex2(dac0)+' '+hex2(dac1)+' '+hex2(dac2)+' '+hex2(dac3));
|
|
for i:=0 to 7 do
|
|
begin
|
|
wrinx(pt,Ix,old xor (1 shl i));
|
|
dac0:=inp($3C8);
|
|
dac1:=inp($3C9);
|
|
dac2:=inp($3C6);
|
|
dac3:=inp($3C7);
|
|
wrinx(pt,Ix,old);
|
|
writeln(' Bit ',i,': '+hex2(dac0)+' '+hex2(dac1)+' '+hex2(dac2)+' '+hex2(dac3));
|
|
end;
|
|
if readkey='' then;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
var
|
|
chp:byte;
|
|
md,x,y,b:integer;
|
|
s,fea:string;
|
|
iteration,err,sel,clks:word;
|
|
t:text;
|
|
ok:boolean;
|
|
devs:array[1..10] of string[80];
|
|
|
|
rcfil:string;
|
|
ignlist:string; {Chips we ignore}
|
|
PCIenable:boolean;
|
|
|
|
function mmode(s:string):integer;
|
|
var x:byte;
|
|
begin
|
|
mmode:=__None;
|
|
for x:=_text to _p32d do {Remember to update}
|
|
if s=strip(mmodenames[x]) then
|
|
mmode:=x;
|
|
end;
|
|
|
|
function FindChp(s:string):integer;
|
|
var chp:integer;
|
|
begin
|
|
FindChp:=__None;
|
|
s:=strip(upstr(s));
|
|
for chp:=__none to max_chip do
|
|
if upstr(header[chp])=s then
|
|
FindChp:=chp;
|
|
end;
|
|
|
|
procedure initcfg; {Reset the configuration}
|
|
begin
|
|
force_mm:=0;
|
|
force_chip:=__none;
|
|
force_version:=0;
|
|
auto_test:=false;
|
|
clocktest:=true; {allow clock testing}
|
|
debug:=false;
|
|
PCIenable:=true;
|
|
ignlist:='';
|
|
fillchar(dotest,sizeof(dotest),ord(true)); {allow test for all chips}
|
|
noumodes:=0;
|
|
end;
|
|
|
|
begin
|
|
{$ifdef ver70}
|
|
test8086:=1; {force 286, 386 mode buggy}
|
|
{$endif}
|
|
initcfg;
|
|
|
|
clrscr;
|
|
assign(t,'whatvga.cfg');
|
|
{$i-}
|
|
reset(t); {Check if the file exists}
|
|
{$i+}
|
|
if ioresult=0 then
|
|
begin
|
|
cv.chip:=__None;
|
|
writeln('Configuration file found!');
|
|
while not eof(t) do
|
|
begin
|
|
readln(t,s);
|
|
if cv.chip=__None then {Initial section}
|
|
begin
|
|
x:=pos('=',s);
|
|
if x>0 then
|
|
begin
|
|
fea:=upstr(strip(copy(s,1,x-1))); {keyword}
|
|
s:=strip(copy(s,x+1,255)); {value}
|
|
if (upstr(s)='YES') or (upstr(s)='ON') or
|
|
(upstr(s)='Y') or (upstr(s)='1') then ok:=true
|
|
else ok:=false;
|
|
if fea='AUTOTEST' then auto_test:=ok;
|
|
if fea='CLOCKTEST' then clocktest:=ok;
|
|
if fea='DEBUG' then debug:=ok;
|
|
if fea='PCITEST' then PCIenable:=ok;
|
|
if fea='MEMORY' then val(s,force_mm,err);
|
|
if fea='IGNORE' then
|
|
begin
|
|
chp:=FindChp(upstr(s));
|
|
if chp<>__None then
|
|
begin
|
|
dotest[chp]:=false;
|
|
ignlist:=ignlist+' '+header[chp];
|
|
end;
|
|
end;
|
|
if fea='CHIPSET' then
|
|
begin
|
|
chp:=FindChp(upstr(s));
|
|
fillchar(dotest,sizeof(dotest),ord(false)); {Disable all tests}
|
|
if chp<>__None then
|
|
begin
|
|
dotest[chp]:=true;
|
|
force_chip:=chp;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
if s[1]='-' then
|
|
begin
|
|
delete(s,1,1);
|
|
md:=dehex(clipstr(s));
|
|
inc(noumodes);
|
|
usermodes[noumodes].md :=md;
|
|
usermodes[noumodes].memmode:=__None; {Disable}
|
|
usermodes[noumodes].flags :=cv.chip;
|
|
end
|
|
else if s[1]='+' then
|
|
begin
|
|
delete(s,1,1);
|
|
md:=dehex(clipstr(s));
|
|
val(clipstr(s),x,err);
|
|
val(clipstr(s),y,err);
|
|
chp:=mmode(clipstr(s));
|
|
val(clipstr(s),b,err);
|
|
inc(noumodes);
|
|
usermodes[noumodes].md :=md;
|
|
usermodes[noumodes].xres :=x;
|
|
usermodes[noumodes].yres :=y;
|
|
usermodes[noumodes].bytes :=b;
|
|
usermodes[noumodes].memmode:=chp;
|
|
usermodes[noumodes].flags :=cv.chip;
|
|
end;
|
|
|
|
if s[1]='[' then
|
|
cv.chip:=FindChp(copy(s,2,pos(']',s)-2));
|
|
end;
|
|
close(t);
|
|
end;
|
|
|
|
rcfil:='';
|
|
for x:=1 to paramcount do
|
|
begin
|
|
s:=upstr(paramstr(x))+' ';
|
|
case s[1] of
|
|
'-':begin
|
|
chp:=FindChp(copy(s,2,255));
|
|
if chp<>__None then
|
|
begin
|
|
dotest[chp]:=false;
|
|
ignlist:=ignlist+' '+header[chp];
|
|
end;
|
|
end;
|
|
'+':begin
|
|
chp:=FindChp(copy(s,2,255));
|
|
fillchar(dotest,sizeof(dotest),ord(false));
|
|
if chp<>__None then
|
|
begin
|
|
dotest[chp]:=true;
|
|
force_chip:=chp;
|
|
end;
|
|
end;
|
|
'=':val(strip(copy(s,2,255)),force_mm,err);
|
|
'/':case upcase(s[2]) of
|
|
'A':auto_test:=true;
|
|
'C':clocktest:=false;
|
|
'I':initcfg;
|
|
'D':debug:=true;
|
|
'T':rcfil:=strip(copy(s,3,255));
|
|
'V':begin
|
|
val(strip(copy(s,3,255)),y,err);
|
|
if err=0 then force_version:=y;
|
|
end;
|
|
'P':PCIenable:=false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if rcfil<>'' then
|
|
begin
|
|
ReCalc(rcfil);
|
|
halt(0);
|
|
end;
|
|
|
|
if (force_mm<>0) or (force_chip<>__none) or (force_version<>0)
|
|
or (ignlist<>'') then
|
|
begin
|
|
if force_mm<>0 then writeln('Memory forced to: '+istr(force_mm)+'K');
|
|
if force_chip<>__none then writeln('Chip forced to: '+header[force_chip]);
|
|
if force_version<>0 then writeln('Chips version forced to: ',force_version);
|
|
if ignlist<>'' then writeln('Chips to ignore:'+ignlist);
|
|
writeln;
|
|
writeln('Press a key to continue...');
|
|
if readkey='' then;
|
|
clrscr;
|
|
end;
|
|
|
|
|
|
|
|
if PCIenable then findPCI;
|
|
findvideo;
|
|
settextmode;
|
|
|
|
for x:=1 to vids do
|
|
begin
|
|
SelectVideo(x);
|
|
fea:='';
|
|
if (cv.features and ft_cursor)>0 then fea:=' C';
|
|
if (cv.features and ft_blit )>0 then fea:=fea+' B';
|
|
if (cv.features and ft_line )>0 then fea:=fea+' L';
|
|
if (cv.features and ft_rwbank)>0 then fea:=fea+' R';
|
|
devs[x]:=' '+istr(x)+' '+ljust(chipnam[cv.chip],9)
|
|
+rjust(istr(cv.mm),8)+ljust(fea,8)+' '+vid[x].name;
|
|
end;
|
|
|
|
|
|
iteration:=0;
|
|
repeat
|
|
stop:=false;
|
|
if vids<>1 then
|
|
begin
|
|
SetTextMode;
|
|
writeln(wrVersionNbr+copyright);
|
|
writeln;
|
|
writeln('Multiple Video Interfaces or Adapters found!!');
|
|
writeln('Please select the one to test:');
|
|
writeln(' Chip: Memory: Feat: Name:');
|
|
for x:=1 to vids do writeln(devs[x]);
|
|
writeln;
|
|
writeln(' 0 Stop');
|
|
writeln;
|
|
sel:=getkey-ord('0');
|
|
if sel=0 then stop:=true;
|
|
end
|
|
else sel:=1;
|
|
if (sel>0) and (sel<=vids) then SelectVideo(sel);
|
|
|
|
while not stop do
|
|
begin
|
|
SetTextMode;
|
|
writeln(wrVersionNbr+copyright);
|
|
writeln;
|
|
|
|
write('Video system: ',chipnam[cv.chip],' with '+istr(cv.mm)+' Kbytes');
|
|
if cv.SubVers<>0 then write(' Version: '+hex4(cv.SubVers));
|
|
writeln;
|
|
if cv.name<>'' then writeln('Name: '+cv.name);
|
|
writeln('Dac: '+cv.dacname);
|
|
writeln('Clock: '+clkname[cv.clktype]);
|
|
case cv.clktype of
|
|
clk_ext2:clks:=4;
|
|
clk_ext3:clks:=8;
|
|
clk_ext4:clks:=16;
|
|
clk_ext5:clks:=32;
|
|
clk_ext6:clks:=64;
|
|
else clks:=4;
|
|
end;
|
|
if clks>0 then
|
|
begin
|
|
for x:=0 to clks-1 do
|
|
begin
|
|
if (x and 7)=0 then
|
|
begin
|
|
if x>0 then writeln;
|
|
write(' ');
|
|
end;
|
|
write(cv.clks[x]/1000:8:3);
|
|
end;
|
|
writeln;
|
|
end;
|
|
|
|
if cv.features<>0 then
|
|
begin
|
|
write('Special features:');
|
|
if (cv.features and ft_cursor)<>0 then write(' Cursor');
|
|
if (cv.features and ft_blit)<>0 then write(' BitBlt');
|
|
if (cv.features and ft_line)<>0 then write(' Line');
|
|
if (cv.features and ft_rwbank)<>0 then write(' RW-bank');
|
|
writeln;
|
|
end;
|
|
|
|
writeln;
|
|
if (cv.flags and FLG_StdVGA)>0 then
|
|
writeln(' 1 Test Standard VGA modes');
|
|
writeln(' 2 Test Extended modes');
|
|
if (cv.chip<>__vesa) and (cv.chip<>__XBE) then
|
|
writeln(' 3 Search for video modes');
|
|
if (cv.features and ft_cursor)<>0 then
|
|
writeln(' 5 HardWare Cursor test');
|
|
if (cv.features and ft_blit)<>0 then
|
|
writeln(' 6 HardWare BitBLT test');
|
|
if (cv.features and ft_line)<>0 then
|
|
writeln(' 7 Line Draw test');
|
|
if (cv.features and ft_rwbank)<>0 then
|
|
writeln(' 8 R/W bank test');
|
|
|
|
writeln;
|
|
writeln(' B Individual bit functionality');
|
|
writeln(' D DAC test submenu');
|
|
writeln(' R Read/Writable registers');
|
|
|
|
writeln;
|
|
writeln(' 0 Stop');
|
|
writeln;
|
|
|
|
if auto_test then
|
|
begin
|
|
inc(iteration);
|
|
pushkey(Ch_Cr); {No Operation, just step on}
|
|
case iteration of
|
|
1:begin
|
|
InitAFfile(sel);
|
|
for x:=1 to vids do
|
|
begin
|
|
AddAFbuf(vid[x],sizeof(vid[1]));
|
|
WrAFbuf(AF_videosys);
|
|
end;
|
|
if (cv.chip<>__vesa) and (cv.chip<>__XBE) then pushkey(ord('1'));
|
|
end;
|
|
2:pushkey(ord('2'));
|
|
3:if (cv.features and ft_cursor)<>0 then pushkey(ord('5'));
|
|
4:if (cv.features and ft_blit)<>0 then pushkey(ord('6'));
|
|
5:if (cv.features and ft_line)<>0 then pushkey(ord('7'));
|
|
6:if (cv.features and ft_rwbank)<>0 then pushkey(ord('8'));
|
|
7:pushkey(ch_esc);
|
|
|
|
end;
|
|
end;
|
|
|
|
case getkey of
|
|
ord('1'):teststdvgamodes;
|
|
ord('2'):testvgamodes;
|
|
ord('3'):searchformodes;
|
|
ord('5'):testcursor;
|
|
ord('6'):testblit;
|
|
ord('7'):testline;
|
|
ord('8'):testrwbank;
|
|
ord('9'):testzoom;
|
|
ord('a'),ord('A'):auto_test:=true;
|
|
ord('b'),ord('B'):testbits;
|
|
ord('d'),ord('D'):testdac;
|
|
ord('r'),ord('R'):testregs;
|
|
ord('t'),ord('T'):testdacbits;
|
|
|
|
|
|
ord('0'):stop:=true;
|
|
Ch_Esc:begin
|
|
stop:=true;
|
|
sel:=0;
|
|
end;
|
|
end;
|
|
end;
|
|
if vids<=1 then sel:=0;
|
|
until sel=0;
|
|
|
|
SetTextMode;
|
|
vio(3); {Standard mode 3 80x25 text}
|
|
|
|
if auto_test then
|
|
begin
|
|
wrAFff;
|
|
close(af_fil);
|
|
writeln;
|
|
writeln('The test results are in the file: ',af_filename);
|
|
writeln;
|
|
writeln('For e-mail, modem etc the test file should be compressed');
|
|
writeln('(ZIP, ARJ...) savings of >40% are not uncommon.');
|
|
writeln;
|
|
writeln('For Email transport, remember that the test file is BINARY.');
|
|
|
|
end;
|
|
end.
|