Tryb graficzny 13h
Wszyscy wiemy, że moduł Graph nie nadaje się do pisania gier, ponieważ jest wolny niczym żółw na środkach usypiających. Dlatego jeżeli masz ochotę napisać nową wersję Quake'a :) to zacznij od napisania własnego modułu do obsługi grafiki. Takie rozwiązanie ma dwie podstawowe zalety: a)procedury będą co najmniej 3 razy szybsze; b)będziesz dokładnie wiedział do czego służy dana procedura. Jednym z najprostszych w obsłudze trybem graficznym jest tryb tzw. 13h. Pozwala on tworzyć kolorową grafikę (256 kolorów) na ekranie o rozdzielczości 320x200 pikseli.
Aha i jeszcze jedno, aby zrozumieć cokolwiek z poniższego tekstu potrzebna jest znajomość chociaż podstaw asemblera.
Aby zainicjować tryb 13h należy posłużyć się niniejszą procedurą:
procedure Init13h;assembler;
asm
mov ax,13h {do rejestru AX przypisujemy wartość 13h (litera h przy wartości oznacz...}
{...że liczba podana jest w systemie szesnastkowym}
int 10h {i na ekran to (10h to przerywanie ekranu/video}
end;
Aby powrócić do trybu tekstowego wywołaj poniższa procedurę:
procedure Close13h;assembler;
asm
mov ax,03h {do AX wartość 03h}
int 10h {... i na ekran}
end;
OK, wiemy już jak zainicjować tryb 13h, więc przyszła pora na narysowanie pierwszego piksela, a do tego posłuży ta procedura:
procedure putpixel(x,y:word; color:byte);
begin
mem[$0A000:y*320+x]:=color; { $0A000 to adres pamięci ekrany. Następnie obliczamy ...}
{... przesunięci (offset) punktu ekranu, któremu ...
{... przypisujemy wartość koloru.}
end;
To było jedno rozwiązanie. Wygląda nieĽle, ale szybciej będzie tak:
procedure putpixel(x,y:word; color:byte); begin mem[$0a000:(x+(y shl 6)+(y shl 8))]:=color; end;
Powyższa procedura wykorzystuje obliczenia pascala do wyznaczenia offsetu. Nie jest to najszybsze rozwiązanie. Lepszy efekt daje zastosowanie poniższej procedury, która to do obliczenia offsetu wykorzystuje asemblera.
procedure PutPixel(x:word;y:word;color:byte);assembler;
asm
mov ax,0a000h {ładujemy rejestr segmentowy es adresem ekranu}
mov es,ax {ale nie można tego robić bezpośrednio}
mov di,x {do di offset punktu -> 320*y+x, wiec}
mov dx,y {(x+64*y+256*y), czyli (x+2^6*y+2^8*y)}
shl dx,6 {właśnie, przypomniałem sobie : }
add di,dx {nie wiem czy wiesz, więc mowie ->}
shl dx,2 {->wspołrzedne ekranu liczymy od zera!!!}
add di,dx {mamy więc [0..319]*[0..199]}
mov cl,color {do cl kolorek}
mov es:[di],cl {no i na ekran go :)))}
end;
!!! UWAGA !!! Aby przekompilował powyższą procedure, to musisz włączyć sobie 286 instructions w Options->Compiler, inaczej tego shl coś tam Pascal nie łyknie.
Teraz pora na dosyć przydatną funkcję Getpixel:
function getpixel(x,y:word):byte;
assembler;
asm
mov ax,y
mov bx,320
mul bx
add ax,x
{ax=y*320+x}
mov dx,0A000h
mov es,dx
mov di,ax
mov al,es:[di]
{Wynik w al=>wartosc funkcji}
end;
W wersji pascalowej powyższą procedurę można napisać tak (tylko jak to na Pascala przystało będzie to wolniejsze) :
function GetPixel(x,y:word):Byte;
begin
GetPixel:=Mem[$a000:x+(y*320)];
end;
end.
Jak już mówiłem na początku, w trybie 13h mamy do dyspozycji 256 kolorów. Co więcej możliwe jest zdefiniowanie tych kolorów samodzielnie. Przyjrzyj się poniższej procedurze, a wszystko stanie się jasne (mam nadzieję :))
procedure SetColor(index:byte;r:byte;g:byte;b:byte);assembler;
{index to numer koloru który chcesz zmienić -> masz kolory od zera do 255, więc}
{wielkość byte (dwa do ósmej) no bo byte (po naszemu bajt ;>) to osiem bitów, a bit}
{może mieć wartości zero lub jeden (zapalony lub nie). R,G,B to składowe tego}
{koloru, czyli zawartość barw czerwonej, zielonej, niebieskiej w naszym kolorze. Są}
{to wielkości byte, ale tak naprawdę to z przedziału od zera do sześćdziesięciu}
{trzech (dwa do szóstej). Jak wpiszesz więcej niż sześćdziesiąt trzy, to program}
{wykona operację (r mod 63)}
asm
mov dx,03c8h {do dx numer portu 03c8h}
mov al,index {do al numer koloru}
out dx,al {i wysyłamy na port z dx numer z al}
inc dx {zwiększamy o 1 dx}
mov al,r {do al składowa czerwona}
out dx,al {i wysyłamy}
mov al,g {i}
out dx,al {t}
mov al,b {d}
out dx,al {.}
end; {.}
To samo można zrobić bez asemblera. Mniej pisania ale wolniejszy efekt:
procedure SetColor(index:byte;r:byte;g:byte;b:byte); begin port[$03c8]:=index; port[$03c9]:=r; port[$03c9]:=g; port[$03c9]:=b; end;
Jak mamy procedurę SetColor, to przydała by się i GetColor. Więc oto ona w wersji asembler (choć nie do końca):
procedure GetColor(index:byte; var r,g,b:byte);
begin
asm
mov dx,03c7h
mov al,index
out dx,al
inc dx
inc dx
in al,dx
mov r1,al
in al,dx
mov g1,al
in al,dx
mov b1,al
end;
r:=r1;
g:=g1;
b:=b1;
{ojoj, to się porobiło...syf ta procedura, nie pokazuj jej nikomu, a na początek i to}
{starczy :) ale nie chce mi się nic kombinować...}
{Na konkurs to żaden nie jest a mi się fade'a zachciało małego na koniec...to trzeba by}
{w asmie do .obj zakodować, ale miał być pure paszczal}
end;
... i w wersji pascal:
procedure GetColor(color:Byte; var r,g,b:Byte); begin Port[$3c7]:=color; r:=Port[$3c9]; g:=Port[$3c9]; b:=Port[$3c9]; end;
Teraz cos jak repeat until keypressed tylko lepsze, no przynajmniej dla mnie bo wyrzucamu wczytany kod klawisza z bufora klawiatury. Bardzo przydatne.
procedure czekaj;assembler; asm @petla : mov ah,01h int 16h jnz @petla xor ah,ah int 16h end;
No to podstawy 13h mamy za sobą. Pora na bardziej zamotane procedury typu line czy circle. Zaczniemy od tej pierwszej. Jak zawsze w dwóch wersjach: Pascal:
Procedure line(x1,y1,x2,y2:word;color:byte);
Function sgn(a:real):integer;
BEGIN
if a>0 then sgn:=+1;
if a<0 then sgn:=-1;
if a=0 then sgn:=0;
END;
var s:real;
u,i,v,d1x,d1y,d2x,d2y,m,n:integer;
BEGIN
u:= x2 - x1;
v:= y2 - y1;
d1x:= SGN(u);
d1y:= SGN(v);
d2x:= SGN(u);
d2y:= 0;
m:= ABS(u);
n := ABS(v);
IF M<=N then
BEGIN
d2x := 0 ;
d2y := SGN(v);
m := ABS(v);
n := ABS(u);
END;
s := INT(m / 2);
FOR i := 0 TO m DO
BEGIN
putpixel(x1,y1,c);
s := s + n;
IF s>=m THEN
BEGIN
s := s - m;
x1:= x1 + d1x;
y1 := y1 + d1y;
END
ELSE
BEGIN
x1:=x1 + d2x;
y1:=y1 + d2y;
END;
END;
END;
i w wersji Asembler:
procedure Line(x1,y1,x2,y2:Integer; color:Byte);
var
wsk1,wsk2,podpr:word;
begin
asm
push si
push di
push es
mov ax,$a000
mov es,ax
mov si,320
mov cx,x2
sub cx,x1
jz @@VL
jns @@pdr1
neg cx
mov bx,x2
xchg bx,x1
mov x2,bx
mov bx,y2
xchg bx,y1
mov y2,bx
@@pdr1:
mov bx,y2
sub bx,y1
jz @@HL
jns @@pdr3
neg bx
neg si
@@pdr3:
push si
mov podpr,offset @@LL1
cmp bx,cx
jle @@pdr4
mov podpr,offset @@HL1
xchg bx,cx
@@pdr4:
shl bx,1
mov wsk1,bx
sub bx,cx
mov si,bx
sub bx,cx
mov wsk2,bx
push cx
mov ax,y1
mov bx,x1
xchg ah,al
add bx,ax
shr ax,1
shr ax,1
add bx,ax
mov di,bx
pop cx
inc cx
pop bx
jmp podpr
@@VL:
mov ax,y1
mov bx,y2
mov cx,bx
sub cx,ax
jge @@pdr31
neg cx
mov ax,bx
@@pdr31:
inc cx
mov bx,x1
push cx
xchg ah,al
add bx,ax
shr ax,1
shr ax,1
add bx,ax
pop cx
mov di,bx
dec si
mov al,color
@@pdr32:
stosb
add di,si
loop @@pdr32
jmp @@Exit
@@HL:
push cx
mov ax,y1
mov bx,x1
xchg ah,al
add bx,ax
shr ax,1
shr ax,1
add bx,ax
mov di,bx
pop cx
inc cx
mov al,color
rep stosb
jmp @@Exit
@@LL1:
mov al,color
@@pdr11:
stosb
or si,si
jns @@pdr12
add si,wsk1
loop @@pdr11
jmp @@Exit
@@pdr12:
add si,wsk2
add di,bx
loop @@pdr11
jmp @@Exit
@@HL1:
mov al,color
@@pdr21:
stosb
add di,bx
@@pdr22:
or si,si
jns @@pdr23
add si,wsk1
dec di
loop @@pdr21
jmp @@Exit
@@pdr23:
add si,wsk2
loop @@pdr21
@@Exit:
pop es
pop di
pop si
end;
end;
Jak widać nie jest to ani krótka, ani łatwa procedura, a i jej wykonywanie nie jest operacją stosunkowo krótką. Dlatego w miarę możliwości stosuje się Procedury takie jak: Vline (linia pionowa) i Hline (linia pozioma). Oto one:
procedure HLine;assembler;
asm
mov bx,&x
mov cx,&y
mov ax,0a000h
mov es,ax
xchg ch,cl
add bx,cx
shr cx,1
shr cx,1
add bx,cx
mov cx,l
mov dl,&c
@petla:
mov es:[bx],dl
inc bx
loop @petla
end;
procedure VLine;assembler;
asm
mov bx,&x
mov cx,&y
mov ax,0a000h
mov es,ax
xchg ch,cl
add bx,cx
shr cx,1
shr cx,1
add bx,cx
mov cx,l
mov dl,&c
@petla:
mov es:[bx],dl
add bx,320
loop @petla
end;
Procedura Circle w wersji Pascal wygląda tak:
procedure Circle(x,y,r:word; color:Byte);
var
deg : Real;
begin
deg:=0;
repeat
x:=Round(r*cos(deg));
y:=Round(r*sin(deg));
PutPixel(x+160,y+100,color);
deg:=deg+0.005;
until (deg>6.4);
end;
... a w wersji Asembler (choć nie do końca) tak:
procedure Circle(xc,yc,rc:word;color:byte);
begin
if rc=0 then begin plot(xc,yc,color); exit; end;
asm
push ds
mov cx,0
mov ax,rc
mov dx,1
sub dx,rc
@do:
push dx
push $a000
pop es
mov dx,yc
mov di,xc
xchg dh,dl
add di,dx
shr dx,2
add di,dx
{push yc+y}
push di
mov dx,ax
shl dx,6
add di,dx
shl dx,2
add di,dx
mov dl,color
mov bx,cx
mov es:[di+bx],dl
not bx
inc bx
mov es:[di+bx],dl
pop di
{push yc-y}
push di
mov dx,ax
not dx
inc dx
shl dx,6
add di,dx
shl dx,2
add di,dx
mov dl,color
mov bx,cx
mov es:[di+bx],dl
not bx
inc bx
mov es:[di+bx],dl
pop di
{push yc+x}
push di
mov dx,cx
shl dx,6
add di,dx
shl dx,2
add di,dx
mov dl,color
mov bx,ax
mov es:[di+bx],dl
not bx
inc bx
mov es:[di+bx],dl
pop di
{push yc-x}
push di
mov dx,cx
not dx
inc dx
shl dx,6
add di,dx
shl dx,2
add di,dx
mov dl,color
mov bx,ax
mov es:[di+bx],dl
not bx
inc bx
mov es:[di+bx],dl
pop di
pop dx
inc cx
cmp dx,0
jl @subd
dec ax
mov bx,cx
sub bx,ax
shl bx,1
add dx,bx
inc dx
jmp @cont
@subd:
mov bx,cx
shl bx,1
add dx,bx
inc dx
@cont:
cmp cx,ax
jna @do
pop ds
end;
end;
W module Graph występują jeszcze takie procedury jak bar, OutText oto one:
procedure Bar;assembler;
asm
mov bx,&x
mov cx,&y
mov ax,0a000h
mov es,ax
xchg ch,cl
add bx,cx
shr cx,1
shr cx,1
add bx,cx
mov cx,&y1
mov dl,&c
@p1:
push cx
mov cx,&x1
push bx
@p2:
mov es:[bx],dl
inc bx
inc si
loop @p2
pop bx
pop cx
add bx,320
loop @p1
end;
procedure OutText(txt:array of Char; x,y:Integer; color:Byte);
type
Tab = array [0..4080] of Byte;
var
WskTab : ^Tab;
k,i,b,j,Tekst_Seg,Tekst_Ofs : Integer;
Znak : Char;
Rej : Registers;
begin
Rej.AX:=$1124;
Rej.BL:=0;
Rej.DL:=200;
Intr($10,Rej);
Rej.AX:=$1130;
Rej.BH:=6;
Intr($10,Rej);
Tekst_Seg:=Rej.ES;
Tekst_Ofs:=Rej.BP;
WskTab:=Ptr(Tekst_Seg,Tekst_Ofs);
for k:=0 to SizeOf(Txt)-1 do
begin
znak:=Txt[k];
for j:=0 to 15 do
begin
b:=WskTab^[Ord(Znak)*16+j];
for i:=0 to 7 do
begin
if(b and 128)<>0 then PutPixel(x+i,y+j,color);
b:=b shl 1;
end;
end;
x:=x+8;
end;
end;
W naszym module przydały by się jeszcze takie procedury jak: ClearScreen, FadeDown i procedura, która zatrzymywała by program do czasu powrotu plamki (przydaje się to, gdy animacja generowana przez program "skacze"). Taką procedurą jest Wait (patrz poniżej).
procedure ClearScreen(color:Byte);
{czyści ekran w danym kolorze}
begin
FillChar(Mem[$a000:0],64000,color);
end;
procedure BlackAll;
{powoduje wyzerowanie całej palety, przez co wszystko staje się czarne}
var
i : Byte;
begin
for i:=0 to 255 do SetRGB(i,0,0,0);
end;
procedure Wait;
{opisana wyżej procedura zatrzymująca program na czas powrotu plamki}
assembler;
label
l1,l2;
asm
mov dx,3DAh
l1: in al,dx
and al,08h
jnz l1
l2: in al,dx
and al,08h
jz l2
end;
procedure FadeDown;
{stopniowe ściemnienie ekranu}
var
lo1,lo2 : Integer;
Tmp : array [1..3] of Byte;
begin
for lo1:=1 to 64 do
begin
Wait;
for lo2:=0 to 255 do
begin
GetRGB(lo2,Tmp[1],Tmp[2],Tmp[3]);
if Tmp[1]>0 then Dec(Tmp[1]);
if Tmp[2]>0 then Dec(Tmp[2]);
if Tmp[3]>0 then Dec(Tmp[3]);
SetRGB(lo2,Tmp[1],Tmp[2],Tmp[3]);
end;
end;
end;
Komentarze
- DariuszG
- ·
- 19-03-2012, 21:18
Kiedy będę chciał napisac grę w Pascalu zamiast uczyc się asemblera wejdę sobie na:http://allegro-pas.sourceforge.net/category/installation/ lub:http://www.freepascal-meets-sdl.net/.tryb 13H nadaje się do gier tak samo jak BGI z Turbo Pascala...teraz mamy kompilator Free Pascal a w nim można wiele...trzeba tylko chciec..
Aby dodawać komentarze musisz być zalogowany!