Na FreeHostingu Endora běží desítky tisíc webů. Přidejte se ještě dnes!
Vytvořit web zdarmaNa FreeHostingu Endora běží desítky tisíc webů. Přidejte se ještě dnes!
Vytvořit web zdarma
V dal sti naeho serilu o grafice se zamme na pokroilej reimy, jako jsou 800x600 a vy, ale tak vce barev ne 256. Naume se njak ty efekty jako je prhlednost, naten obrzk, kreslen ar, krunic, natn obrzk ve formtu BMP, ale tvorbu formt vlastnch. A tak trochu nakousneme zobrazovn v 3D. Ped tm ne zaneme, jet pr zmnek o Free Pascalu a minulm dlu.
Pokud jste se pokusili pepsat minul pklady do Free Pascalu, co bylo zvlt ohledn XMS trochu zbyten, asi jste zjistili, e Vm nco nefunguje. Podmnek je nkolik. Potebujete zapisovat do DOSov pamti. Tu u FP alokoval pod svj deskriptor, take Mem smruje do DOSov pamti jako doposud. Pokud ale pouvte ASM, muste pout selektor FS a offset te obshne 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 leet v konvenn pamti (ovem ve FP je zbyten XMS pouvat). Funkce GetMem a FreeMem vak alokuj pam na hald v chrnnm reimu. Mete pout funkce typu DosMemGet, atp. nebo vyut funkce od DMPI (jedn se o ty sam funkce, jen jinak pojmenovan; viz. npovda k FP). Na alokovn a pesuny pamti mete pout tyto funkce:
var handle : longint; begin handle := global_dos_alloc(32768); dosmemget(hi(handle),0,Buffer,32768); {pete DOSovou pam} dosmemput(hi(handle),0,Buffer,32768); {zape do konv.pamti} 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 tto pamti, doln WORD pak obsahuje selektor. Funkce Move a FillChar maj stejn vznam, jako FillChar a Move v TP7. Pro Fill existuj jet varianty s Byte, Word a Dword, co je vhoda oproti TP7. Pokud ale bte ve FP, vele doporuuji mepouvat pomalou XMS, protoe pomoc GetMem mete alokovat teba 5 MB velk prostor (vce ne 2 MB pro XMS Vm vtinou poskytnou emultory, nap. DOSbox pod Windows XP), ve kterm si mete ukldat vechny obrzky a obsluha bude stejn jako u dynamickch promnnch (nebo si mete vytvoit tento buffer pes VAR, pak ale jeho velikost nebude dynamick, a v nich rozliench tedy zbyten budete vyadovat vce RAM ne je nutn).
A dky Mircosoftovi jsem tak odhalil men kosmetickou vadu v mm "zpoovai". Pokud budete vyuvat asova na adrese 0:$46c, mete ho samozejm vyuvat zpsobem, jakm jsem popsal ped tm. To Vm vytvo zaruen zpodn jak potebujete. Pokud ale potebujete, aby toto zpodn bylo maximln, kter program vytvo, a to vetn kdu, kter b ped nm, muste to napsat takto:
var Cas : longint; const Delka = 1; begin repeat Cas := MemL[0:$46c]; {njak kd} While MemL[0:$46c]-Cas <= Delka do; until False; end;
Dky tomuto se vlastn nejprve zjist as, pak se provede kd, a teprve tehdy, pokud proveden kdu bylo moc rychl, nastoup na adu zpodn. U pomalch pota se kd provede pomaleji a tedy nebude nutn pidvat dal zpodn, jako v ppad m procedury, kter vytvela zpodn stle stejn nehled na rychlost potae. A pokud budete mnit rychlost pomoc port a zjistte, e to jede stle 18.2 Hz (co se nkdy pod Windows stv), tak Vm sta obsadit peruen $1c, kam si dte prost Inc(Tiky), kde Tiky : longint, protoe toto peruen Vai rychlost reflektovat bude. Pak sta jen tuto promnnou nastavit na zatku programu na 0 a vce se o ni nezajmat (jen ji samozejm muste st namsto toho MEML).
Grafiku ve Free Pascalu budeme brt extra v njakm ptm dlu. Nic neslibuji, ale mon se jet potom podvme i na Windows API, kde si vytvome pr oken a tlatek (a se to naum). A jet potom budu brt zvukov karty a pak bude zvltn seril o komunikaci mezi potai (s IPX, sockety pes TCP a sriov kabel). Pokud se nkomu z Vs nechce ekat, nech se podv na www.volny.cz/martinlux, kde najde nejen spoustu program, kter vyuvaj klvesnici, my, zvukovou kartu, sriov port, i grafiku, ale tak v sekci Programovn/Perifrie tutorialy na zvukov karty, s IPX a komunikaci pes COM porty.
Tak, nauili jsme se 256barevn md a dle u nemusme. Jen podotknu, e pokud budete chtt pouvat nap. 800x600, tak muste provst jen pr vc:
8 bit 1024 16 bit 2048 24 bit 4096 32 bit 4096(daje jsou v bytech).
Nyn ale 256barevn reimy opustme a vrhneme se na nco lepho. Vrtme se k nim a budeme pevdt barvy, dve ne. Tabulku reim jsem uvdl v minulm dlu. Pokud nechcete pouvat vyhledvn, muste se spolehnout na ni. Take si te mete nastavit prakticky jakkoliv md. J bych jen tabulku doplnil o dal mdy, kter obas 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
Pedchoz tabulka vak tak plat (pod Windows 9X a DOSem ano, pod Linuxem asi ne, v DOSboxu by mla platit vdy i pod Linuxem). Nyn Vm chyb u jen jedno: vybrat si md, kter chcete pouvat a pepnout se do nj. Jak ale vytvet pixely? Pedem musme ci, e zde u neexistuje dn paleta. Do VVRAM tedy nebudete zapisovat indexy, ale pmo u RGB popis pixel.
Jak pixely vypadaj jsme si uvdli na zatku naeho serilu, take to opakovat nebudu. Uvedu jen funkce, kter zap pixel do pamti VVRAM (resp. pro zjednoduen jen do pole; opt plat, e pod DOSem muste 24 bitov pixely (3 byty) nejprve nast po 4 bytech (1 byte z druhho pixelu), pak zmnit ten prvn pixel a pak odeslat zase 4 byty). Tentokrt zde neuvdm zmnu banku, protoe ta je zvisl na aktulnm rozlien a dlce dku (stejn tak funkce OffsetXMS mus reflekovat aktuln rozmry 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 mli dobrho sprvce XMS nebo by V program bel jen pod Windows (ani na jedno nejde spolhat), 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 dobe i s 15 bitovmi, ale 15 bitov reimy nejsou rychlej, nezabraj mn VRAM, a navc maj 2x mn barev: jedin ospravedlniteln vyuit je u tch karet, kter 16 bitov reimy nepodporuj a Vy nechcete pouvat 32 bitov - nutno podotknout, e prce s 16 bity je pomalej ne s 24/32 bity zvlt, pokud mnte sloky RGB pixel, viz. dle):
function CtiPixel16(X,Y : word) : word; begin CtiXMS(OffsetXMS(X,Y),2); {pro (nkdy) zrychlen meme st i 4} Pixel16 := word(VasProstor^); {jinak se nic mnit 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 uiten, pokud potebujete pixely jen pesouvat nap. z obrzku do VVRAM pes test prhlednosti (transluciency je prsvitnost). Pokud samozejm chcete zobrazit jen dek, mete zase provst:
Move(Zdroj,Cil,DelkaRadku*BPP);
Ale pokud budete chtt s pixely pracovat (nap. je barvit, mnit jas, potat prsvitnost), budete potebovat znt jejich sloky. Take si napeme funkce, kter nm zjist sloky pixel (u 15/16 bitovch budou mt RGB sloky max. 32, resp. u G a 64 odstn; u 24/32 bit a 256), a tak funkce, kter takov rozloen pixel zase slo (nic Vm samozejm nebrn, abyste sloky RGB pmo zapsali do VVRAM bez skldn prostou pravou ve uvedench zapisovacch funkc). Tady se u funkce pro 15 a 16 bitov pixely bude liit (naopak funkce pro 24 bitov pixely me obslouit i 32 bitov, pokud nebudete potebovat nejvy byte):
procedure GetPix15(Pixel : word; var R,G,B : byte); assembler; asmmov 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 {vymaeme nejvy bit T} les di,r mov es:[di],blend; procedure GetPix16(Pixel : word; var R,G,B : byte); assembler; asmmov 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],blend; procedure GetPix24(Pixel : longint; var R,G,B : byte); assembler; asmmov 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],alend; procedure GetPix32(Pixel : longint; var R,G,B,T : byte); assembler; asmmov 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],alend;
Nezapomete, e intel ukld ve opan (aby se to dalo snadno petypovat), take v typu Longint mte sloky jako RGB od nejvyho bitu k nejnimu, ale v pamti jsou uloeny jako BGR (je to vhoda, pokud chcete udlat z LONGINTu BYTE, sta prost napsat Byte(L) a pete se jen 1. byte). Te jet funkce pro sloen pixelu (nezapomete, e do 15/16 bitovch pixel muste dvat sloky zmenen!):
procedure SetPix15(var Pixel : word; R,G,B : byte); assembler; asmxor bx,bx mov bl,r shl bx,5 or bl,g shl bx,5 or bl,b les di,pixel mov es:[di],bxend; procedure SetPix16(var Pixel : word; R,G,B : byte); assembler; asmxor bx,bx mov bl,r shl bx,6 or bl,g shl bx,5 or bl,b les di,pixel mov es:[di],bxend; procedure SetPix24(var Pixel : longint; R,G,B : byte); assembler; asmles 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],alend; procedure SetPix32(var Pixel : longint; R,G,B,T : byte); assembler; asmles 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 pevod sloek RGB mezi 15/16/24 pixely me vypadat nsledovn:
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 nkdy potebovali pevst pmo 16bitov pixel (pro 15bitov je poteba mal prava kvli prostednmu daji) na 24/32 bitov a obrcen (nap. mte obrzek v 16 bitech, ale VVRAM je 32 bitov - test na prhlednost mete dlat jednodue: slote si z RGB sloek 16 bitov daj a pak u jen testujete zda WORD v obrzku je stejn jako WORD prhledn barvy a pokud ano, nebudete ho muset pesouvat - je to rychlej ne testovat zvlt sloky RGB; podobn to mete dlat pro 24/32 bitov pixely v Longintu), mete vyut tyto dv funkce:
function Pixel16to24(Barva : word) : longint; assembler; asmmov 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,bxend; function Pixel24to16(Barva : longint) : word; assembler; asmmov 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 nezvldli, tak zde mte i 15bitov funkce:
function Pixel15to24(Barva : word) : longint; assembler; asmmov 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,7end; {vsledek je v DX:AX} function Pixel24to15(Barva : longint) : word; assembler; asmmov 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,cxend;
Samozejm mete pixely zapisovat pes Mem pmo do VasProstor po slokch R,G,B, ppadn je i rovnou pomoc SHR zmenovat, pokud mte 8 bitov sloky a potebujete pro HC jen 5/6 bitov.
Te, kdy vme, jak pracovat s pixely, tak si ukeme dva (resp. ti efekty), kter jsme trochu nakousli u 256barevnch reim. Jak zjistit, zda je pixel pln prhledn u vme (test <> nebo =). Jak ale spojit dva pixely, kdy jeden z nich je barva pozad a druh je trochu prhledn (barevn sklo)? Nebo jak obarvit pixel i zmnit jeho jas? Ve je velice jednoduch. Ukeme si to pro 24 bitov a 16 bitov pixely. Ostatn si snad jist odvodte sami. Prhlednost se standardn pot tmto vzorekem:
(HORNI*PRUHL+DOLNI*(100-PRUHL)) DIV 100
To v ppad, e bychom potali prhlednost pes 0-100%. To je ale velice pomal, take zkusme namsto destkov soustavy dvojkovou, kter potam sed o mnoho vce. Tuto metodu lze pout i pokud potebujete zprhlednit nkolik vrstev pixel nad sebou (sta, kdy pjdete od spodu a budete potat vdy dvojice Pozadi-DalsiVrstva, kdy do Pozadi postupn dosadte ji vypoten prniky). My budeme pro zjednoduen brt, e pro 8 bitov sloky plat, e 255 je neprhledn pixel, 0 je pln prhledn. Pro 6/5 bitov to bude 63, resp. 31. Pokud budeme potat jas (resp. pro R<>G<>B je to barven), tak budeme brt pro 8 bitov sloky, e 100% je 64, pro 6 bitov to bude 16, a pro 5 bitov 4. Tm zskme monost pixel a 4x zesvtlit, 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 meme vesele vytvet zajmav efekty, kdy se nm pixely prolnaj, atd. Pokud jedete ve 256 barvch a chcete vypotat prsvitnost dvou pixel, muste si pomoc jejich indexu zjistit z tabulky (paleta) jejich R,G,B sloky (pokud mono v rozsahu 0-255; nebo 0-63, kdy si ale muste napsat novou funkci), pak je pomoc ve uveden funkce zmixovat a pak muste podle vsledn R,G,B barvy najt njakou, kter pesn (nebo alespo piblin) odpovd njak barv v palet a podle n vrtte index. To budeme brt pozdji, dn strach.
Nejprve ale trochu optimalizace. Pokud budete chtt vypotat prhlednost celho obrzku, je zbyten neustle potat kad pixel. Stejn to plat i pro jas. Vemte si toto: mte obrzek 320x200 a chcete ho prhledn zobrazit na 75% viditelnosti pes pozad (nap. mlha), Pro 64.000x potat u kadho pixelu znovu vsledek? Kdy si to meme pedpotat pedem (asi se nevyplat u obrzk, kter maj mn ne 256-512 pixel, tj. nap. 16x16, 32x16, atd., leda e by jich lo po sob nkolik a vechny se stejnou % prhlednost). Bylo by samozejm ideln si na zatku programu pedpotat vechno, ale to by zabralo pli mnoho prostoru (tabulka pro osvtlen 256*256 = 64kB, a pro prhlednost dokonce 256*256*256 = 16 MB).
Vyeme to tak na pl. Tabulku pro osvtlen si meme vypost pi startu programu a to pro 64 odstn jasu. Tm si zachovme docela slun rozsah a pitom zmenme 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 dnen dob se u moc nevyplat podporovat 16 bitov reimy, protoe VRAM m na kart kad dost a navc vpoty s nimi jsou dost pomal - muste pevdt. Trochu Vs jen zachrn, e vlastn pente 50% a 66% pvodnch dat). Nyn, kdy budete chtt zjistit hodnotu njakho pixelu po zmn jasu, provedete to nsledovn (ZMENA je 0-255):
NOVYJAS := Jas[ZMENA shr 2,STARYJAS];
Pro kadou sloku pixelu. Tm se vpoet zkrtil na jedno SHR, jedno MUL (to TP7 dl, pokud si to pepete do ASM, mete MUL 256 nahradit SHL 8 a bude to jet rychlej) a MOV.
OK, jas (a barevnost) u umme mnit, te jak prhlednost. Nememe vyuvat vechny kombinace, protoe to by prost byla tabulka jak dlo (pod FP samozejm dn problm, ale uvdomte si, e 16 MB jen na tabulku nen ani v dnen dob zrovna astn npad: do tto velikosti mete nahrt destky sprit, kter Vm tedy budou chybt a budete muset zvyovat nroky na HW). Vyuijeme men nepesnosti lidskho oka. Sloky budete opt zadvat 0-255, stejn tak prhlednost, ale my budeme pouvat jen 32 stup prhlednosti (tedy nemusme ped kadm obrzkem potat tabulku znovu, pokud by pouval jinou ne ten pedchoz) a pouze 128 rovn jasu jednotlivch sloek u hornho pixelu a 64 u dolnho (budeme pedpokldat, e horn pixel bude vtinou vce vidt ne ten doln, resp. PRUHL bude 128 a ve, tch pr obasnch <128 zase a tak moc neukod). Tm se velikost tabulky zmen na 256 kB. Pokud se Vm to zd moc, mete zmenit poet stup na 16, a dostanete se na 128 kB (takovou tabulku ale mete mt i XMS (v ppad TP7, u FP je 256 kB nic, tam mete klidn dt spodnmu pixelu tak 128 odstn a tabulka bude mt jen 512 kB, co je snesiteln velikost) a penet vdy jen tu st, kterou potebujete (tj. vdy jen 128*64 byt pro dan stupe prsvitnosti, take v konvenn pamti bude vdy jen 8 kB - podobn to mete dlat i s jasem, kdy Vm bude stait mt v doln pamti vdy 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 {vpoet 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; {vpoet 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;
Vpoty jsou opt platn pro 8 bitov sloky pixel. Pro jin mte dv monosti: bu pepete algoritmus a nebo budete vechno potat jako v TC (tj. HC pixely pevedete na TC, spotate a zase pevedete zpt na HC). Pixely pak zmixujete tmto stylem:
{metoda pro TP7} ; pokud nen natena, nati 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];
Ve uveden je zameno hlavn na eten pamt, take pokud si mete dovolit pltvat, mete uetit jednu SHR instrukci a dt hornmu pixelu 256 jas (bez SHR) a dolnmu 128 (SHR 1). Tabulka bude mt pak 2 MB (nebo 1 MB, pokud zachovte 64 odstn pro doln). A pamatujte, e i VAR promnn jsou v konvenn pamti, take nemuste tabulku penet z XMS nejprve do njakho pointeru pes GETMEM a pak teprve do VAR (mete to udlat pmo; VAR je tak defakto pointer).
Dobr, nauili jsme se dlat efekty ve vych barvch. Co kdy ale nkdo neme vyuvat HC nebo TC a jede jen v 256 barvch? Musme je pevdt. Nam eenm je, e meme mt stejn vechny obrzky v pamti v TC a HC, stejn tak nai VVRAM (pokud ovem nepracujeme s 8 bitovmi, a jen potebujeme provst prhlednost, jak jsem psal ve). Vechny vpoty pak tak provdme v TC, a teprve, kdy potebujeme vykreslit VVRAM, pevedeme ji na 256 barev a tyto poleme do VRAM (vyuijeme jet njak dal pracovn buffer). Mme ti monosti, jak provdt tento pevod.
Prvn metoda je, e si nechme vytvoit paletu v odstnech edi. To jsme u brali. Pot, kdy dostaneme pixel, meme ho pevst jednodue tmto stylem:
INDEX := (R+G+B) div 3;
Nebo rychleji, kdy vyuijeme pracovn sloku (tu si mete nastavit na 0-255 a tm vlastn mnit gamma obrazu: pokud dte 0, nedostanete nikdy pln blou; pokud dte 255, nedostanete nikdy pln ernou):
INDEX := (R+G+B+X) shr 2;
Ano, i toto je metoda. Ale pokud chceme zobrazovat barevn, musme provdt pevod. Dejme tomu, e paletu u mme (jak ji dostaneme, o tom se zmnme pozdji). Budeme ji tedy muset prochzet a zjiovat, zda se sloky RGB pixelu shoduj se slokami njakho indexu. Protoe je ale nepravdpodobn, e by po zmn pixelu njak z nich byl pesn shodn s tm nam, budeme muset potat s jistou mrou tolerance. Jak s n nalome je na ns. Meme ji postupn zvyovat od 0 to 255, dokud nenajdeme pixel. Meme zvyovat vechny sloky narz (rychlej) nebo stdav (9x pomalej, ale pesnj). Meme tak mnit vdy jen + a pak jen -, ale to ns opt 4x zdr. Toleranci meme zvyovat po 1, nebo exponenciln (tj. 1,2,4,8,16,32, atd.), co je rychlej, ale me dt hor vsledky. J jsem si pro ukzku vybral metodu, kter zvyuje exponenciln a u vech sloek souasn 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 chtli zvyovat toleranci po 1, sta nm obyejn INC a nemusme dlat dn SHL (a navc uetme 1 promnnou). Pro real-time pevod rozlien nad 640x480 ale budete potebovat alespo 1 GHz procesor, abyste tam mohli provozovat adventuru nebo dungeon hru (zatmco u Gray palety nm sta obyejn 486 a u exponenciln metody poblin Pentium II). Dobe, najt barvu umme, ale kde seeneme paletu?
Mme nkolik een. Bu si paletu nateme z njakho externho souboru (768 byt), nebo z PEL registr video karty (to u umme), nebo si vytvome adaptivn paletu. Jak se to dl? Budeme potebovat celkem velk prostor na okldn dat. Pod FP opt nen problm, pod TP7 budeme asi potebovat vyuvat opt XMS. Budeme toti postupovat nsledovn: peteme pixel z VVRAM a zjistme, zda danou barvu u v tabulce mme. Pokud ne, pidme ji, pokud ano, zvme jej vskyt. Pro sporu msta je vhodn vyuvat barvy typu HC, protoe uetme 1 byte na barvu. Pak budeme moci dt vskyt WORD a tm budeme mt kadou poloku zarovnanou na DWORD. Pklad uvedu pro FP, pro TP7 si muste tabulku udlat v XMS a penet ideln vdy jen ty 2-4 byty tam a sem (nebo si pokat na lep metodu). Pod TP7 bychom tabulku dynamicky zvtovali, tj. bychom uloili hodnotu barvy a pot jej slo, zvili poet barev. Pi ptm vkldn bychom prohledvali u jen tolik barev, kolik bychom jich tam mli. Jednodu ale je, pokud si to meme dovolit (ono nm ani nic jinho nezbyde, pokud budeme potat s tm, e nm tabulka me stejn nabobtnat a na 65536 barev) udlat tabulku velkou 128 kB a mt v n jen vskyty barev, piem hodnota barvy se vezme jako index. To nm uet spoustu asu s prohledvnm:
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;
Dobe, te mme barvy. Co s nimi? Provedeme jejich tdn. Jakou metodu si zvolte nechm na Vs, j pouiji teba Bubble Sort. Protoe jsme si ale na zatku uetili as s ukldnm hodnoty barvy do tabulky, nememe nyn jen tak setdit tabulku, protoe bychom pak nevdli, kter vskyt patil kter barv. Musme proto udlat dal tabulku, kam nejprve ulome sla barev (resp. i jejich hodnoty), a tuto tabulku budeme tdit souasn.
var Zmena : boolean; index : word; Prac : word; Barvy : array[0..65535] of word; {toto v TP7 neudlte :-(} 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 mme setdnou (nejvce se vyskytujc barvy jdou prvn), a nyn zjistme, kolik v n je barev (dokud nenarazme na vskyt = 0 nebo na konec tabulky), jak je prmrn vskyt, a kter barva (index) tomuto prmru piblin odpovd.
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 {pedpokldm, e tabulka nen przdn} 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 vme, kter barva je prmr vech vskyt. Nyn peteme 256 barev v pomru 192:64 z obou oblast. Pro takto divn? 192 odstn vezmeme z tch barev, kter se vyskytuj nejastji, take budou mt vce monost. Ale nesmme zanedbat ani ty odstny, kter nejsou tak ast, ale jsou (jinak bychom o n pili). Tch ale vezmeme mn. Pokud je barev v tabulce 256 a mn, nemusme nic potat, prost pevezmeme celou tabulku (pozor! musme pevzt barvy z tabulky BARVY, ne poty vskyt, a musme je uloit normln od zatku, tj. prvn barvu z tabulky dme do PALETA[0], neobsazen barvy na konci vymaeme na $ff; toto pak pome naemu ve uvedenmu algoritmu ve hledn). Nyn tedy zjistme, po kolika barvch musme barvy z tabulky natat:
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 hzet je do palety. Musme samozejm pevst HC na TC a otoit poad sloek (u VGA palety je poad RGB, zatmco my mme pixely BGR, u VESy je to natst stejn, jen tam je o 1 byte na barvu navc). Pro tento el si zavedeme jet pr funkc, kter nm vyseparuj RGB sloky:
function R(pixel : longint) : byte; asmmov al,pixel+2.byteend; function G(pixel : longint) : byte; asmmov al,pixel+1.byteend; function B(pixel : longint) : byte; asmmov al,pixel.byteend;
A te vytvome 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 vpoet meme samozejm zavst dal promnnou, kter bude na zatku naplnna 0 nebo MEZem a budeme ji jen zvyovat pomoc INC o MeneSkok nebo ViceSkok (abychom nemuseli nsobit). Mme ale hlavn problm. Tuto legraci budeme toti muset provdt ped kadm kreslenm VVRAM do VRAM, protoe se nm tam mn pi nov zmn VVRAM (vtinou) podl barev. Jednodu een pro ns je provst toto pouze jednou a to po nahrn vech sprit, kter ve scn budou, do pamti. Pak vytvome tabulku nikoliv ze vech pixel VVRAM, ale ze vech pixel vech obrzk. V tomto ppad vytvome paletu (a nahrajeme ji do VGA karty) jen jednou.
Ale pro to dlat sloit, kdy to jde jednodue. Ukeme si jeden geniln trik, kter sice nevyuv adpativn paletu, ale doke i na prmrnm Pentiu provdt real-time (v relnm ase) pevod z TC na 256 barev a pitom obraz vypad skoro stejn jako pvodn TC obrzek. Zde jednodue vyuvme toho, e mme speciln vypotanou paletu a pak u jen bereme RGB sloky pmo jako index do tto palety (kter vypad takto: bbgg grrr). Geniln mylenky bvaj 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 vypotme nsledovn:
Index := word(R) and $e0+(word(G) shr 5) shl 2+word(B) shr 6;
A v tom je cel ten zzrak. Nyn si u tedy mete vychutnat krsu TC na potach, kter pro to teba ani nemaj VRAM. Vhodou tto druh metody je, e paletu sta tak vytvoit jen jednou a cel pevod VVRAM pak stejn probh nezvisle na tom, co tam mte za data. Jednu nevhodu to samozejm m: pokud bude cel Vae VVRAM zbarvena jen do 1 odstnu (nap. modr), pijdete o vtinu detail a bude to vypadat stran (zde by tedy mla nastoupit adaptivn pomalej metoda). Ale pro normln fotky je to vce ne dobr.
Fajn, umme zobrazovat, ale nemme co. Meme kreslit obrazce pomoc pixel, ale jednodu asi bude, kdy si na to vytvome njak ty procedury. Naume se kreslit ry (vodorovn, svisl, ikm), tverce a obdelnky, krunice a elipsy, a tak se je naume vyplovat barvou i vzorem. Pouijeme pr trik, abychom urychlili nae vykreslovn. Zaneme nejprve s tm nejjednodum - ry. Tady asi nen moc, co bych ml vysvtlovat:
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 horizontln jde vrazn urychlit (v TP7 jen pro BPP=1, v FP pro vechna, ale muste vdy pout sprvn Fill):
procedure Vodorovne(X1,X2,Y : word; Barva : byte); begin FillChar(VVRAM[X1,Y],X2-X1,Barva); end;
Kdy umme kreslit ry, tak umme kreslit i tverce a obdelnky:
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 nauit kreslit i ikm ry. Existuje spousta algoritm. My pouijeme ten (algoritmus nen mj), kter pot prstky rozdlu. Nebudeme ale pouvat reln sla (kvli 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 {rozdly v osch X a Y} DeltaX := abs(x2-x1); DeltaY := abs(y2-y1); {zkontrolujeme pesnost. Tm urme nezvislou promnnou} if (DeltaX >= DeltaY) then begin {X bude nezvisl promnn} 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 nezvisl promnn} 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; {Ujistme se, e X a Y se mn sprvnm smrem} if x1 > x2 then begin Xinc1 := -Xinc1; Xinc2 := -Xinc2; end; if y1 > y2 then begin Yinc1 := -Yinc1; Yinc2 := -Yinc2; end; {Zaneme 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 "sloitj" (i kdy krat) je vpoet krunice (algoritmus nen z m hlavy; u tch, co jsou, se ppadn omlouvm za peklepy a chyby, ale mli byste bt u na takov rovni, abyste si to byli schopni upravit, opravit a pizpsobit podle teorie). Ale zde je mon pomoci si tm, e je vlastn dokonale symetrick, take nm sta spotat si pouze 1/8 bod a ty ostatn promtneme pes osy X a Y, a zrove XY. Elipsa (algoritmus bohuel neznm) se kresl podobn (zkuste teba vyut Vae znalosti ze S z goniometrie a rovnice bodu na elipse), jen musme potat 2x tolik bod ne u krunice, protoe nen soumrn podle os XY, ale jen X a Y. Pstupy do VVRAM mete nahradit opt njakm tm pesunem do XMS, stejn tak si opt meme pedpotat opakujc se vpoty u X a Y. Jen upozoruji, e u nesymetrickch md, jako je nap. 320x200 (1.6:1) nebo 640x480 (1.33:1) nemus bt krunice kulat (pokud obrazovku "tpnete" do BMP a zobrazte nap. ve Windows, tak kulat na 99% bude), protoe pixely nejsou tvercov (proto budete muset kreslit spe elipsy). Je vhodn tak testovat, zda vykreslovan pixel nele mimo obrazovku (nebo nastaven vez).
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 mme hotov tvary (jedna perlika, pokud zmnte d<0 za d>0, dostanete kosotverec; prvnm SHL 2 mnte prohnut dovnit (m vt slo, tm se to bude podobat kosotverci se zaoblenmi rohy), druhm SHL 2 mnte vchylku ven (m vt slo, tm se to bude podobat tverci ze zaoblenmi rohy); pokud nahradte dvojice CX za CY nebo obrcen, dostanete z nkterch oblouk rovn ry a tedy i zajmav tvary). Meme se je nauit vyplovat. Tyto funkce funguj na principu zsobnku, kdy si ulo pixely, kter jsou vedle nich jet nevyplnn a dokud v zsobnku jet nco je a my stle mme jet dek pro plnn, opakujeme vykreslovn. Existuj dv varianty. Prvn hled pixely jen vedle sebe v osch XY. Je rychlej a tak se hod pro vyplovn krunic, elips a trojhelnk. Pomalej metoda, kter prohledv vech 8 os (tj. i ikmo) se nehod pro objekty, kter maj ikm ry (protoe "vytee" ven), ale pome u nkterch sloitjch objekt (to lze ale obejt prost tm, e vlote nkolik bod, odkud se zane vyplovat a pouijete "4"). Zsobnk muste udlat dostaten hlubok, aby u velkch i sloitch objekt stail (me bt poteba a destky 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 vypluj jednou barvou a to tm stylem, e vypln vechny pixely, kter nejsou urit barvy (OKRAJE) na barvu Barva. Mete si je samozejm upravit tak, aby fungovaly jen na barv, kterou urte (tedy budou vlastn nahrazovat barvu Okraje na Barvu ve svm nejblim okol) a to prostou zmnou pkazu <> na pkaz =. Meme si ale napsat i procedury, kter vykresluj plochu ne jednou barvou, ale njakm vzorkem. Aby ten drel na mst (tj. se rzn nerozjdl podle toho, jak moc je ikm lev i prav strana objektu, a odkud se zane vyplovat), budeme brt souadnice XY na obrazovce s uritou pravou jako souadnice v bufferu vzorku (ten je vlastn obyejn obrzek X*Y s BPP, jakou potebujete).
type TVzor = array[0..15,0..15] of RGB; var Vzorek : TVzor; {rozmry 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 nm AND msto 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, take umme kreslit 2D objekty. Ale chtli jste u nkdy kreslit i 3D? Nen nic snaho. Pro pepoet na 2D obrazovku se pouv vzoreek:
Xobr := (X * 512) DIV (Z + 512) + XobrMax div 2; Yobr := (Y * 512) DIV (Z + 512) + YobrMax div 2;
Jednodue do rovnic dosadte X,Y,Z (Z se vtinou pouv do 255) a vyjde Vm, na kter XY souadnice mte bod na obrazovku nakreslit. Mlo by tak platit, e m je bod dl, tm by ml bt tmav (pokud tam ovem nemte njak svj zdroj svtla, kter pipotete zlumen dle Z k jeho jasu podle toho, zda jeho Z le v oblasti, kde je svtlo). Rovnice lze samozejm upravovat dle efektu, kter chcete doshnout, take me vypadat teba 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 stedu obrazovky). Pokud se m kamera hbat, muste upravit rovnice teba takto:
Xobr := ((X+Xcam)*Vzdal) DIV (Z+Vzdal)+XobrMax div 2 Yobr := -((Y+Ycam)*Vzdal) DIV (Z+Vzdal)+YobrMax div 2
Vimnte si, e u Y souadnice je mnus. To je proto, jeliko souadnice na monitoru stoupaj odshora dol; ale pozici kamery na map vtinou vyjadujete tak, e Y=0 je dole, a smrem nahoru souadnice stoupaj. Vzdlenost me bt dle "oky" kamery, nap. 512 nebo nic (mete takto snadno doshnout i prothlho pohledu, kdy k Z nic pitat nebudete a budete zvyovat slo za nsobenm, resp. posunem vlevo). Kad bod XYZ mete brt jako st objektu. Pokud chcete nap. kreslit zdi jako u WOLFa 3D, sta Vm vdt, kde le dan bod na map a podle toho, kam se dvte (pokud se otote o 180 stup, tak muste tak zmnit souadnice objekt, co byly za Vmi (nebo si propotat souadnice svho pohledu), aby te leely jakoby ped Vmi, pokud jim nechte stejn XYZ, vyjdou nesmysly) to pepotat a pak pevst na XY. Pokud Vs to zajm, podvejte se do asopisu Vhe. Jen nutno podotknout, e pro kreslen her typu Prince of Persia (pseudo-3D) nebo Transport Tycoon (izometrie) nepotebujete tyto pevody, ale spe znalosti kreslen 3D technickch vkres, kdy zmente poet pixel na stranch, kter jsou jakoby 3D na 1/2 bu na Y (vrchn) nebo na X (krajn) jejich vynechnm, a kreslte je pod hlem 45 st., tedy vdy X+1 a Y+1.
Pokud ale chcete kreslit na obrazovku vce objekt, kter se budou zakrvat, nebo dokonce prolnat, asi narazte na problm, jak kreslit jednotliv body (jist, kreslit objekty od nejzadnjch po nejbli, ale co kdy jsou dva objekty propleten?). Mete si samozejm objekty uspodat, vyhodit ty strany, kter nejsou vidt (jsou od ns odvrcen), i ty, kter jsou zakryty cel jinm objektem, ale stle muste vykreslit body. Na toto se pouv tzv. Z-Buffer. Jedn se o pole, kter m stejn rozmry X*Y jako VVRAM (ale u nemus mt stejn BPP, protoe to bv vtinou 1 a 2 dle toho, jak me bt Z). Do Z bufferu se ukldaj, jak u nzev napovd, souadnice Z. Na zatku kadho vykreslovn ho naplnte max. hodnotami (255 pro byte) a vdy, kdy budete chtt kreslit bod, tak zjistte, zda jeho Z je men ne v to bufferu. Pokud ano, vlote jeho Z na toto msto a vykreslte jej. V opanm ppad jej "zahodte".
var ZBuffer : array[0..MaxY-1,0..MaxX-1] of byte;
A te pro kad obrzek provedete to, co je v nsledujcm pkladu (pokud je poteba dan pixel kreslit, tj. pokud jej ji nevyadila funkce testujc prhlednost). Kreslme obrzek Xobr*Yobr na souadnice Xv,Yv, a obrzek je dejme tomu natoen od 45 stup "dovnit" monitoru (ze). Pro kad bod musme Z njak vypotat (ideln si vypotejte Z prvnho a poslednho bodu, zjistte si rozdl, vynsobte 65536 (bez relnch sel potebujeme mt vt citlivost) a vydlte potem bod v obrzku (Yobr). Nastavte Z na Z bliho bodu. Nyn po peten kadho X zvyte njakou pracovn promnnou typu LONGINT o Zr*65536/X. Pokud bude pracovn promnn >=65536, zvyte Z o 1 a od t pracovn promnn odette 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 ; vypoteme Z, pokud je teba obrzek natoen ; vypoteme souadnice Xo a Yo na obrazovce if z < zbuffer[yo,xo] then begin Pixel(yo,xo,barva); zbuffer[yo,xo] := z; end; end;
Voala, a mme 3D prostor jak vyit. Te se u mete pustit do tvorby vlastnho Dooma (podlahy jsou to sam co zdi, jen se naklpj podle jin osy). Fajn, ale stle jet nemme co zobrazovat. Jasn, mme krunice a ry, ale kdo by dneska hrl hru na bzi drtnch model. Chtlo by to njak ty textury. Tak se naume st obrzky (a vytvome si i vlastn formt). Ale to a jindy :-)
*** POKRAOVN P͊T ***