Program de testare a posibilitatilor de lucru a placii grafice in standardul VESA

Program Testare_VESA;

uses dos;

type tmoduri=array[1..256] of word;

var imod,vseg,x,y:word; cbank,c:longint; rg:registers;

ntbanks:longint; opt:char;

vesabuf:record sign:longint; vers:word; oem:pchar;

capab:longint; list:^tmoduri;

reserv:array[1..512] of byte end;

vesamod:record attr:word; wina,winb:byte;

gran,winsiz,sega,segb:word; pagfun:pointer;

bytes,width,height:word;

charw,charh,planes,bits,nbanks,model,sbank,

nrimpg,reservb,rms,rfp,gms,gfs,bms,bfs:byte;

reserv:array[1..512] of byte end;

function hexa(v:word):string;

const s:string[16]='0123456789abcdef';

function hexb(b:byte):string;

begin

hexb:=s[b div 16+1]+s[b mod 16+1];

end;

begin

hexa:=hexb(hi(v))+hexb(lo(v));

end;

procedure setbank(b:longint);

begin

vseg:=$a000;

if b<>cbank then with rg,vesamod do begin

cbank:=b; ax:=$4f05; bx:=0;

dx:=b*64 div gran; intr(16,rg);

end;

end;

procedure putpixel(x,y:word; cul:longint);

var l:longint; m,z:word;

begin

with rg,vesamod do case bits of

4: begin

l:=longint(bytes)*y+x div 8;

port[$3ce]:=3; port[$3cf]:=0;

port[$3ce]:=5; port[$3cf]:=2;

port[$3ce]:=8; port[$3cf]:=128 shr (x and 7);

setbank(l shr 16);

z:=mem[vseg:word(l)]; mem[vseg:word(l)]:=cul;

end;

Proiect: Fisa de lucru - operatii cu numere intregi Referat: Jocuri didactice matematica - lantul buclucas

8: begin

l:=longint(bytes)*y+x; setbank(l shr 16);

mem[vseg:word(l)]:=cul;

end;

15,16: begin

l:=longint(bytes)*y+x*2; setbank(l shr 16);

memw[vseg:word(l)]:=cul;

end;

24: begin

l:=longint(bytes)*y+x*3;

z:=word(l); m:=l shr 16; setbank(m);

if z<$fffe then move(cul,mem[vseg:z],3)

else begin

mem[vseg:z]:=lo(cul);

if z=$ffff then setbank(m+1);

mem[vseg:z+1]:=lo(cul shr 8);

if z=$fffe then setbank(m+1);

mem[vseg:z+2]:=cul shr 16;

end;

end;

end;

end;

begin

with rg, vesabuf, vesamod do begin

ax:=$4f00; es:=seg(vesabuf); di:=ofs(vesabuf);

sign:=$41534556; intr(16,rg);

if al<>$4f then begin

writeln('Standardul VESA nu e implementat');

exit end;

imod:=1;

while list^[imod]<>$ffff do begin

ax:=3; intr(16,rg); ax:=$4f01; cx:=list^[imod];

es:=seg(vesamod); di:=ofs(vesamod);

intr(16,rg);

if attr and 16<>0 then begin

writeln(oem,' VESA Versiune ',hi(vers),'.',lo(vers));

writeln(hexa(list^[imod]),

' Rezolutie: ',width,' x ',height,

' Culori: ',longint(1) shl bits);

write('Doriti testare (D/N)? '); readln(opt);

end else opt:='N';

if upcase(opt)='D' then begin

ax:=$4f02; bx:=list^[imod];

intr(16,rg); cbank:=-1;

ntbanks:=longint(bytes)*height div gran div 1055;

for x:=0 to ntbanks do begin

setbank(x); mem[$a000:$ffff]:=0;

fillchar(mem[$a000:0],$ffff,0);

end;

case bits of

4,8: c:=15;

15: c:=32767;

16: c:=65535;

24: c:=longint(1) shl 24-1;

end;

for x:=0 to width-1 do begin

putpixel(x,0,c); putpixel(x,height-1,c);

end;

for y:=0 to height-1 do begin

putpixel(0,y,c); putpixel(width-1,y,c);

end;

for x:=0 to 191 do for y:=0 to 191 do begin

case bits of

4: c:=(y div 48)*4+x div 48;

8: c:=(y div 12)*4+x div 12;

15,16: c:=(y div 6)*(1 shl rfp)+x div 6;

24: c:=longint(x)*65536+y;

end;

putpixel(x+4,y+4,c);

end;

readln;

end;

inc(imod);

end;

ax:=3; intr(16,rg);

end;

end.