Program pre otáčanie texturou pomocou kolineránich transformácií
Delphi & Pascal (česká wiki)
Category: KMP (Club of young programmers)
Program: Krychle.pas, U_crt.pas, U_graf13.pas, U_znacka.pas
File exe: Krychle.exe
need: Textura2.bmp, Textura2.obj
Program: Krychle.pas, U_crt.pas, U_graf13.pas, U_znacka.pas
File exe: Krychle.exe
need: Textura2.bmp, Textura2.obj
Program pre otáčanie texturou pomocou kolineránich transformácií.
{ krychle.pas } { Program pre otacanie kockou pomocou kolineranich transformacii. } { } { Kolinerani transformace: } { a1*x + a2*y + a3 b1*x + b2*y + b3 } { X' = ------------------ Y' = ------------------ } { c1*x + c2*y + 1 c1*x + c2*y + 1 } { } { Upravena kolinearni transformace: X' = la/lc, Y' = lb/lc } { } { la a lb je vetsi nez lc x krat, kde x je velikost textury (= tak } { 9 bitove cislo) } { } { lc se nastavi tak aby bylo co nejvetsi ale ne vetsi jak 15 bitu } { (16 je znamenko), a o trochu mene kvuli preteceni pres 15 bitu diky} { zaokrouhlovani (viz s := 32000/s a ne 32768/s) } { } { la a lb maji tedy max 24 bitu. Max chyba ze zaokrouhlovani cisla } { la nebo lb {je 320*0.5=+-160 (v prave casti obrazu) } { } { Author: } { Datum:02.02.2008 http://www.trsek.com } {$M 1200,64640,64640} {$D-,E-,G+,I-,L-,N-,P+,Q-,R-,S-,T-,V-,Y- exe} {B+,D+,L+,I+,Q+,R+,S+,T+,V+,Y+ ladici} {$N+,G+} Uses U_Znacka,U_Graf13,U_CRT; Type BGRNul= record Blue :Byte; Green:Byte; Red :Byte; Nula :Byte; {vzdy = 0} End; TypPaleta256=Array[0..255] of BGRNul; Vektor = Array [1..3] of Single; TypBaze=Array[1..3] of Vektor; _Sour = record x,y:Single; end; _Bod = record Old,New:_Sour; End; Sour2D = Record Sour:_Sour; JeVidet:Boolean; End; Const Xpul= 159; Ypul= 99; RozhledX = 300; RozhledY = 240; TvrdyMaxPol=6; TvrdyMaxHran=4; TvrdyMaxBod=8; MaxPol{:Word}=6; MaxBod{:Word}=8; Uhly:array[1..5] of Integer=(1,3,7,9,3); Posun:Byte = 4; Cekej:Byte=0; Ohen:Boolean=False; Rotace:Boolean=False; Pohyb:Boolean=False; Stop:Boolean=False; StredPohybuKrychle:Array[1..3] of Integer =(80,0,0); StredKrychle:Array[1..3] of Single =(110,0,0); LokalKrychle:array[1..TvrdyMaxBod,1..3] of Integer= {1}((-20, 20,-20), {2} (-20,-20,-20), {3} ( 20,-20,-20), {4} ( 20, 20,-20), {5} (-20, 20, 20), {6} (-20,-20, 20), {7} ( 20,-20, 20), {8} ( 20, 20, 20)); {[polygon,0]=pocet bodu, viditelna strana ve smeru hod rucicek} SezPolBod:array[1..TvrdyMaxPol,1..TvrdyMaxHran] of Integer= {1}((1,2,3,4), {2} (3,7,8,4), {3} (1,5,6,2), {4} (3,2,6,7), {5} (1,4,8,5), {6} (5,8,7,6)); BazeOka:TypBaze=((1,0,0),(0,1,0),(0,0,1)); BazeKrychle:TypBaze=((1,0,0),(0,1,0),(0,0,1)); VekStredu:TypBaze=((1,0,0),(0,1,0),(0,0,1)); Ident:Array[1..4] of _Bod=( {New = velikost obrazku} (Old:(X:0;Y:0);New:(X:0 ;Y:0)), (Old:(X:0;Y:0);New:(X:0 ;Y:199)), (Old:(X:0;Y:0);New:(X:207;Y:199)), (Old:(X:0;Y:0);New:(X:207;Y:0))); Var CTab:Array[0..39] of Single; STab:Array[0..39] of Single; Body :Array[1..TvrdyMaxBod,1..3] of Single; {3D souradnice polygonu} Kolmy:Array[1..TvrdyMaxPol] of Vektor; {smeruje dovnitr (od viditelne strany k neviditelne)} Paleta256:^TypPaleta256; _Ofs,TOfs,_13Ofs,_13Seg:Word; a1,a2,a3,b1,b2,b3,c1,c2:Single; Oko :Vektor; {3D souradnice} Obr :Array [1..TvrdyMaxBod] of Sour2D; {2D souradnice polygonu} Matice:Array[0..8,0..8] of Single; {[sloupce,radky]} Roz :String[2]; procedure Textura2;external; {$L textura2.obj} Procedure NastavMatici; Var a:Byte; Begin For a := 1 to 4 do Begin {a1} Matice[0,a] := Ident[a].Old.X; {a2} Matice[1,a] := Ident[a].Old.Y; {a3} Matice[2,a] := 1; {b1} Matice[3,a] := 0; {b2} Matice[4,a] := 0; {b3} Matice[5,a] := 0; {c1} Matice[6,a] := -Ident[a].Old.X*Ident[a].New.X; {c2} Matice[7,a] := -Ident[a].Old.Y*Ident[a].New.X; {X'} Matice[8,a] := Ident[a].New.X; {a1} Matice[0,a+4] := 0; {a2} Matice[1,a+4] := 0; {a3} Matice[2,a+4] := 0; {b1} Matice[3,a+4] := Ident[a].Old.X; {b2} Matice[4,a+4] := Ident[a].Old.Y; {b3} Matice[5,a+4] := 1; {c1} Matice[6,a+4] := -Ident[a].Old.X*Ident[a].New.Y; {c2} Matice[7,a+4] := -Ident[a].Old.Y*Ident[a].New.Y; {Y'} Matice[8,a+4] := Ident[a].New.Y; End; End; Procedure GaussovaEliminacniMetoda; Var a,min,y,x:Byte; d:Single; Procedure ZamenRadky(r1,r2:Byte); Var a:Byte; r:Single; Begin For a := 0 to 8 do Begin r := Matice[a,r1]; Matice[a,r1] := Matice[a,r2]; Matice[a,r2] := r; End; End; Begin FOR min := 1 TO 7 do Begin {Vyber radku} d := 0; FOR y := Min TO 8 do Begin IF ABS(Matice[Min-1,y]) > d Then Begin a := y; d := ABS(Matice[Min-1,y]); End; End; IF d = 0 Then Continue; ZamenRadky(Min,a); FOR y := min + 1 TO 8 do Begin d := -Matice[min - 1, y] / Matice[min - 1, min]; FOR x := min - 1 TO 8 do Matice[x, y] := Matice[x, min] * d + Matice[x, y]; End; End; FOR y := 8 DownTO 1 do Begin d := Matice[8, y]; FOR a := y TO 7 do d := d - Matice[a, y] * Matice[a, 0]; IF Matice[y-1,y] <> 0 then Matice[y - 1, 0] := d / Matice[y - 1, y] Else Matice[y - 1, 0] := 0; End; a1 := Matice[0,0]; a2 := Matice[1,0]; a3 := Matice[2,0]; b1 := Matice[3,0]; b2 := Matice[4,0]; b3 := Matice[5,0]; c1 := Matice[6,0]; c2 := Matice[7,0]; End; Procedure XLoadPal; Var a:Integer; Begin For a := 0 to 255 do SetRGBPalette(a,Paleta256^[a].Red,Paleta256^[a].Green,Paleta256^[a].Blue); SetRGBPalette(255,255,255,255); LoadPal; End; Procedure SSouc(Var Vek1,Vek2,Vek3:Vektor); Var r:Single; Begin Vek1[1] := Vek2[2] * Vek3[3] - Vek2[3] * Vek3[2]; Vek1[2] := Vek2[3] * Vek3[1] - Vek2[1] * Vek3[3]; Vek1[3] := Vek2[1] * Vek3[2] - Vek2[2] * Vek3[1]; r := sqrt(Vek1[1] * Vek1[1] + Vek1[2] * Vek1[2] + Vek1[3] * Vek1[3]); Vek1[1] := Vek1[1] / r; Vek1[2] := Vek1[2] / r; Vek1[3] := Vek1[3] / r; end; Procedure OtocBazi(var Baze:TypBaze;Od,K,Uhel:ShortInt); Begin Baze[Od,1] := Baze[Od,1] * ctab[Uhel] + Baze[K,1] * stab[Uhel]; Baze[Od,2] := Baze[Od,2] * ctab[Uhel] + Baze[K,2] * stab[Uhel]; Baze[Od,3] := Baze[Od,3] * ctab[Uhel] + Baze[K,3] * stab[Uhel]; SSouc(Baze[K],Baze[K Mod 3 + 1],Baze[6-K-(K Mod 3 + 1)]); End; Procedure PohybOka; Procedure PosunOka(a,b:ShortInt); Begin Oko[1] := Oko[1] + BazeOka[a,1] * posun * b; Oko[2] := Oko[2] + BazeOka[a,2] * posun * b; Oko[3] := Oko[3] + BazeOka[a,3] * posun * b; End; begin {proti smeru hodinovych rucicek} IF (roz = ',') OR (roz = '<') THEN OtocBazi(BazeOka,3,2,Posun); {po smeru hodinovych rucicek} IF (roz = '.') OR (roz = '>') THEN OtocBazi(BazeOka,2,3,Posun); {dopredu} IF roz = '+' THEN PosunOka(1,1); {dozadu} IF roz = '-' THEN PosunOka(1,-1); IF Roz[1] = #0 Then Case Roz[2] of {nahoru} 'H': OtocBazi(BazeOka,3,1,Posun); {dolu} 'P': OtocBazi(BazeOka,1,3,Posun); {doleva} 'K': OtocBazi(BazeOka,1,2,Posun); {doprava} 'M': OtocBazi(BazeOka,2,1,Posun); {ukrok vlevo} 's': PosunOka(2,1); {ukrok vpravo} 't': PosunOka(2,-1); {ukrok nahoru} 'I': PosunOka(3,1); {ukrok dolu} 'Q': PosunOka(3,-1); End; {case} End; Procedure VypocetKolmychVektoru; var a,b:Integer; x,y:Vektor; Begin For a := 1 to MaxPol do Begin For b := 1 to 3 do Begin x[b] := Body[SezPolBod[a,3],b] - Body[SezPolBod[a,2],b]; y[b] := Body[SezPolBod[a,1],b] - Body[SezPolBod[a,2],b]; End; SSouc(Kolmy[a],x,y); End; End; Procedure PocitejBody; var a:integer; cos,dx,dy,dz,t:Single; PomVek:vektor; begin FOR a := 1 TO MaxBod do begin dx := body[a, 1] - Oko[1]; dy := body[a, 2] - Oko[2]; dz := body[a, 3] - Oko[3]; {cos...skalarni soucin normaly roviny a smeroveho vektoru primky (dx,dy,dz) cos = |1|*|dxyz|*cos(Fi) cos = 0 tak primka je rovnobezna s rovinou => bod je v rovine oka cos < 0 tak bod je za okem} cos := BazeOka[1,1] * dx + BazeOka[1,2] * dy + BazeOka[1,3] * dz; IF cos = 0 THEN Obr[a].JeVidet := False ELSE Begin {t..pomer mezi vzdalenosti (oko..prusecik)/(oko..bod) 1..sqr(vek[1,1]) + sqr(vek[1,2]) + sqr(vek[1,3]) t = (1/cos)*(1/(oko..bod)} t := 1 / cos; IF t > 0 Then Obr[a].JeVidet := True Else Obr[a].JeVidet := False; {pomvek = vektor v rovine obrazu od stredu obrazu(bodu H, H-Oko=vek[1]) k pruseciku} PomVek[1] := -BazeOka[1,1] + dx * t; PomVek[2] := -BazeOka[1,2] + dy * t; PomVek[3] := -BazeOka[1,3] + dz * t; Obr[a].Sour.x := Xpul - rozhledx * (PomVek[1] * BazeOka[2,1] + PomVek[2] * BazeOka[2,2] + PomVek[3] * BazeOka[2,3]); Obr[a].Sour.y := Ypul - rozhledy * (PomVek[1] * BazeOka[3,1] + PomVek[2] * BazeOka[3,2] + PomVek[3] * BazeOka[3,3]); end; end; end; Procedure Info; Begin SetColor(255); AktObraz13 := True; ClearDevice; OutTextXY(1,1,'OVLADANI'#13); OutText(#24','#25','#26','#27',<,>...otaceni baze'#13); OutText('+,-,Ctrl'#26',Ctrl'#27',PUp,PDown...posun baze'#13); OutText('F1...tato napoveda'#13); OutText('F2,F3...+,- zdrzovaci lhuty v 0.055 s'#13); OutText('F4...prepinac simulace ohne'#13); OutText('F5...prepinac rotace objektu'#13); OutText('F6...prepinac pohybu objektu'#13); OutText('P...prepinac krokovani (ceka se na'#13' stisk klavesy)'#13); OutText('R,G,B...prepinac slozek barvy'#13); OutText('1 az 9...velikost otoceni a posunu'#13); Outtext('Q,Esc...konec'#13); AktObraz13 := False; Repeat Until KeyPressed; While KeyPressed do ReadKey; End; procedure ZobrazPoly4(Polygon:Byte); var a,sum:Byte; y,x1,x2:Integer; fromx,tox,s,s2,value:Single; DeltaXY:array[1..4] of Single; Xa,Ya:array[0..4] of Single; Ba:array[0..4] of Boolean; Bool:Boolean; lc,ldc,la,lb,lda,ldb:LongInt; begin For a := 1 to 4 do Xa[a] := Obr[SezPolBod[Polygon,a]].Sour.X; For a := 1 to 4 do Ya[a] := Obr[SezPolBod[Polygon,a]].Sour.Y; For a := 1 to 4 do Ba[a] := Obr[SezPolBod[Polygon,a]].JeVidet; Xa[0] := Xa[4]; Ya[0] := Ya[4]; Ba[0] := Ba[4]; For a := 1 to 4 do if not(Ya[a]=Ya[a-1]) Then deltaxy[a]:=(Xa[a]-Xa[a-1])/(Ya[a]-Ya[a-1]); for y:= 0 to 199 do begin fromx:=320; tox:=-1; sum := 0; For a := 1 to 4 do IF not(ya[a]=ya[a-1]) Then IF Ba[a] Or Ba[a-1] Then Begin IF Ba[a] xor Ba[a-1] Then Begin IF Ba[a] Then Begin if ya[a]-ya[a-1] < 0 Then s := -1 Else s := 200; Bool := ((s>=y)or(ya[a]>=y)) and ((s<=y)or(ya[a]<=y)); end; IF Ba[a-1] Then Begin if ya[a-1]-ya[a] < 0 Then s := -1 Else s := 200; Bool := ((s>=y)or(ya[a-1]>=y)) and ((s<=y)or(ya[a-1]<=y)); end; End Else Bool := ((ya[a-1]>=y)or(ya[a]>=y)) and ((ya[a-1]<=y)or(ya[a]<=y)); IF Bool Then begin value:=(y-ya[a-1])*deltaxy[a] + xa[a-1]; if value<fromx then fromx:=value; if value>tox then tox:=value; If Sum = 0 then Begin {s2 + tak textura pokracuje doprava, - doleva} IF Ba[a] Then Begin s2 := Ya[a-1]-Ya[a]; if not Ba[a-1] Then s2 := -s2; End Else {If Ba[a-1] Then} s2 := Ya[a]-Ya[a-1]; End; Sum := Sum + 1; end; end; if sum = 1 {=3, tak hrana je bez "drobnych"} Then Begin If (s2 < 0) and (tox > 0) Then fromx := 0 Else If (s2 > 0) and (fromx < 319) then tox := 319; end; if fromx<0 then fromx:=0; if tox>319 then tox:=319; If fromx<tox then Begin x1 := Round(fromx+0.5); x2 := Trunc(tox); IF x1 > x2 then Continue; s := abs(c2*y + 1); s2:= abs(320*c1 + c2*y + 1); IF s2 > s Then s := s2; s2 := abs(320*c1); IF s2 > s Then s := s2; If s = 0 Then Exit; s := 32000/s; lda := Trunc(a1*s); ldb := Trunc(b1*s); ldc := Trunc(c1*s*65536); la := Trunc(((x1-1)*a1+a2*y+a3)*s); lb := Trunc(((x1-1)*b1+b2*y+b3)*s); lc := Trunc(((x1-1)*c1+c2*y+ 1)*s*65536); { Kolinerani transformace: a1*x + a2*y + a3 b1*x + b2*y + b3 X' = ------------------ Y' = ------------------ c1*x + c2*y + 1 c1*x + c2*y + 1 Upravena kolinearni transformace: X' = la/lc, Y' = lb/lc la a lb je vetsi nez lc x krat, kde x je velikost textury (= tak 9 bitove cislo) lc se nastavi tak aby bylo co nejvetsi ale ne vetsi jak 15 bitu (16 je zna- menko), a o trochu mene kvuli preteceni pres 15 bitu diky zaokrouhlovani (viz s := 32000/s a ne 32768/s) la a lb maji tedy max 24 bitu. Max chyba ze zaokrouhlovani cisla la nebo lb je 320*0.5=+-160 (v prave casti obrazu) S 16 bitovym lc pri vetsim priblizeni textura "tepala" tak jsem lc vynasobil 65536=(shl 16) ale delim jen 16 hornimy bity. Max chyba pri zaokrouhlovani je 320*0.5/65536=0.0024=0 a diky tomu ze pri deleni vezmu hornich 16 bitu bez ohledu na spodni tak +-0.99..=+-1 I pres usilovnou snahu nastava obcas chyba, kdy by pri deleni vzniklo cislo vetsi nez 16 bitu a program by vytuhl s hlaskou "ze se deli nulou". Nastava to jen kdyz je oko prilis blizko krychle. Proto obsahuje nize vkladany assembler test (jae @Error) zda to nastane. Ten test samozrejmne trochu zpomaluje rutinu. } Asm mov DI,_13Ofs MOV BX,y XCHG BH,BL ADD DI,BX SHR BX,2 ADD DI,BX mov ax,x1 add di,ax MOV _Ofs,DI mov cx,x2 sub cx,ax inc cx jmp @Dal {takhle blbe do delam kvuli tomu ze: false js = 1 cyklus, true js = 3 cykly} @11: db $66; neg [word ptr la] db $66; neg [word ptr lda] jmp @1 @22: db $66; neg [word ptr lb] db $66; neg [word ptr ldb] jmp @2 @33: db $66; neg [word ptr lc] db $66; neg [word ptr ldc] jmp @3 @Error: INC _Ofs DEC CX JZ @Exit @Dal: mov ax,word ptr[lda] mov bx,word ptr[lda+2] add word ptr[la],ax adc word ptr[la+2],bx js @11 @1: mov ax,word ptr[ldb] mov bx,word ptr[ldb+2] add word ptr[lb],ax adc word ptr[lb+2],bx js @22 @2: mov ax,word ptr[ldc] mov bx,word ptr[ldc+2] add word ptr[lc],ax adc word ptr[lc+2],bx js @33 @3: mov bx,word ptr[lc+2] or bx,bx jz @Error mov dx,word ptr[la+2] mov ax,word ptr[la] cmp dx,bx jae @Error div bx mov DI,TOfs add DI,ax mov dx,word ptr[lb+2] mov ax,word ptr[lb] cmp dx,bx jae @Error div bx SHL AX,4 ADD DI,AX SHL AX,2 ADD DI,AX SHL AX,1 ADD DI,AX MOV AL,CS:[DI] MOV ES,_13Seg MOV BX,_Ofs MOV ES:[BX],AL INC BX MOV _Ofs,BX loop @dal @Exit: End; End; {fromx < tox} End; {y} End; Procedure LokalDoAbs; Var a,b:Byte; Begin For a := 1 to TvrdyMaxBod do For b := 1 to 3 do Body[a,b] := StredKrychle[b] + LokalKrychle[a,1]*BazeKrychle[1,b] + LokalKrychle[a,2]*BazeKrychle[2,b] + LokalKrychle[a,3]*BazeKrychle[3,b]; VypocetKolmychVektoru; End; Procedure PohybKrychle; Var a:Byte; Begin IF (Random(10)= 0) AND (Random(10)=0) Then Uhly[4]:= (Uhly[4] + 1) mod 40; IF (Random(10)= 0) AND (Random(10)=0) Then Uhly[5]:= (Uhly[5] + 1) mod 40; {nahoru/dolu} OtocBazi(VekStredu,3,1,Uhly[4]); {doleva/doprava} OtocBazi(VekStredu,1,2,Uhly[5]); For a := 1 to 3 do StredKrychle[a] := StredPohybuKrychle[a] + 30*VekStredu[1,a]; End; Procedure PohybBazeKrychle; Begin IF (Random(10)= 0) AND (Random(10)= 0) Then Uhly[1]:= (Uhly[1] + 1) mod 40; IF (Random(10)= 0) AND (Random(10)= 0) Then Uhly[2]:= (Uhly[2] + 1) mod 40; IF (Random(10)= 0) AND (Random(10)= 0) Then Uhly[3]:= (Uhly[3] + 1) mod 40; {po/proti smeru hodinovych rucicek} OtocBazi(BazeKrychle,2,3,Uhly[1]); {nahoru/dolu} OtocBazi(BazeKrychle,3,1,Uhly[2]); {doprava/doleva} OtocBazi(BazeKrychle,2,1,Uhly[3]); End; Var a,b:Integer; s :Single; JeVidet:Boolean; t :LongInt; begin asm {rychle opakovani dlouho(nastaveno na kratce) stiskle klavesy} mov ax,$0305 mov bx,$0000 int 16h end; {0,1..9,10, 9..1, 0,-1..-9,-10,-9..-1} {0,1..9,10,11..19,20,21..29, 30,31..39} ctab[0] := 1; stab[0] := 0; s := pi/(4*180); For a := 1 to 10 do Begin ctab[a] := cos(s); ctab[20-a]:= ctab[a]; stab[a] := sin(s); stab[20-a]:= stab[a]; s := s * (1 + 1/a); End; For a := 20 to 39 do Begin ctab[a] := ctab[a-20]; stab[a] := -stab[a-20]; End; Paleta256:= @Textura2; TOfs := Ofs(Paleta256^) + 1024 + 54; Paleta256 := PTR(Seg(Paleta256^),Ofs(Paleta256^)+54); InitGraph; _13Ofs := Ofs(Schranka13^); _13Seg := Seg(Schranka13^); XLoadPal; Info; ClearDevice; AktObraz13 := False; LokalDoABS; Repeat IF Pohyb Then PohybKrychle; IF Rotace Then PohybBazeKrychle; IF Pohyb Or Rotace Then LokalDoABS; IF Not Ohen Then ClearDevice; { SetColor(255);} For a := 1 to MaxPol do begin JeVidet := False; FOR b := 1 to 4 do begin IF Obr[SezPolBod[a,b]].JeVidet Then JeVidet := True; Ident[b].Old.X := Obr[SezPolBod[a,b]].Sour.X; Ident[b].Old.Y := Obr[SezPolBod[a,b]].Sour.Y; end; IF JeVidet then begin {vektorovy soucin, s= |x|*|y|*cos(alfa)} s := 0; For b := 1 to 3 do s := s + Kolmy[a,b]*(Body[SezPolBod[a,1],b]-Oko[b]); if s > 0 then Begin NastavMatici; GaussovaEliminacniMetoda; ZobrazPoly4(a); end; end; end; IF Ohen then Rozmazni; SetColor(255); CIRCLE(15, 10, 9); a:=15 - Round(10 * BazeOka[1,2]); b:=10 - Round(9 * BazeOka[1,1]); LINE (15, 10, a,b); CIRCLE(15, 29, 9); a:= Round(10 * Sqrt(ABS(1 - BazeOka[1,3] * BazeOka[1,3]))); IF BazeOka[3,3] < 0 THEN a := -a; a:= 15 + a; b:= 29 - Round(9 * BazeOka[1,3]); LINE (15, 29, a,b); Tet13.y := 15; Tet13.X := 30; OutInteger(Time-t); Tet13.x := 30; Tet13.y := 25; OutInteger(Cekej); If Red13 Then OutTextXY(30,5,'R'); If Green13 Then OutTextXY(38,5,'G'); If Blue13 Then OutTextXY(46,5,'B'); If Stop Then OutTextXY(54,5,'P'); t := Time; ZobrazSchranku13; IF Stop Then Repeat Until KeyPressed;; IF KeyPressed Then Begin Roz := UpCase(ReadKey); IF Roz = #0 then Roz := Roz + ReadKey; End Else Roz := #255; Delay27(Cekej); IF (Roz = 'Q') or (Roz = #27) THEN Begin CloseGraph; Halt; End; {F1} IF Roz = #0#59 Then Info; IF (Roz = #0#60) or (Roz=#0#61) then Begin {F2} IF (Roz = #0#60) AND (Cekej < 9) Then Cekej := Cekej + 1; {F3} IF (Roz = #0#61) AND (Cekej > 0) Then Cekej := Cekej - 1; End; {F4} IF Roz = #0#62 Then Ohen := Not Ohen; {F5} IF Roz = #0#63 Then Rotace := Not Rotace; {F6} IF Roz = #0#64 Then Pohyb := Not Pohyb; {1..9} For a := 1 to 9 do IF ord(roz[1]) = 48+a Then Posun := a; If Roz = 'R' Then Red13 := Not Red13; If Roz = 'G' Then Green13 := Not Green13; If Roz = 'B' Then Blue13 := Not Blue13; If (Roz = 'R') OR (Roz = 'G') OR (Roz = 'B') Then Begin IF Not(red13 OR green13 OR blue13) Then XLoadPal Else Begin InitPalRGB; SetRGBPalette(255,255,255,255); LoadPal; End; End; IF Roz = 'P' Then Stop := Not Stop; PohybOka; PocitejBody; Until False; End.