Delphi & Pascal (èeská wiki)
{ DATA.PAS } { Kniznica pre python. } { } { Author: WERBHOFEN } { Datum: 12.10.2009 http://www.trsek.com } (* Datovy subor ku programu Python2.pas *) procedure NovyBod; (* nahodne zvoli 1. bod, ktory treba zobrat *) begin Bod.x:=random(57)+2; Bod.y:=random(22)+2; end; procedure VykresliHada; (* nanovo vykresli celeho hada *) var i:integer; begin textbackground(FarbaHad); for i:=1 to DlzkaHada-1 do WriteXY(had[i].x,had[i].y,' '); textbackground(FarbaPozadie); end; procedure Kraj; var n:integer; begin textbackground(FarbaOkraj); (* hracia plocha *) window(1,1,60,25); ClrScr; textbackground(black); window(2,2,59,24); ClrScr; textbackground(FarbaOkraj); (* pravy kraj obrazovky *) window(62,1,80,25); clrscr; textbackground(black); window(63,2,79,24); clrscr; textcolor(FarbaText); n:=4; WriteXY(n,3,'Hi-Score'); GotoXY(n,4); Write(highscore:2); WriteXY(n,6,'Your Score'); GotoXY(n,7); Write(score:2); WriteXY(n,9,'Life'); GotoXY(n,10); Write(life:2); WriteXY(n,12,'Level'); GotoXY(n,13); Write(level:2); WriteXY(n,21,'Space = Pause'); WriteXY(n,22,' ESC = Quit'); window(1,1,80,25); end; procedure ZvukPrehra; (* zvuk pri narazeni hada *) var i:integer; begin i:=0; repeat i:=i+1; if zvuky then sound(random(500)); cakaj(10); until i=50; nosound; end; procedure ZvukNovyClanok; (* zvuk pri prejdeni cez novy clanok *) var i:integer; begin for i:=1 to 10 do begin if zvuky then sound(i*100); cakaj(10); end; nosound; end; procedure UvodnaObrazovka; var x,y:integer; begin NoSound; x:=4; y:=3; textmode(1); VymazKurzor; textbackground(black); textcolor(FarbaOkraj); clrscr; gotoxy(x,y+0); write('ÛÛÛ Û Û ÛÛÛÛÛ Û Û ÛÛÛ Û Û'); gotoxy(x,y+1); write('Û Û Û Û Û Û Û Û Û ÛÛ Û'); gotoxy(x,y+2); write('Û Û Û Û Û ÛÛÛÛÛ Û Û Û Û Û'); gotoxy(x,y+3); write('ÛÛÛ Û Û Û Û Û Û Û ÛÛ'); gotoxy(x,y+4); write('Û Û Û Û Û Û Û Û Û'); gotoxy(x,y+5); write('Û Û Û Û Û ÛÛÛ Û Û'); gotoxy(x+10,y+9); writeln('Version 2.0'); gotoxy(x+10,y+10); write('by WERBHOFEN'); textcolor(26); WriteXY(x+8,18,'Press any key ...'); ClearKeyboardBuffer; g:=readkey; if g=#27 then KoniecProgramu:=true; textmode(2); VymazKurzor; end; procedure VymenSmer; var u,i:integer; n,m:array[1..100] of integer; begin (* superpoziciou poslednych 2 clankov *) case had[1].x-had[2].x of (* vypocita novy smer hada po stlaceni *) -1: Smer:=4; (* opacneho smeru, akym sa had pohybuje *) 1: Smer:=2; else case had[1].y-had[2].y of -1: Smer:=1; 1: Smer:=3; end; end; u:=0; i:=DlzkaHada+1; repeat (* otoci hada naopak - tam, kde bola predna cast je *) u:=u+1; (* zadna cast a tam, kde bola zadna cast je predna *) i:=i-1; (* cast (vymeni suradnice) *) m[u]:=had[i].x; n[u]:=had[i].y; until i=1; i:=0; repeat i:=i+1; had[i].x:=m[i]; had[i].y:=n[i]; until i=DlzkaHada; end; procedure okno(s:string;color:byte); begin textcolor(color); textbackground(farbahad); WriteXY(27,11,s); g:=readkey; textbackground(FarbaPozadie); WriteXY(27,11,' '); VykresliHada; textbackground(FarbaHad); WriteXY(Bod.x,Bod.y,' '); textbackground(FarbaPozadie); end; procedure vymaz(oneskorenie:integer;zvuk:boolean); (* vymaze hracu plochu po ukonceni hry *) var y,r,i:integer; begin textbackground(6); y:=y2; i:=0; repeat (* maze z dola hore *) y:=y-1; i:=i+30; if zvuk and zvuky then sound(i); cakaj(oneskorenie); WriteXY(X1+1,y,' '); until y=y1+1; textbackground(FarbaPozadie); y:=y1; repeat (* maze z hora dole *) y:=y+1; i:=i-30; if zvuk and zvuky then sound(i); cakaj(oneskorenie); WriteXY(X1+1,y,' '); until y=y2-1; nosound; end; procedure borec; begin window(1,1,80,25); clrscr; KoniecHry:=true; textcolor(30); WriteXY(35,11,'SI BOREC !!!'); ClearKeyboardBuffer; g:=readkey; end; procedure NoveKolo; BEGIN StarySmer:=smer; textcolor(FarbaPozadie); (* vymaze posledny clanok z hada *) textbackground(FarbaPozadie); WriteXY(had[1].x,had[1].y,' '); gotoxy(had[1].x,had[1].y); cakaj(oneskorenie); while keypressed do begin g:=readkey; case g of #80: smer:=3; #72: smer:=1; #75: smer:=4; #77: smer:=2; #32: okno('PAUSE',30); #27: begin okno('QUIT?(Y/N)',FarbaText); if (g='Y')or(g='y') then KoniecProgramu:=true; end; end; end; textcolor(FarbaPozadie); (* vymaze posledny clanok z hada *) textbackground(FarbaPozadie); WriteXY(had[1].x,had[1].y,' '); gotoxy(had[1].x,had[1].y); textcolor(FarbaText); gotoxy(66,4); write('Hi-Score'); gotoxy(66,5); write(highscore:2); gotoxy(66,7); write('Your Score'); gotoxy(66,8); write(score:2); textbackground(FarbaHad); (* furt prekresluje bod na zobratie, je tu totiz *) WriteXY(Bod.x,Bod.y,' '); (* 'podozrenie' na miznutie tohto bodu v pripade *) textbackground(FarbaPozadie); (* ze sa objavi na suradniciach ktore uz ma had *) i:=0; repeat (* posunie vsetky suradnice v hadovi o 1 do predu *) i:=i+1; had[i].x:=had[i+1].x; had[i].y:=had[i+1].y; until i=DlzkaHada-1; case smer of (* zatacanie + posunutie (ovladanie) hada *) 1: if StarySmer=3 then VymenSmer else had[DlzkaHada].y:=had[DlzkaHada].y-1; 2: if StarySmer=4 then VymenSmer else had[DlzkaHada].x:=had[DlzkaHada].x+1; 3: if StarySmer=1 then VymenSmer else had[DlzkaHada].y:=had[DlzkaHada].y+1; 4: if StarySmer=2 then VymenSmer else had[DlzkaHada].x:=had[DlzkaHada].x-1; end; if (had[DlzkaHada].x=Bod.x)and(had[DlzkaHada].y=Bod.y) (* had sa trafil na dalsi bod *) then begin score:=score+100; BodyPreNovyZivot:=BodyPreNovyZivot+100; DlzkaHada:=DlzkaHada+1; (* dlzka hada sa zvacsila o jeden clanok *) if score>highscore then highscore:=score; if BodyPreNovyZivot>NovyZivot then begin life:=life+1; oneskorenie:=oneskorenie-10; BodyPreNovyZivot:=0; end; if DlzkaHada<level+PocetKociek (* had este nema dlzku potrebnu na skoncenie levelu *) then begin ZvukNovyClanok; case smer of 1: begin had[DlzkaHada].x:=Bod.x; had[DlzkaHada].y:=Bod.y-1; end; 2: begin had[DlzkaHada].x:=Bod.x+1; had[DlzkaHada].y:=Bod.y; end; 3: begin had[DlzkaHada].x:=Bod.x; had[DlzkaHada].y:=Bod.y+1; end; 4: begin had[DlzkaHada].x:=Bod.x-1; had[DlzkaHada].y:=Bod.y; end; end; NovyBod; end else begin (* had ma dlzku potrebnu na skoncenie levelu *) KoniecKola:=true; level:=level+1; textbackground(FarbaHad); textcolor(FarbaText); WriteXY(29,11,'YOU WIN !!!'); g:=readkey; vymaz(100,true); if DlzkaHada=MaxDlzkaHada then borec; end; end; i:=0; repeat (* narazanie hada sameho do seba *) i:=i+1; if (had[DlzkaHada].x=had[i].x)and(had[DlzkaHada].y=had[i].y) then prehra:=true; until (i=DlzkaHada-1)or(prehra); (* narazenie hada do steny *) if (had[DlzkaHada].x=x1)or(had[DlzkaHada].x=x2)or(had[DlzkaHada].y=y1)or(had[DlzkaHada].y=y2)then prehra:=true; if prehra then begin ZvukPrehra; KoniecKola:=true; life:=life-1; if life<=0 then begin KoniecHry:=true; textbackground(FarbaHad); textcolor(FarbaText); WriteXY(23,11,'GAME OVER !!!'); g:=readkey; vymaz(100*2,false); end else vymaz(100 div 3,false); end; textbackground(FarbaHad); (* vykresli novy clanok hada *) WriteXY(had[DlzkaHada].x,had[DlzkaHada].y,' '); textbackground(FarbaPozadie); END;