Tryb 13h
Każdy kto używał standardowej biblioteki graficznej Turbo Pascala, po pewnym czasie strasznie
się do niej zniechęcał. Jest ona strasznie wolna i ma małe możliwości. Od razu czujemy niedosyt
kolorów, ponieważ obsługuje ona ich tylko 16. I właśnie wtedy przychodzi czas na zajęcie się trybem 13h. Daje on nam 256 kolorów i dość dużą szybkość (dlatego, że jest napisana w asemblerze). Największą jego wadą jest niska rozdzielczość 320/200 pixeli. Możemy w nim
napisać wiele ciekawych efektów graficznych np. ogień (zajmiemy się nim w kolejnym odcinku).
Aby zainicjować tryb 13h należy do rejestru AX wprowadzić 0013H i wywołać przerwanie 10H służące do zmiany trybu
tekstowego na graficzny i odwrotnie.
Procedure Init13h; Assembler;
Asm;
MOV AX,0013H
INT 10H
End;
Na końcu programu musimy ZAWSZE wywołać ponownie tryb tekstowy.
Procedure end13h; Assembler;
Asm;
MOV AX,0003H
INT 10H
End;
W trybie 13h na 1 pixel przypada 1 bajt czyli cały "ekran" ma 64000 bajtów, (320*200) czyli zajmuje 1 segment pamięci. Dzięki temu znając adres tego segmentu bez problemu możemy napisać procedurę stawiającą na ekranie punkt.
Procedure PutPixel(x,y:integer;kolor:byte);
Begin
mem[$A000:Y*320+X]:=kolor;
End;
Procedura mem daje nam dostęp do pamięci operacyjnej (odczyt/zapis bajtu o podanym adresie) składnia: mem[segment:przesunięcie]
Żeby zrozumieć działanie tej procedury należy wiedzieć, że segment pamięci jest jakby jednowymiarową tablicą w której współrzędne x=100, y=100 (na ekranie) odpowiadają bajtowi o numerze 32100 (100*320+100). Więc żeby namalować na ekranie kropkę o współrzędnych x=50, y=50 należy do przesunięcia 50*320+50 (16050) w segmencie A000 wpisać numerek jednego z 256 kolorów.
Tak samo możemy odczytać kolor pixela z ekranu.
Function GetPixel(x,y: integer) : byte;
Begin
GetPixel:=MEM[$A000:y*320+x];
End;
Funkcja będzie zwracać zawartość przesunięcia y*320+x czyli kolor punktu x,y na ekranie.
Te funkcje mają jednak wady. Są one napisane w TP przez co nie są bardzo szybkie. Napiszmy więc je w assemblerze.
procedure PutPixel(x,y:integer;kolor:byte);assembler;
asm
mov ax,y
mov bx,320
mul bx
add ax,x
mov dx,0A000h
mov es,dx
mov di,ax
mov al,kolor
mov es:[di],al
end;
Function GetPixel(x,y:integer):byte; Assembler;
Asm
mov ax,y
mov bx,320
mul bx
add ax,x
mov dx,0A000h
mov es,dx
mov di,ax
mov al,es:[di]
End;
Jest jeszcze jeden o wiele prostszy sposób stawiania punktów:
MOV AH, 0Ch
MOV AL, kolor punktu (0..255)
MOV DX, oś x
MOV CX, oś y
Ale jest on niestety znacznie wolniejszy od poprzedniego.
np.
MOV AH, 0Ch
MOV AL, 14
MOV DX,100
MOV CX,50
postawi nam pixel we współrzędnych x=100, y=50 o kolorze 14 (żółtym)
Procedura rysująca poziomą linie do x1 do x2 na osi y może wyglądać tak
procedure poline(x1,x2,y:integer; k:byte);
var j:integer;
begin
for j:=x1 to x2 do putpixel(j,y,k);
end;
Mogąc rysować poziome linie możemy zrobić wypełniony prostokąt
procedure bar(x1,y1,x2,y2:integer; k:byte);
var J:integer;
begin
for j:=y1 to y2 do poline(x1,x2,j,k);
end;
Modyfikując poline będziemy mogli robić linie pionowe a wtedy bez problemu napiszemy
procedurę rysującą niewypełnione prostokąty.
pionowa linja:
procedure piline(y1,y2,x:integer; k:byte);
begin
for j:=y1 to y2 do putpixel(x,j,k);
end;
prostokąt:
procedure rectangle(x1,y1,x2,y2:integer; k:byte);
begin
poline(x1,x2,y1,k);
poline(x1,x2,y2,k);
piline(y1,y2,x1,k);
piline(y1,y2,x2,k);
end;
Bardzo łatwo można zrobić procedurę czyszczącą ekran
procedure cls;
var j:integer;
begin
for j:=0 to 179 do poline(0,639,j,0);
end;
O wiele trudniej jest zrobić procedury rysujące okręgi i zwykłe linie.
procedure circle(x,y,r:integer;k:byte);
var i:integer;
begin
for i:=0 to 710 do PutPixel(x+Round(SIN(i)*r), y+Round(COS(i)*r),k);
end;
Jest to kiepska ale najprostsza procedura rysująca okręgi. Działałaby szybciej gdyby zamiast 710 były mniejsze wartości ale okrąg miałby przerwania.
I na koniec najtrudniejsza procedura, rysująca linie
procedure line(x1,y1,x2,y2:Integer;c:Byte);
var
DeltaX,DeltaY,NumPixels,Counter,
D,Dinc1,Dinc2,
X,Xinc1,Xinc2,
Y,Yinc1,Yinc2:Integer;
begin
DeltaX:=abs(x2-x1);
DeltaY:=abs(y2-y1);
if (DeltaX>=DeltaY) then begin
NumPixels:=Deltax+1;
D:=(DeltaY shl 1)-DeltaX;
Dinc1:=DeltaY shl 1;
Dinc2:=(DeltaY - DeltaX) shl 1;
Xinc1:=1;
Xinc2:=1;
Yinc1:=0;
Yinc2:=1;
end else begin
NumPixels:=DeltaY+1;
D:=(DeltaX shl 1)-DeltaY;
Dinc1:=DeltaX shl 1;
Dinc2:=(DeltaX - DeltaY) shl 1;
Xinc1:=0;
Xinc2:=1;
Yinc1:=1;
Yinc2:=1;
end;
if x1>x2 then begin
Xinc1:=-Xinc1;
Xinc2:=-Xinc2;
end;
if y1>y2 then begin
Yinc1:=-Yinc1;
Yinc2:=-Yinc2;
end;
X:=x1;
Y:=y1;
for Counter:= 1 to NumPixels do begin
PutPix(X,Y,c);
if (D<0) then begin
inc(D,Dinc1);
inc(X,Xinc1);
inc(Y,Yinc1);
end else begin
inc(D,Dinc2);
inc(X,Xinc2);
inc(Y,Yinc2);
end;
end;
end;
W dziale DOWNLOAD znajduje się moduł z tymi procedurami.
Heniu
Jeśli czegoś nie rozumiecie to piszcie amprogramista@skrzynka.pl