int21h

Grafický režim v TP7 a FP

V další části našeho seriálu o grafice se zaměříme na pokročilejší režimy, jako jsou 800x600 a vyšší, ale také více barev než 256. Naučíme se nějaké ty efekty jako je průhlednost, natáčení obrázků, kreslení čar, kružnic, načítání obrázků ve formátu BMP, ale tvorbu formátů vlastních. A také trochu nakousneme zobrazování v 3D. Před tím než začneme, ještě pár zmínek o Free Pascalu a minulém dílu.


Pokud jste se pokusili přepsat minulé příklady do Free Pascalu, což bylo zvláště ohledně XMS trochu zbytečné, asi jste zjistili, že Vám něco nefunguje. Podmínek je několik. Potřebujete zapisovat do DOSové paměti. Tu už FP alokoval pod svůj deskriptor, takže Mem směruje do DOSové paměti jako doposud. Pokud ale používáte ASM, musíte použít selektor FS a offset teď obsáhne SEG*16+OFS:


Move(VVRAM,Mem[$a000:0],64000);


asm
	mov	edi,$a0000		{tady není $a000}
	lds	esi,vvram
	mov	ax,fs
	mov	es,ax			{vhodné je ES obnovit}
	mov	ecx,16000		{ES = DS}
	rep	movsd
(*
	push	ds
	pop	es
*)
end;

Data pro XMS musí ležet v konvenční paměti (ovšem ve FP je zbytečné XMS používat). Funkce GetMem a FreeMem však alokují paměť na haldě v chráněném režimu. Můžete použít funkce typu DosMemGet, atp. nebo využít funkce od DMPI (jedná se o ty samé funkce, jen jinak pojmenované; viz. nápověda k FP). Na alokování a přesuny paměti můžete použít tyto funkce:


var	handle : longint;


begin
 handle := global_dos_alloc(32768);
 dosmemget(hi(handle),0,Buffer,32768);	{přečte DOSovou paměť}
 dosmemput(hi(handle),0,Buffer,32768);	{zapíše do konv.paměti}
 dosmemfillchar(hi(handle),0,32768,#0);
 dosmemmove(hi(handle),0,Cil_Seg,Cil_Ofs,32768);
 global_dos_free(word(handle));
end;  

Horní WORD v handle obsahuje segment této paměti, dolní WORD pak obsahuje selektor. Funkce Move a FillChar mají stejný význam, jako FillChar a Move v TP7. Pro Fill existují ještě varianty s Byte, Word a Dword, což je výhoda oproti TP7. Pokud ale běžíte ve FP, vřele doporučuji mepoužívat pomalou XMS, protože pomocí GetMem můžete alokovat třeba 5 MB velký prostor (více než 2 MB pro XMS Vám většinou poskytnou emulátory, např. DOSbox pod Windows XP), ve kterém si můžete ukládat všechny obrázky a obsluha bude stejná jako u dynamických proměnných (nebo si můžete vytvořit tento buffer přes VAR, pak ale jeho velikost nebude dynamická, a v nižších rozlišeních tedy zbytečně budete vyžadovat více RAM než je nutné).

A díky Mircosoftovi jsem také odhalil menší kosmetickou vadu v mém "zpožďovači". Pokud budete využívat časovač na adrese 0:$46c, můžete ho samozřejmě využívat způsobem, jakým jsem popsal před tím. To Vám vytvoří zaručeně zpoždění jaké potřebujete. Pokud ale potřebujete, aby toto zpoždění bylo maximální, které program vytvoří, a to včetně kódu, který běží před ním, musíte to napsat takto:


var	Cas : longint;
const	Delka = 1;
begin
 repeat
  Cas := MemL[0:$46c];
   {nějaký kód}
  While MemL[0:$46c]-Cas <= Delka do;
 until False;
end;  

Díky tomuto se vlastně nejprve zjistí čas, pak se provede kód, a teprve tehdy, pokud provedení kódu bylo moc rychlé, nastoupí na řadu zpoždění. U pomalých počítačů se kód provede pomaleji a tedy nebude nutné přidávat další zpoždění, jako v případě mé procedury, která vytvářela zpoždění stále stejné nehledě na rychlost počítače. A pokud budete měnit rychlost pomocí portů a zjistíte, že to jede stále 18.2 Hz (což se někdy pod Windows stává), tak Vám stačí obsadit přerušení $1c, kam si dáte prostě Inc(Tiky), kde Tiky : longint, protože toto přerušení Vaši rychlost reflektovat bude. Pak stačí jen tuto proměnnou nastavit na začátku programu na 0 a více se o ni nezajímat (jen ji samozřejmě musíte číst namísto toho MEML).

Grafiku ve Free Pascalu budeme brát extra v nějakém příštím dílu. Nic neslibuji, ale možná se ještě potom podíváme i na Windows API, kde si vytvoříme pár oken a tlačítek (až se to naučím). A ještě potom budu brát zvukové karty a pak bude zvláštní seriál o komunikaci mezi počítači (síť IPX, sockety přes TCP a sériový kabel). Pokud se někomu z Vás nechce čekat, nechť se podívá na www.volny.cz/martinlux, kde najde nejen spoustu programů, které využívají klávesnici, myš, zvukovou kartu, sériový port, či grafiku, ale také v sekci Programování/Periférie tutorialy na zvukové karty, síť IPX a komunikaci přes COM porty.


Tak, naučili jsme se 256barevný mód a dále už nemusíme. Jen podotknu, že pokud budete chtít používat např. 800x600, tak musíte provést jen pár věcí:


- zvětšit velikost VVRAM na 800x600 bytů
- pokud využíváte změnu logické délky řádku, tak ji musíte přizpůsobit:
8 bit    1024
16 bit   2048
24 bit   4096
32 bit   4096
(údaje jsou v bytech).

Nyní ale 256barevné režimy opustíme a vrhneme se na něco lepšího. Vrátíme se k nim až budeme převádět barvy, dříve ne. Tabulku režimů jsem uváděl v minulém dílu. Pokud nechcete používat vyhledávání, musíte se spolehnout na ni. Takže si teď můžete nastavit prakticky jakýkoliv mód. Já bych jen tabulku doplnil o další módy, které občas platí (např. u karet ATi):

$11b	1280  1024	16.8M		24
$11c	 640   400	65536		16
$11d	 640   480	16.8M		32
$11e	 800   600	16.8M		32
$11f	1024   768	16.8M		32
$120	1600  1200	  256		 8
$121	1600  1200	32767		15
$122	1600  1200	65536		16

Předchozí tabulka však také platí (pod Windows 9X a DOSem ano, pod Linuxem asi ne, v DOSboxu by měla platit vždy i pod Linuxem). Nyní Vám chybí už jen jedno: vybrat si mód, který chcete používat a přepnout se do něj. Jak ale vytvářet pixely? Předem musíme říci, že zde už neexistuje žádná paleta. Do VVRAM tedy nebudete zapisovat indexy, ale přímo už RGB popis pixelů.

Jak pixely vypadají jsme si uváděli na začátku našeho seriálu, takže to opakovat nebudu. Uvedu jen funkce, které zapíší pixel do paměti VVRAM (resp. pro zjednodušení jen do pole; opět platí, že pod DOSem musíte 24 bitové pixely (3 byty) nejprve načíst po 4 bytech (1 byte z druhého pixelu), pak změnit ten první pixel a pak odeslat zase 4 byty). Tentokrát zde neuvádím změnu banku, protože ta je závislá na aktuálním rozlišení a délce řádku (stejně tak funkce OffsetXMS musí reflekovat aktuální rozměry a BPP u VVRAM):


procedure Pixel16(X,Y,Hodnota : word);
begin
 word(VasProstor^) := Hodnota;
 UlozXMS(OffsetXMS(X,Y),2);
end;


procedure Pixel24(X,Y : word; Hodnota : longint);
begin
 CtiXMS(OffsetXMS(X,Y),4);
 longint(VasProstor^) := (Hodnota and $ffffff) or
  (longint(Mem[Seg(VasProstor^):Ofs(VasProstor^)+3]) shl 24);
 UlozXMS(OffsetXMS(X,Y),4);
end;


procedure Pixel32(X,Y : word; Hodnota : longint);
begin
 longint(VasProstor^) := Hodnota;
 UlozXMS(OffsetXMS(X,Y),4);
end;  

Pokud byste měli dobrého správce XMS nebo by Váš program běžel jen pod Windows (ani na jedno nejde spoléhat), tak by procedura pro 24 bitové pixely vypadala takto:


procedure Pixel24(X,Y : word; Hodnota : longint);
begin
 longint(VasProstor^) := Hodnota;
 UlozXMS(OffsetXMS(X,Y),3);
end;  

Čtení pixelů je podobné (funkce pro 16 bitové pixely pracuje stejně dobře i s 15 bitovými, ale 15 bitové režimy nejsou rychlejší, nezabírají méně VRAM, a navíc mají 2x méně barev: jediné ospravedlnitelné využití je u těch karet, které 16 bitové režimy nepodporují a Vy nechcete používat 32 bitové - nutno podotknout, že práce s 16 bity je pomalejší než s 24/32 bity zvláště, pokud měníte složky RGB pixelů, viz. dále):


function CtiPixel16(X,Y : word) : word;
begin
 CtiXMS(OffsetXMS(X,Y),2);	{pro (někdy) zrychlení můžeme číst i 4}
 Pixel16 := word(VasProstor^);	{jinak se nic měnit nebude}
end;


function CtiPixel24(X,Y : word) : longint;
begin
 CtiXMS(OffsetXMS(X,Y),4);
 Pixel24 := longint(VasProstor^) and $ffffff;
end;


function CtiPixel32(X,Y : word) : longint;
begin
 CtiXMS(OffsetXMS(X,Y),4);
 Pixel32 := longint(VasProstor^);
end;  

Tyto funkce jsou užitečné, pokud potřebujete pixely jen přesouvat např. z obrázku do VVRAM přes test průhlednosti (transluciency je průsvitnost). Pokud samozřejmě chcete zobrazit jen řádek, můžete zase provést:


Move(Zdroj,Cil,DelkaRadku*BPP);  

Ale pokud budete chtít s pixely pracovat (např. je barvit, měnit jas, počítat průsvitnost), budete potřebovat znát jejich složky. Takže si napíšeme funkce, které nám zjistí složky pixelů (u 15/16 bitových budou mít RGB složky max. 32, resp. u G až 64 odstínů; u 24/32 bit až 256), a také funkce, které takový rozložený pixel zase složí (nic Vám samozřejmě nebrání, abyste složky RGB přímo zapsali do VVRAM bez skládání prostou úpravou výše uvedených zapisovacích funkcí). Tady se už funkce pro 15 a 16 bitové pixely bude lišit (naopak funkce pro 24 bitové pixely může obsloužit i 32 bitové, pokud nebudete potřebovat nejvyšší byte):


procedure GetPix15(Pixel : word; var R,G,B : byte); assembler;
asm  
	mov	bx,pixel
	mov	ax,bx
	and	ax,$1f
	les	di,b
	mov	es:[di],al
	mov	ax,bx
	shr	ax,5
	and	ax,$1f
	les	di,g
	mov	es:[di],al
	shr	bx,10
	and	bx,$1f	{vymažeme nejvyšší bit T}
	les	di,r
	mov	es:[di],bl  
end;


procedure GetPix16(Pixel : word; var R,G,B : byte); assembler;
asm  
	mov	bx,pixel
	mov	ax,bx
	and	ax,$1f
	les	di,b
	mov	es:[di],al
	mov	ax,bx
	shr	ax,5
	and	ax,$3f
	les	di,g
	mov	es:[di],al
	shr	bx,11
	les	di,r
	mov	es:[di],bl  
end;


procedure GetPix24(Pixel : longint; var R,G,B : byte); assembler;
asm  
	mov	al,pixel+2.byte
	les	di,r
	mov	es:[di],al
	mov	al,pixel+1.byte
	les	di,g
	mov	es:[di],al
	mov	al,pixel.byte
	les	di,b
	mov	es:[di],al  
end;


procedure GetPix32(Pixel : longint; var R,G,B,T : byte); assembler;
asm  
	mov	al,pixel+2.byte
	les	di,r
	mov	es:[di],al
	mov	al,pixel+1.byte
	les	di,g
	mov	es:[di],al
	mov	al,pixel.byte
	les	di,b
	mov	es:[di],al
	mov	al,pixel+3.byte
	les	di,t
	mov	es:[di],al  
end;  

Nezapomeňte, že intel ukládá vše opačně (aby se to dalo snadno přetypovat), takže v typu Longint máte složky jako RGB od nejvyššího bitu k nejnižšímu, ale v paměti jsou uloženy jako BGR (je to výhoda, pokud chcete udělat z LONGINTu BYTE, stačí prostě napsat Byte(L) a přečte se jen 1. byte). Teď ještě funkce pro složení pixelu (nezapomeňte, že do 15/16 bitových pixelů musíte dávat složky zmenšené!):


procedure SetPix15(var Pixel : word; R,G,B : byte); assembler;
asm  
	xor	bx,bx
	mov	bl,r
	shl	bx,5
	or	bl,g
	shl	bx,5
	or	bl,b
	les	di,pixel
	mov	es:[di],bx  
end;


procedure SetPix16(var Pixel : word; R,G,B : byte); assembler;
asm  
	xor	bx,bx
	mov	bl,r
	shl	bx,6
	or	bl,g
	shl	bx,5
	or	bl,b
	les	di,pixel
	mov	es:[di],bx  
end;


procedure SetPix24(var Pixel : longint; R,G,B : byte); assembler;
asm  
	les	di,pixel
	mov	al,b
	mov	es:[di],al
	inc	di
	mov	al,g
	mov	es:[di],al
	inc	di
	mov	al,r
	mov	es:[di],al  
end;


procedure SetPix32(var Pixel : longint; R,G,B,T : byte); assembler;
asm  
	les	di,pixel
	mov	al,b
	mov	es:[di],al
	inc	di
	mov	al,g
	mov	es:[di],al
	inc	di
	mov	al,r
	mov	es:[di],al
	inc	di
	mov	al,t
	mov	es:[di],al
end;  

Procedura pro převod složek RGB mezi 15/16/24 pixely může vypadat následovně:


procedure _15_to_16(var R,G,B : byte);
begin
 G := G shl 1;
end;


procedure _16_to_15(var R,G,B : byte);
begin
 G := G shr 1;
end;


procedure _15_to_24(var R,G,B : byte);
begin
 R := R shl 3;
 G := G shl 3;
 B := B shl 3;
end;


procedure _16_to_24(var R,G,B : byte);
begin
 R := R shl 3;
 G := G shl 2;
 B := B shl 3;
end;


procedure _24_to_15(var R,G,B : byte);
begin
 R := R shr 3;
 G := G shr 3;
 B := B shr 3;
end;


procedure _24_to_15(var R,G,B : byte);
begin
 R := R shr 3;
 G := G shr 2;
 B := B shr 3;
end;  

A pokud byste někdy potřebovali převést přímo 16bitový pixel (pro 15bitový je potřeba malá úprava kvůli prostřednímu údaji) na 24/32 bitový a obráceně (např. máte obrázek v 16 bitech, ale VVRAM je 32 bitová - test na průhlednost můžete dělat jednoduše: složíte si z RGB složek 16 bitový údaj a pak už jen testujete zda WORD v obrázku je stejný jako WORD průhledné barvy a pokud ano, nebudete ho muset přesouvat - je to rychlejší než testovat zvlášt složky RGB; podobně to můžete dělat pro 24/32 bitové pixely v Longintu), můžete využít tyto dvě funkce:


function Pixel16to24(Barva : word) : longint; assembler;
asm  
	mov	dx,barva
	mov	ax,dx
	mov	bx,dx
	and	ax,$1f
	and	bx,$7e0
	and	dx,$f800
	shl	ax,3
	shl	bx,5
	shr	dx,8
	or	ax,bx  
end;


function Pixel24to16(Barva : longint) : word; assembler;
asm  
	mov	bl,barva.byte
	shr	bl,3
	mov	al,barva+1.byte
	xor	ax,ax
	shr	al,2
	shl	ax,5
	xor	cx,cx
	mov	cl,barva+2.byte
	shr	cl,3
	shl	cx,11
	or	ax,bx
	or	ax,cx
end;  

Kdybyste to snad sami nezvládli, tak zde máte i 15bitové funkce:


function Pixel15to24(Barva : word) : longint; assembler;
asm  
	mov	ax,barva
	mov	bx,ax
	mov	dx,ax
	and	ax,$1f
	shl	ax,3
	and	bx,$3e0
	shl	bx,3
	or	ax,bx
	and	dx,$7c00
	shr	dx,7  
end;	{výsledek je v DX:AX}


function Pixel24to15(Barva : longint) : word; assembler;
asm  
	mov	bl,barva.byte
	shr	bl,3
	mov	al,barva+1.byte
	xor	ax,ax
	shr	al,3
	shl	ax,5
	xor	cx,cx
	mov	cl,barva+2.byte
	shr	cl,3
	shl	cx,10
	or	ax,bx
	or	ax,cx  
end;  

Samozřejmě můžete pixely zapisovat přes Mem přímo do VasProstor po složkách R,G,B, případně je i rovnou pomocí SHR zmenšovat, pokud máte 8 bitové složky a potřebujete pro HC jen 5/6 bitové.

Teď, když víme, jak pracovat s pixely, tak si ukážeme dva (resp. tři efekty), které jsme trochu nakousli u 256barevných režimů. Jak zjistit, zda je pixel plně průhledný už víme (test <> nebo =). Jak ale spojit dva pixely, když jeden z nich je barva pozadí a druhý je trochu průhledný (barevné sklo)? Nebo jak obarvit pixel či změnit jeho jas? Vše je velice jednoduché. Ukážeme si to pro 24 bitové a 16 bitové pixely. Ostatní si snad jistě odvodíte sami. Průhlednost se standardně počítá tímto vzorečkem:


	(HORNI*PRUHL+DOLNI*(100-PRUHL)) DIV 100  

To v případě, že bychom počítali průhlednost přes 0-100%. To je ale velice pomalé, takže zkusíme namísto desítkové soustavy dvojkovou, která počítačům sedí o mnoho více. Tuto metodu lze použít i pokud potřebujete zprůhlednit několik vrstev pixelů nad sebou (stačí, když půjdete od spodu a budete počítat vždy dvojice Pozadi-DalsiVrstva, kdy do Pozadi postupně dosadíte již vypočtené průniky). My budeme pro zjednodušení brát, že pro 8 bitové složky platí, že 255 je neprůhledný pixel, 0 je plně průhledný. Pro 6/5 bitové to bude 63, resp. 31. Pokud budeme počítat jas (resp. pro R<>G<>B je to barvení), tak budeme brát pro 8 bitové složky, že 100% je 64, pro 6 bitové to bude 16, a pro 5 bitové 4. Tím získáme možnost pixel až 4x zesvětlit, nebo 64x ztmavit pro 8 bitové, 4x/16x pro 6 bitové a 4x/4x pro 5 bitové):


procedure ZmenJas16(var R,G,B : byte; dR,dG,dB : byte);
begin	{dR a dB = <0,31>, dG=<0,63>; totéž pro R,G,B}
 R := word(R)*word(dR) shr 3;
 R := word(R)*word(dR) shr 4;
 R := word(R)*word(dR) shr 3;
end;


procedure ZmenJas24(var R,G,B : byte; dR,dG,dB : byte);
begin
 R := word(R)*word(dR) shr 6;
 R := word(R)*word(dR) shr 6;
 R := word(R)*word(dR) shr 6;
end;


procedure Pruh16(R1,G1,B1,R2,G2,B2,R3,G3,B3,Pruhl : byte);
var PrPruhl : word;		{Pruhl=<0,31>}
begin
 PrPruhl := 31-Pruhl;
 R3 := (word(R1)*word(Pruhl)+word(R2)*PrPruhl) shr 5;
 G3 := (word(G1)*word(Pruhl shl 1)+word(G2)*(PrPruhl shl 1)) shr 6;
 B3 := (word(B1)*word(Pruhl)+word(B2)*PrPruhl) shr 5;
end;


procedure Pruh24(R1,G1,B1,R2,G2,B2,R3,G3,B3,Pruhl : byte);
var PrPruhl : word;
begin
 PrPruhl := 255-Pruhl;
 R3 := (word(R1)*word(Pruhl)+word(R2)*PrPruhl) shr 8;
 G3 := (word(G1)*word(Pruhl)+word(G2)*PrPruhl) shr 8;
 B3 := (word(B1)*word(Pruhl)+word(B2)*PrPruhl) shr 8;
end;  

Tak, a teď můžeme vesele vytvářet zajímavé efekty, kdy se nám pixely prolínají, atd. Pokud jedete ve 256 barvách a chcete vypočítat průsvitnost dvou pixelů, musíte si pomocí jejich indexu zjistit z tabulky (paleta) jejich R,G,B složky (pokud možno v rozsahu 0-255; nebo 0-63, kdy si ale musíte napsat novou funkci), pak je pomocí výše uvedené funkce zmixovat a pak musíte podle výsledné R,G,B barvy najít nějakou, která přesně (nebo alespoň přibližně) odpovídá nějaké barvě v paletě a podle ní vrátíte index. To budeme brát později, žádný strach.

Nejprve ale trochu optimalizace. Pokud budete chtít vypočítat průhlednost celého obrázku, je zbytečné neustále počítat každý pixel. Stejně to platí i pro jas. Vemte si toto: máte obrázek 320x200 a chcete ho průhledně zobrazit na 75% viditelnosti přes pozadí (např. mlha), Proč 64.000x počítat u každého pixelu znovu výsledek? Když si to můžeme předpočítat předem (asi se nevyplatí u obrázků, které mají méně než 256-512 pixelů, tj. např. 16x16, 32x16, atd., leda že by jich šlo po sobě několik a všechny se stejnou % průhledností). Bylo by samozřejmě ideální si na začátku programu předpočítat všechno, ale to by zabralo příliš mnoho prostoru (tabulka pro osvětlení 256*256 = 64kB, a pro průhlednost dokonce 256*256*256 = 16 MB).

Vyřešíme to tak na půl. Tabulku pro osvětlení si můžeme vypočíst při startu programu a to pro 64 odstínů jasu. Tím si zachováme docela slušný rozsah a přitom zmenšíme velikost (16 kB):


var	Jas : array[0..63,0..255] of byte;
	j,p : byte;


begin
 for j := 0 to 63 do
  for i := 0 to 255 do
   Jas[j,p] := word(p)*word(j shl 2) shr 6;
end;  

Tabulka je platná pro 24/32 bitové pixely (v dnešní době se už moc nevyplatí podporovat 16 bitové režimy, protože VRAM má na kartě každý dost a navíc výpočty s nimi jsou dost pomalé - musíte převádět. Trochu Vás jen zachrání, že vlastně přenášíte 50% až 66% původních dat). Nyní, když budete chtít zjistit hodnotu nějakého pixelu po změně jasu, provedete to následovně (ZMENA je 0-255):


NOVYJAS := Jas[ZMENA shr 2,STARYJAS];  

Pro každou složku pixelu. Tím se výpočet zkrátil na jedno SHR, jedno MUL (to TP7 dělá, pokud si to přepíšete do ASM, můžete MUL 256 nahradit SHL 8 a bude to ještě rychlejší) a MOV.

OK, jas (a barevnost) už umíme měnit, teď jak průhlednost. Nemůžeme využívat všechny kombinace, protože to by prostě byla tabulka jak dělo (pod FP samozřejmě žádný problém, ale uvědomte si, že 16 MB jen na tabulku není ani v dnešní době zrovna šťastný nápad: do této velikosti můžete nahrát desítky spritů, které Vám tedy budou chybět a budete muset zvyšovat nároky na HW). Využijeme menší nepřesnosti lidského oka. Složky budete opět zadávat 0-255, stejně tak průhlednost, ale my budeme používat jen 32 stupňů průhlednosti (tedy nemusíme před každým obrázkem počítat tabulku znovu, pokud by používal jinou než ten předchozí) a pouze 128 úrovní jasu jednotlivých složek u horního pixelu a 64 u dolního (budeme předpokládat, že horní pixel bude většinou více vidět než ten dolní, resp. PRUHL bude 128 a výše, těch pár občasných <128 zase až tak moc neuškodí). Tím se velikost tabulky zmenší na 256 kB. Pokud se Vám to zdá moc, můžete zmenšit počet stupňů na 16, a dostanete se na 128 kB (takovou tabulku ale můžete mít i XMS (v případě TP7, u FP je 256 kB nic, tam můžete klidně dát spodnímu pixelu také 128 odstínů a tabulka bude mít jen 512 kB, což je snesitelná velikost) a přenášet vždy jen tu část, kterou potřebujete (tj. vždy jen 128*64 bytů pro daný stupeň průsvitnosti, takže v konvenční paměti bude vždy jen 8 kB - podobně to můžete dělat i s jasem, kdy Vám bude stačit mít v dolní paměti vždy jen 256 bytů).


var	Pruhl7 : array[0..127,0..63] of byte;		{pro TP7 a XMS}
	Pruhl : array[0..31,0..127,0..63] of byte;	{pro FP}
	p,a,b : byte;


begin
	{výpočet pro TP7 s XMS}
 for p := 0 to 31 do
 begin
  for a := 0 to 127 do
   for b := 0 to 63 do
    Pruhl7[a,b] := (word(a shl 1)*word(p)+word(b shl 2)*(31-p)) shr 5; 
  ; ulož tabulku do XMS (1 handle, offs=8192*p)
 end;
	{výpočet pro FP}
 for p := 0 to 31 do
  for a := 0 to 127 do
   for b := 0 to 63 do
    Pruhl[p,a,b] := (word(a shl 1)*word(p)+word(b shl 2)*(31-p)) shr 5; 
end;  

Výpočty jsou opět platné pro 8 bitové složky pixelů. Pro jiné máte dvě možnosti: buď přepíšete algoritmus a nebo budete všechno počítat jako v TC (tj. HC pixely převedete na TC, spočítate a zase převedete zpět na HC). Pixely pak zmixujete tímto stylem:


{metoda pro TP7}
; pokud není načtena, načti XMS tabulku z ofs=(p shr 3)*8192
Slozka := Pruhl7[horni shr 1, dolni shr 2];


{metoda pro FP}
Slozka := Pruhl[p shr 3, horni shr 1, dolni shr 2];  

Výše uvedené je zaměřeno hlavně na šetření pamětí, takže pokud si můžete dovolit plýtvat, můžete ušetřit jednu SHR instrukci a dát hornímu pixelu 256 jasů (bez SHR) a dolnímu 128 (SHR 1). Tabulka bude mít pak 2 MB (nebo 1 MB, pokud zachováte 64 odstínů pro dolní). A pamatujte, že i VAR proměnné jsou v konvenční paměti, takže nemusíte tabulku přenášet z XMS nejprve do nějakého pointeru přes GETMEM a pak teprve do VAR (můžete to udělat přímo; VAR je také defakto pointer).

Dobrá, naučili jsme se dělat efekty ve vyšších barvách. Co když ale někdo nemůže využívat HC nebo TC a jede jen v 256 barvách? Musíme je převádět. Naším řešením je, že můžeme mít stejně všechny obrázky v paměti v TC a HC, stejně tak naši VVRAM (pokud ovšem nepracujeme s 8 bitovými, a jen potřebujeme provést průhlednost, jak jsem psal výše). Všechny výpočty pak také provádíme v TC, a teprve, když potřebujeme vykreslit VVRAM, převedeme ji na 256 barev a tyto pošleme do VRAM (využijeme ještě nějaký další pracovní buffer). Máme tři možnosti, jak provádět tento převod.

První metoda je, že si necháme vytvořit paletu v odstínech šedi. To jsme už brali. Poté, když dostaneme pixel, můžeme ho převést jednoduše tímto stylem:


INDEX := (R+G+B) div 3;  

Nebo rychleji, kdy využijeme pracovní složku (tu si můžete nastavit na 0-255 a tím vlastně měnit gamma obrazu: pokud dáte 0, nedostanete nikdy úplně bílou; pokud dáte 255, nedostanete nikdy úplně černou):


INDEX := (R+G+B+X) shr 2;  

Ano, i toto je metoda. Ale pokud chceme zobrazovat barevně, musíme provádět převod. Dejme tomu, že paletu už máme (jak ji dostaneme, o tom se zmíníme později). Budeme ji tedy muset procházet a zjišťovat, zda se složky RGB pixelu shodují se složkami nějakého indexu. Protože je ale nepravděpodobné, že by po změně pixelu nějaký z nich byl přesně shodný s tím naším, budeme muset počítat s jistou mírou tolerance. Jak s ní naložíme je na nás. Můžeme ji postupně zvyšovat od 0 to 255, dokud nenajdeme pixel. Můžeme zvyšovat všechny složky naráz (rychlejší) nebo střídavě (9x pomalejší, ale přesnější). Můžeme také měnit vždy jen + a pak jen -, ale to nás opět 4x zdrží. Toleranci můžeme zvyšovat po 1, nebo exponenciálně (tj. 1,2,4,8,16,32, atd.), což je rychlejší, ale může dát horší výsledky. Já jsem si pro ukázku vybral metodu, která zvyšuje exponenciálně a u všech složek současně na obě strany.


function NajdiPixel(R,G,B : byte) : byte;
var	ind : byte;
	rl,rh,gl,gh,bl,bh : integer;
	tol : byte;
	tolerance : word;
begin
 tol := 0;
 repeat
  tolerance := 1 shl tol;
  inc(tol);
  rl := R-tolerance;
  rh := R+tolerance;
  gl := G-tolerance;
  gh := G+tolerance;
  bl := B-tolerance;
  bh := B+tolerance;
  if rl < 0 then rl := 0;
  if gl < 0 then gl := 0;
  if bl < 0 then bl := 0;
(*
  if rh > 255 then rh := 255;
  if gh > 255 then gh := 255;
  if bh > 255 then bh := 255;
*)
  for ind := 0 to 255 do
   if (Paleta[ind].R >= rl) and
      (Paleta[ind].R <= rh) and
      (Paleta[ind].G >= gl) and
      (Paleta[ind].G <= gh) and
      (Paleta[ind].B >= bl) and
      (Paleta[ind].B <= bh) then
    begin
     NajdiPixel := ind;
     Exit;
    end;
 until tolerance = 256;
 NajdiPixel := 0;
end;  

Pokud bychom chtěli zvyšovat toleranci po 1, stačí nám obyčejné INC a nemusíme dělat žádné SHL (a navíc ušetříme 1 proměnnou). Pro real-time převod rozlišení nad 640x480 ale budete potřebovat alespoň 1 GHz procesor, abyste tam mohli provozovat adventuru nebo dungeon hru (zatímco u Gray palety nám stačí obyčejná 486 a u exponenciální metody přobližně Pentium II). Dobře, najít barvu umíme, ale kde seženeme paletu?

Máme několik řešení. Buď si paletu načteme z nějakého externího souboru (768 bytů), nebo z PEL registrů video karty (to už umíme), nebo si vytvoříme adaptivní paletu. Jak se to dělá? Budeme potřebovat celkem velký prostor na okládání dat. Pod FP opět není problém, pod TP7 budeme asi potřebovat využívat opět XMS. Budeme totiž postupovat následovně: přečteme pixel z VVRAM a zjistíme, zda danou barvu už v tabulce máme. Pokud ne, přidáme ji, pokud ano, zvýšíme její výskyt. Pro úsporu místa je vhodné využívat barvy typu HC, protože ušetříme 1 byte na barvu. Pak budeme moci dát výskyt WORD a tím budeme mít každou položku zarovnanou na DWORD. Příklad uvedu pro FP, pro TP7 si musíte tabulku udělat v XMS a přenášet ideálně vždy jen ty 2-4 byty tam a sem (nebo si počkat na lepší metodu). Pod TP7 bychom tabulku dynamicky zvětšovali, tj. bychom uložili hodnotu barvy a poté její číslo, zvýšili počet barev. Při příštím vkládání bychom prohledávali už jen tolik barev, kolik bychom jich tam měli. Jednoduší ale je, pokud si to můžeme dovolit (ono nám ani nic jiného nezbyde, pokud budeme počítat s tím, že nám tabulka může stejně nabobtnat až na 65536 barev) udělat tabulku velkou 128 kB a mít v ní jen výskyty barev, přičemž hodnota barvy se vezme jako index. To nám ušetří spoustu času s prohledáváním:


var	Tabulka : array[0..65535] of word;
	x,y : word;
begin
 FillChar(Tabulka,SizeOf(Tabulka),0);
 for y := 0 to MaxY-1 do
  for x := 0 to MaxX-1 do
   if Tabulka[tc2hc(VVRAM[y,x])] < 65535 then
    Inc(Tabulka[tc2hc(VVRAM[y,x])]);
end;  

Dobře, teď máme barvy. Co s nimi? Provedeme jejich třídění. Jakou metodu si zvolíte nechám na Vás, já použiji třeba Bubble Sort. Protože jsme si ale na začátku ušetřili čas s ukládáním hodnoty barvy do tabulky, nemůžeme nyní jen tak setřídit tabulku, protože bychom pak nevěděli, který výskyt patřil které barvě. Musíme proto udělat další tabulku, kam nejprve uložíme čísla barev (resp. i jejich hodnoty), a tuto tabulku budeme třídit současně.


var	Zmena : boolean;
	index : word;
	Prac : word;
	Barvy : array[0..65535] of word;	{toto v TP7 neuděláte :-(}
begin
 for index := 0 to 65535 do
  Barvy[index] := index;
 repeat
  Zmena := False;
  for index := 0 to 65534 do
   if Tabulka[index] < Tabulka[index+1] then
   begin
    Prac := Tabulka[index];
    Tabulka[index] := Tabulka[index+1];
    Tabulka[index+1] := Tabulka[index];
    Prac := Barvy[index];
    Barvy[Index] := Barvy[Index+1];
    Barvy[Index+1] := Prac;
    Zmena := True;
   end;
 until not Zmena;
end;  

Tabulku teď máme setříděnou (nejvíce se vyskytující barvy jdou první), a nyní zjistíme, kolik v ní je barev (dokud nenarazíme na výskyt = 0 nebo na konec tabulky), jaký je průměrný výskyt, a která barva (index) tomuto průměru přibližně odpovídá.


var	Barev : word;
	Prumer : word;
	Mez : word;
	Soucet : longint;
begin
 Soucet := 0;
 Barev := 65535;
 for index := 0 to 65535 do
  if Tabulka[index] <> 0 then
   Inc(Soucet,Tabulka[index])
    else
     begin		{předpokládám, že tabulka není prázdná}
      Barev := Index;
      Break;
     end;
 if Barev > 256 do
 begin
  Prumer := Soucet div longint(Barev);
  for index := 0 to Barev-2 do
   if (Tabulka[index] >= prumer) and
      (Tabulka[index+1] < prumer) then
      begin
       Mez := index;
       Break;
      end
       else if index = Barev-2 then
        Mez := Barev-1;
 end; 
end;  

Teď víme, která barva je průměr všech výskytů. Nyní přečteme 256 barev v poměru 192:64 z obou oblastí. Proč takto divně? 192 odstínů vezmeme z těch barev, které se vyskytují nejčastěji, takže budou mít více možností. Ale nesmíme zanedbat ani ty odstíny, které nejsou tak časté, ale jsou (jinak bychom o ně přišli). Těch ale vezmeme méně. Pokud je barev v tabulce 256 a méně, nemusíme nic počítat, prostě převezmeme celou tabulku (pozor! musíme převzít barvy z tabulky BARVY, ne počty výskytů, a musíme je uložit normálně od začátku, tj. první barvu z tabulky dáme do PALETA[0], neobsazené barvy na konci vymažeme na $ff; toto pak pomůže našemu výše uvedenému algoritmu ve hledání). Nyní tedy zjistíme, po kolika barvách musíme barvy z tabulky načítat:


var	ViceSkok,MeneSkok : word;
begin
 ViceSkok := Mez div 192;
 if ViceSkok = 0 then Inc(ViceSkok);
 MeneSkok := (Barev-Mez) shr 6;
 if MeneSkok = 0 then Inc(MeneSkok);
end;  

A teď už jen budeme číst barvy z tabulky a házet je do palety. Musíme samozřejmě převést HC na TC a otočit pořadí složek (u VGA palety je pořadí RGB, zatímco my máme pixely BGR, u VESy je to naštěstí stejně, jen tam je o 1 byte na barvu navíc). Pro tento účel si zavedeme ještě pár funkcí, které nám vyseparují RGB složky:


function R(pixel : longint) : byte;
asm  
	mov	al,pixel+2.byte  
end;


function G(pixel : longint) : byte;
asm  
	mov	al,pixel+1.byte  
end;


function B(pixel : longint) : byte;
asm  
	mov	al,pixel.byte  
end;  

A teď vytvoříme svou adapativní paletu:


var	Pixel : longint;
	pozice : byte;
begin
 pozice := 255;
 for index := 0 to 191 do
 begin
  Pixel := hc2tc(Barvy[index*viceskok]);
  paleta[pozice].r := r(pixel);
  paleta[pozice].g := g(pixel);
  paleta[pozice].b := b(pixel);
  Dec(pozice);
 end;
 for index := 0 to 63 do
 begin
  Pixel := hc2tc(Barvy[index*meneskok+mez]);
  paleta[pozice].r := r(pixel);
  paleta[pozice].g := g(pixel);
  paleta[pozice].b := b(pixel);
  Dec(pozice);
 end;
end;  

Pro rychlejší výpočet můžeme samozřejmě zavést další proměnnou, která bude na začátku naplněna 0 nebo MEZem a budeme ji jen zvyšovat pomocí INC o MeneSkok nebo ViceSkok (abychom nemuseli násobit). Máme ale hlavní problém. Tuto legraci budeme totiž muset provádět před každým kreslením VVRAM do VRAM, protože se nám tam mění při nové změně VVRAM (většinou) podíl barev. Jednoduší řešení pro nás je provést toto pouze jednou a to po nahrání všech spritů, které ve scéně budou, do paměti. Pak vytvoříme tabulku nikoliv ze všech pixelů VVRAM, ale ze všech pixelů všech obrázků. V tomto případě vytvoříme paletu (a nahrajeme ji do VGA karty) jen jednou.

Ale proč to dělat složitě, když to jde jednoduše. Ukážeme si jeden geniální trik, který sice nevyužívá adpativní paletu, ale dokáže i na průměrném Pentiu provádět real-time (v reálném čase) převod z TC na 256 barev a přitom obraz vypadá skoro stejně jako původní TC obrázek. Zde jednoduše využíváme toho, že máme speciálně vypočítanou paletu a pak už jen bereme RGB složky přímo jako index do této palety (který vypadá takto: bbgg grrr). Geniální myšlenky bývají prosté:


procedure VytvorPaletu;
var	r,g,b,i : byte;
begin
 R := 0;
 G := 0;
 B := 0;
 for i := 0 to 255 do
 begin
  paleta.r := r;
  paleta.g := g;
  paleta.b := b;
  Inc(b);
  if b = 4 then
  begin
   b := 0;
   Inc(g);
   if g = 8 then
   begin
    g := 0;
    inc(r);    
   end;
  end;
 end;
end;  

Samotný index pixelu pak vypočítáme následovně:


Index := word(R) and $e0+(word(G) shr 5) shl 2+word(B) shr 6;  

A v tom je celý ten zázrak. Nyní si už tedy můžete vychutnat krásu TC na počítačích, které pro to třeba ani nemají VRAM. Výhodou této druhé metody je, že paletu stačí také vytvořit jen jednou a celý převod VVRAM pak stejně probíhá nezávisle na tom, co tam máte za data. Jednu nevýhodu to samozřejmě má: pokud bude celá Vaše VVRAM zbarvena jen do 1 odstínu (např. modré), přijdete o většinu detailů a bude to vypadat strašně (zde by tedy měla nastoupit adaptivní pomalejší metoda). Ale pro normální fotky je to více než dobré.

Fajn, umíme zobrazovat, ale nemáme co. Můžeme kreslit obrazce pomocí pixelů, ale jednodušší asi bude, když si na to vytvoříme nějaké ty procedury. Naučíme se kreslit čáry (vodorovné, svislé, šikmé), čtverce a obdelníky, kružnice a elipsy, a také se je naučíme vyplňovat barvou i vzorem. Použijeme pár triků, abychom urychlili naše vykreslování. Začneme nejprve s tím nejjednoduším - čáry. Tady asi není moc, co bych měl vysvětlovat:


procedure Vodorovne(X1,X2,Y : word; Barva : BPP);
var i : word;
begin
 for i := X1 to X2 do
  PixelBPP(i,Y,Barva);
end;


procedure Svisle(X,Y1,Y2 : word; Barva : BPP);
var i : word;
begin
 for i := Y1 to Y2 do
  PixelBPP(X,i,Barva);
end;  

Čáru pro kreslení horizontálně jde výrazně urychlit (v TP7 jen pro BPP=1, v FP pro všechna, ale musíte vždy použít správný Fill):


procedure Vodorovne(X1,X2,Y : word; Barva : byte);
begin
 FillChar(VVRAM[X1,Y],X2-X1,Barva);
end;  

Když umíme kreslit čáry, tak umíme kreslit i čtverce a obdelníky:


procedure _4uhelnik(X1,Y1,X2,Y2 : word; Barva : BPP);
begin
 Vodorovne(X1,Y1,X2,Y1,Barva);
 Vodorovne(X1,Y2,X2,Y2,Barva);
 Svisle(X1,Y1,X1,Y2,Barva);
 Svisle(X2,Y1,X2,Y2,Barva);
end;  

Bylo by ale vhodné se naučit kreslit i šikmé čáry. Existuje spousta algoritmů. My použijeme ten (algoritmus není můj), který počítá přírůstky rozdílu. Nebudeme ale používat reálná čísla (kvůli rychlosti):


procedure Cara(X1,Y1,X2,Y2 : word; Barva : BPP);
var	DeltaX, DeltaY, NumPixels, Counter,
	D, Dinc1, Dinc2,
	X, Xinc1, Xinc2,
	Y, Yinc1, Yinc2 : Integer;
begin
	{rozdíly v osách X a Y}
 DeltaX := abs(x2-x1);
 DeltaY := abs(y2-y1);
	{zkontrolujeme přesnost. Tím určíme nezávislou proměnnou}
 if (DeltaX >= DeltaY) then
 begin
    {X bude nezávislá proměnná}
  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
	{Y bude nezávislá proměnná}
   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;
	{Ujistíme se, že X a Y se mění správným směrem}
 if x1 > x2 then
 begin
  Xinc1 := -Xinc1;
  Xinc2 := -Xinc2;
 end;
 if y1 > y2 then
 begin
  Yinc1 := -Yinc1;
  Yinc2 := -Yinc2;
 end;
	{Začneme kreslit na bodu X1 a Y1}
 X := x1;
 Y := y1;
 for Counter := 1 to NumPixels do
 begin
  Pixel(X,Y,Barva);
  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;  

Trochu "složitější" (i když kratší) je výpočet kružnice (algoritmus není z mé hlavy; u těch, co jsou, se případně omlouvám za překlepy a chyby, ale měli byste být už na takové úrovni, abyste si to byli schopni upravit, opravit a přizpůsobit podle teorie). Ale zde je možné pomoci si tím, že je vlastně dokonale symetrická, takže nám stačí spočítat si pouze 1/8 bodů a ty ostatní promítneme přes osy X a Y, a zároveň XY. Elipsa (algoritmus bohužel neznám) se kreslí podobně (zkuste třeba využít Vaše znalosti ze SŠ z goniometrie a rovnice bodu na elipse), jen musíme počítat 2x tolik bodů než u kružnice, protože není souměrná podle os XY, ale jen X a Y. Přístupy do VVRAM můžete nahradit opět nějakým tím přesunem do XMS, stejně tak si opět můžeme předpočítat opakující se výpočty u X a Y. Jen upozorňuji, že u nesymetrických módů, jako je např. 320x200 (1.6:1) nebo 640x480 (1.33:1) nemusí být kružnice kulatá (pokud obrazovku "típnete" do BMP a zobrazíte např. ve Windows, tak kulatá na 99% bude), protože pixely nejsou čtvercové (proto budete muset kreslit spíše elipsy). Je vhodné také testovat, zda vykreslovaný pixel neleží mimo obrazovku (nebo nastavený výřez).


procedure Kruznice(X,Y,R : word; Barva : BPP);
var	d,cx,cy : integer;
begin
 d := 3-(r+r);
 cx := 0;
 cy := r;
 while cx <= cy do
 begin
  VVRAM[y+cy,x+cx] := barva;
  VVRAM[y-cy,x+cx] := barva;
  VVRAM[y+cy,x-cx] := barva;
  VVRAM[y-cy,x-cx] := barva;
  VVRAM[y+cx,x+cy] := barva;
  VVRAM[y-cx,x+cy] := barva;
  VVRAM[y+cx,x-cy] := barva;
  VVRAM[y-cx,x-cy] := barva;
  inc(cx);
  if d < 0 then
   d := d+cx shl 2+6
    else
     begin
      d := d+(cx-cy) shl 2+10;
      dec(cy);
     end;
 end;
end;  

A když už máme hotové tvary (jedna perlička, pokud změníte d<0 za d>0, dostanete kosočtverec; prvním SHL 2 měníte prohnutí dovnitř (čím větší číslo, tím se to bude podobat kosočtverci se zaoblenými rohy), druhým SHL 2 měníte výchylku ven (čím větší číslo, tím se to bude podobat čtverci ze zaoblenými rohy); pokud nahradíte dvojice CX za CY nebo obráceně, dostanete z některých oblouků rovné čáry a tedy i zajímavé útvary). Můžeme se je naučit vyplňovat. Tyto funkce fungují na principu zásobníku, kdy si uloží pixely, které jsou vedle nich ještě nevyplněné a dokud v zásobníku ještě něco je a my stále máme ještě řádek pro plnění, opakujeme vykreslování. Existují dvě varianty. První hledá pixely jen vedle sebe v osách XY. Je rychlejší a také se hodí pro vyplňování kružnic, elips a trojúhelníků. Pomalejší metoda, která prohledává všech 8 os (tj. i šikmo) se nehodí pro objekty, které mají šikmé čáry (protože "vyteče" ven), ale pomůže u některých složitějších objektů (to lze ale obejít prostě tím, že vložíte několik bodů, odkud se začne vyplňovat a použijete "4"). Zásobník musíte udělat dostatečně hluboký, aby u velkých či složitých objektů stačil (může být potřeba až desítky kB!).


type	ZasSirka = word;
const	Vyska : ZasSirka = 1024;
var	Zasobnik : array[0..Vyska-1] of record
					 X,Y : word;
					end;
	Vrchol : ZasSirka;


procedure Vloz(X,Y : word);
begin
 if Vrchol = Vyska then Exit;
 Zasobnik[Vrchol].X := X;
 Zasobnik[Vrchol].Y := Y;
 Inc(Vrchol);
end;


procedure Vyjmi(var X,Y : word);
begin
 if Vrchol = 0 then Exit;
 X := Zasobnik[Vrchol].X;
 Y := Zasobnik[Vrchol].Y;
 Dec(Vrchol); 
end;


procedure Vypln4(X,Y : word; Okraje,Barva : BPP);
var l,r : word;
begin
 Vrchol := 0;
 repeat
  if Vrchol > 0 then Vyjmi(X,Y);
  l := x;
  while (l > 0) and (VVRAM[l,y] <> Okraje) do
  begin			{cyklus doleva}
   if y-1 > 0 then
    if VVRAM[l,y-1] <> Okraje then Vloz(l,y-1);
   if y+1 < MaxY then
    if VVRAM[l,y+1] <> Okraje then Vloz(l,y+1);
   Pixel(l,y,Barva);
   Dec(l);
  end;
  p := x+1;
  while (p < MaxX) and (VVRAM[p,y] <> Okraje) do
  begin			{cyklus doprava}
   if y-1 > 0 then
    if VVRAM[p,y-1] <> Okraje then Vloz(p,y-1);
   if y+1 < MaxY then
    if VVRAM[p,y+1] <> Okraje then Vloz(p,y+1);
   Pixel(p,y,Barva);
   Inc(p);
  end;
 until Vrchol = 0;
end;


procedure Vypln8(X,Y : word; Okraje,Barva : BPP);
var l,r : word;
begin
 Vrchol := 0;
 repeat
  if Vrchol > 0 then Vyjmi(X,Y);
  l := x;
  while (l > 0) and (VVRAM[l,y] <> Okraje) do
  begin			{cyklus doleva}
   if y-1 > 0 then
   begin
    if VVRAM[l,y-1] <> Okraje then Vloz(l,y-1);
    if l-1 > 0 then
     if VVRAM[l-1,y-1] <> Okraje then Vloz(l-1,y-1);
   end;
   if y+1 < MaxY then
   begin
    if VVRAM[l,y+1] <> Okraje then Vloz(l,y+1);
    if l-1 < MaxX then
     if VVRAM[l-1,y+1] <> Okraje then Vloz(l-1,y+1);
   end;
   Pixel(l,y,Barva);
   Dec(l);
  end;
  p := x+1;
  while (p < MaxX) and (VVRAM[p,y] <> Okraje) do
  begin			{cyklus doprava}
   if y-1 > 0 then
   begin
    if VVRAM[p,y-1] <> Okraje then Vloz(p,y-1);
    if p+1 > 0 then
     if VVRAM[p+1,y-1] <> Okraje then Vloz(p+1,y-1);
   end;
   if y+1 < MaxY then
   begin
    if VVRAM[p,y+1] <> Okraje then Vloz(p,y+1);
    if p+1 < MaxX then
     if VVRAM[p+1,y+1] <> Okraje then Vloz(p+1,y+1);
   end;
   Pixel(p,y,Barva);
   Inc(p);
  end;
 until Vrchol = 0;
end;  

Tyto procedury vyplňují jednou barvou a to tím stylem, že vyplní všechny pixely, které nejsou určité barvy (OKRAJE) na barvu Barva. Můžete si je samozřejmě upravit tak, aby fungovaly jen na barvě, kterou určíte (tedy budou vlastně nahrazovat barvu Okraje na Barvu ve svém nejbližším okolí) a to prostou záměnou příkazu <> na příkaz =. Můžeme si ale napsat i procedury, které vykreslují plochu ne jednou barvou, ale nějakým vzorkem. Aby ten držel na místě (tj. se různě nerozjížděl podle toho, jak moc je šikmá levá či pravá strana objektu, a odkud se začne vyplňovat), budeme brát souřadnice XY na obrazovce s určitou úpravou jako souřadnice v bufferu vzorku (ten je vlastně obyčejný obrázek X*Y s BPP, jakou potřebujete).


type	TVzor = array[0..15,0..15] of RGB;
var	Vzorek : TVzor;		{rozměry jako mocniny 2}


procedure Vypln4Vzor(X,Y : word; Okraj : BPP; Vzor : TVzor);
var l,r : word;
begin
 Vrchol := 0;
 repeat
  if Vrchol > 0 then Vyjmi(X,Y);
  l := x;
  while (l > 0) and (VVRAM[l,y] <> Okraje) do
  begin			{cyklus doleva}
   if y-1 > 0 then
    if VVRAM[l,y-1] <> Okraje then Vloz(l,y-1);
   if y+1 < MaxY then
    if VVRAM[l,y+1] <> Okraje then Vloz(l,y+1);
   Pixel(l,y,vzor[y and 15,l and 15]);
   Dec(l);			{mocnina dvou -> stačí nám AND místo MOD}
  end;
  p := x+1;
  while (p < MaxX) and (VVRAM[p,y] <> Okraje) do
  begin			{cyklus doprava}
   if y-1 > 0 then
    if VVRAM[p,y-1] <> Okraje then Vloz(p,y-1);
   if y+1 < MaxY then
    if VVRAM[p,y+1] <> Okraje then Vloz(p,y+1);
   Pixel(p,y,vzor[y and 15,p and 15]);
   Inc(p);
  end;
 until Vrchol = 0;
end;  

Dobrá, takže umíme kreslit 2D objekty. Ale chtěli jste už někdy kreslit i 3D? Není nic snažšího. Pro přepočet na 2D obrazovku se používá vzoreček:


Xobr := (X * 512) DIV (Z + 512) + XobrMax div 2;
Yobr := (Y * 512) DIV (Z + 512) + YobrMax div 2;  

Jednoduše do rovnic dosadíte X,Y,Z (Z se většinou používá do 255) a vyjde Vám, na které XY souřadnice máte bod na obrazovku nakreslit. Mělo by také platit, že čím je bod dál, tím by měl být tmavší (pokud tam ovšem nemáte nějaký svůj zdroj světla, který připočtete zlumený dle Z k jeho jasu podle toho, zda jeho Z leží v oblasti, kde je světlo). Rovnice lze samozřejmě upravovat dle efektu, který chcete dosáhnout, takže může vypadat třeba i takto:


Xobr := (X shl 9) div Z + XobrMax shr 1
Yobr := (Y shl 8) div Z + YobrMax shr 1;  

Toto platí pro statickou kameru (resp. kamera, která je ve středu obrazovky). Pokud se má kamera hýbat, musíte upravit rovnice třeba takto:


Xobr := ((X+Xcam)*Vzdal) DIV (Z+Vzdal)+XobrMax div 2
Yobr := -((Y+Ycam)*Vzdal) DIV (Z+Vzdal)+YobrMax div 2  

Všimněte si, že u Y souřadnice je mínus. To je proto, jelikož souřadnice na monitoru stoupají odshora dolů; ale pozici kamery na mapě většinou vyjadřujete tak, že Y=0 je dole, a směrem nahoru souřadnice stoupají. Vzdálenost může být dle "čočky" kamery, např. 512 nebo nic (můžete takto snadno dosáhnout i protáhlého pohledu, když k Z nic přičítat nebudete a budete zvyšovat číslo za násobením, resp. posunem vlevo). Každý bod XYZ můžete brát jako část objektu. Pokud chcete např. kreslit zdi jako u WOLFa 3D, stačí Vám vědět, kde leží daný bod na mapě a podle toho, kam se díváte (pokud se otočíte o 180 stupňů, tak musíte také změnit souřadnice objektů, co byly za Vámi (nebo si propočítat souřadnice svého pohledu), aby teď ležely jakoby před Vámi, pokud jim necháte stejné XYZ, vyjdou nesmysly) to přepočítat a pak převést na XY. Pokud Vás to zajímá, podívejte se do časopisu Výheň. Jen nutno podotknout, že pro kreslení her typu Prince of Persia (pseudo-3D) nebo Transport Tycoon (izometrie) nepotřebujete tyto převody, ale spíše znalosti kreslení 3D technických výkresů, kdy zmenšíte počet pixelů na stranách, které jsou jakoby 3D na 1/2 buď na Y (vrchní) nebo na X (krajní) jejich vynecháním, a kreslíte je pod úhlem 45 st., tedy vždy X+1 a Y+1.

Pokud ale chcete kreslit na obrazovku více objektů, které se budou zakrývat, nebo dokonce prolínat, asi narazíte na problém, jak kreslit jednotlivé body (jistě, kreslit objekty od nejzadnějších po nejbližší, ale co když jsou dva objekty propletené?). Můžete si samozřejmě objekty uspořádat, vyhodit ty strany, které nejsou vidět (jsou od nás odvrácené), i ty, které jsou zakryty celé jiným objektem, ale stále musíte vykreslit body. Na toto se používá tzv. Z-Buffer. Jedná se o pole, které má stejné rozměry X*Y jako VVRAM (ale už nemusí mít stejné BPP, protože to bývá většinou 1 až 2 dle toho, jaké může být Z). Do Z bufferu se ukládají, jak už název napovídá, souřadnice Z. Na začátku každého vykreslování ho naplníte max. hodnotami (255 pro byte) a vždy, když budete chtít kreslit bod, tak zjistíte, zda jeho Z je menší než v to bufferu. Pokud ano, vložíte jeho Z na toto místo a vykreslíte jej. V opačném případě jej "zahodíte".


var	ZBuffer : array[0..MaxY-1,0..MaxX-1] of byte;  

A teď pro každý obrázek provedete to, co je v následujícím příkladu (pokud je potřeba daný pixel kreslit, tj. pokud jej již nevyřadila funkce testující průhlednost). Kreslíme obrázek Xobr*Yobr na souřadnice Xv,Yv, a obrázek je dejme tomu natočený od 45 stupňů "dovnitř" monitoru (zeď). Pro každý bod musíme Z nějak vypočítat (ideálně si vypočítejte Z prvního a posledního bodu, zjistěte si rozdíl, vynásobte 65536 (bez reálných čísel potřebujeme mít větší citlivost) a vydělte počtem bodů v obrázku (Yobr). Nastavte Z na Z bližšího bodu. Nyní po přečtení každého X zvyšte nějakou pracovní proměnnou typu LONGINT o Zr*65536/X. Pokud bude pracovní proměnná >=65536, zvyšte Z o 1 a od té pracovní proměnné odečtěte 65536 (takto se nahrazují čísla 0.4, 0.8, 1.2-1 = 0.2 (Z+1), 0.6, 1.0-1 = 0 (Z+1), 0,4...).


for y := 0 to ObrY-1 do
 for x := 0  to ObrX-1 do
 begin
  ; vypočteme Z, pokud je třeba obrázek natočený
  ; vypočteme souřadnice Xo a Yo na obrazovce
  if z < zbuffer[yo,xo] then
  begin
   Pixel(yo,xo,barva);
   zbuffer[yo,xo] := z;
  end;
 end;  

Voala, a máme 3D prostor jak vyšitý. Teď se už můžete pustit do tvorby vlastního Dooma (podlahy jsou to samé co zdi, jen se naklápějí podle jiné osy). Fajn, ale stále ještě nemáme co zobrazovat. Jasně, máme kružnice a čáry, ale kdo by dneska hrál hru na bázi drátěných modelů. Chtělo by to nějaké ty textury. Tak se naučíme číst obrázky (a vytvoříme si i vlastní formát). Ale to až jindy :-)


*** POKRAČOVÁNÍ PŘÍŠTĚ ***

2006-11-30 | Martin Lux
Reklamy: