Program Snake; uses crt,graph; type massiv=record x,y : integer; end; prepmas=record prepx, prepy: integer; end; var gd,gm: integer; chs, ch_k_v: integer; z: array[1..7] of byte; x_min, y_min, x_max, y_max, x, y, score, best: word; size,level, p: byte; kol,xrand,yrand: integer; n, k, l, o: word; way_x, way_y: shortint; score_str, best_str: string[10]; ch, chr, level_ch, chose_ch, key: char; mass: array[1..24,1..12] of massiv; point, exit: boolean; koor, helpkoor: array[1..400,1..2] of word; f: text; color: integer; oldpattern: fillpatterntype; prep: array[1..255] of prepmas; prepcol: integer; prepchar: char; prX: integer; oldmenuselect, menuselect: integer; oldoptionselect, optionselect: integer; oldcreatselect, creatselect: integer; oldloosemenuselect, loosemenuselect: integer; crtlvlselect, oldcrtlvlselect: integer; x0,y0,x01,y01: integer; pointcol: integer; {========================================================================} procedure zakrascircle(a,b,rad,color : integer); var oldpattern : fillpatterntype; begin setcolor(color); circle(a,b,rad); getfillpattern(oldpattern); setfillpattern(oldpattern,color); floodfill(a+1,b+1,color); end; {===========================================================================} procedure pole; var oldpattern : fillpatterntype; q : integer; begin zakrascircle(30,50,20,lightgreen); {Рамка} zakrascircle(610,50,20,lightgreen); zakrascircle(30,450,20,lightgreen); zakrascircle(610,450,20,lightgreen); line(30,30,610,30); line(30,50,610,50); getfillpattern(oldpattern); setfillpattern(oldpattern,lightgreen); floodfill(55,37,lightgreen); line(10,50,10,450); line(30,50,30,450); getfillpattern(oldpattern); setfillpattern(oldpattern,lightgreen); floodfill(20,200,lightgreen); line(30,450,610,450); line(30,470,610,470); getfillpattern(oldpattern); setfillpattern(oldpattern,lightgreen); floodfill(80,460,lightgreen); line(610,50,610,450); line(630,50,630,450); getfillpattern(oldpattern); setfillpattern(oldpattern,lightgreen); floodfill(615,200,lightgreen); setcolor(15); rectangle(30,50,610,450); getfillpattern(oldpattern); setfillpattern(oldpattern,15); floodfill(141,101,15); setcolor(7); {Сетка} q:=30; repeat line(q,50,q,450); q:=q+20; until q=610; q:=50; repeat line(30,q,610,q); q:=q+20; until q=450; setcolor(7); rectangle(30,50,610,450); end; {=======================================================================} procedure Delay(time:longint); var ctime,time2:Longint; begin ctime:=meml[$40:$006c]; time2:=time div 55+ctime; while time2>meml[$40:$006c] do; end; {========================================================================} procedure refreshloosemenu(loosemenuselect: integer); begin setcolor(1); if oldloosemenuselect=-1 then begin outtextxy(280,160, 'ДА'); outtextxy(280,180, 'НЕТ'); end else case oldloosemenuselect of 1:outtextxy(280,160, 'ДА'); 2:outtextxy(280,180, 'НЕТ'); end; oldloosemenuselect:=loosemenuselect; setcolor(4); case loosemenuselect of 1:outtextxy(280,160, 'ДА'); 2:outtextxy(280,180, 'НЕТ'); end; setlinestyle(0,0,1); end; {=======================================================================} PROCEDURE GAMEWITHOUTRANDOM(prepcol, level: integer); label lb1, lb2, lb3, lb4; BEGIN lb1: cleardevice; pole; {----------------------------------------} size:=5; x:=x_min+size*k; {Координаты "змейки"} y:=(y_max div 2)+5; setfillstyle(0,0); bar(x-size*k,y,x,y+k); way_x:=1; way_y:=0; for n:=1 to size do begin koor[n,1]:=x-n*k+k; koor[n,2]:=y end; point:=false; {----------------------------------------} settextstyle(2,0,6); { Текст навеpху } setcolor(15); outtextxy(50, 7, 'Очки:'); outtextxy(450,7, 'Рекоpg:'); setcolor(9); bar(530,7,640,0); {---------------------------------------} assign(f,'record.snk'); { Обpаботка файла с pекоpдом } reset(f); repeat read(f,ch); best_str:=best_str+ch; until eof(f); close(f); setcolor(2); outtextxy(530,7,best_str); {--------------------------------------} setfillstyle(0,0); bar(170,7,400,25); setcolor(15); outtextxy(210,7,'Уpовень:'); setcolor(3); if level=1 then outtextxy(290,7,'ЧЕРВЬ') else if level=2 then outtextxy(290,7,'ВЫПОЛЗОК') else if level=3 then outtextxy(290,7,'УЖ') else if level=4 then outtextxy(290,7,'ГАДЮКА') else if level=5 then outtextxy(290,7,'КОБРА') else if level=6 then outtextxy(290,7,'ПИТОН') else if level=7 then outtextxy(290,7,'УДАВ') else if level=8 then outtextxy(290,7,'АНАКОНДА') else if level=9 then outtextxy(290,7,'???!!!'); {-----------------------------------------------------------------} for prx:=1 to prepcol do begin {Рисование препятствий} setfillstyle(6,12); if prep[prx].prepx=610 then prep[prx].prepx:=prep[prx].prepx-20; if prep[prx].prepy=450 then prep[prx].prepy:=prep[prx].prepy-20; bar(prep[prx].prepx, prep[prx].prepy, prep[prx].prepx+20, prep[prx].prepy+20); end; pointcol:=0; REPEAT begin if keypressed then ch:=readkey; {управление} case ch of #72: if way_y=0 then begin way_x:=0; way_y:=-1 end; #75: if way_x=0 then begin way_x:=-1; way_y:=0 end; #77: if way_x=0 then begin way_x:=1; way_y:=0 end; #80: if way_y=0 then begin way_x:=0; way_y:=1 end; end; setfillstyle(1,15); bar(koor[size,1]-k, koor[size,2], koor[size,1], koor[size,2]+k); {------------------------------------------------------} for n:=size downto 2 do for l:=size downto 1 do { Пеpесчет кооpдинат } begin koor[n,1]:=koor[n-1,1]; koor[n,2]:=koor[n-1,2]; helpkoor[l,1]:=koor[n+1,1]-10; helpkoor[l,2]:=koor[n+1,2]+10; putpixel(helpkoor[1,1], helpkoor[1,2], 11); end; setcolor(7); if (koor[size,1]=koor[size-1,1]) and (koor[size,2]>koor[size-1,2]) then begin if (koor[size,2]+20)<>450 then rectangle(koor[size,1]-20, koor[size,2]+20, koor[size,1], koor[size,2]+40) end {Вверх} else if (koor[size,1]>koor[size-1,1]) and (koor[size,2]=koor[size-1,2]) then begin if (koor[size,1])<>610 then rectangle(koor[size,1], koor[size,2], koor[size,1]+20, koor[size,2]+20) end {Влево} else if (koor[size,1]<koor[size-1,1]) and (koor[size,2]=koor[size-1,2]) then begin if (koor[size,1]-20)<>30 then rectangle(koor[size,1]-40, koor[size,2], koor[size,1]-20, koor[size,2]+20) end {Вправо} else if (koor[size,1]=koor[size-1,1]) and (koor[size,2]<koor[size-1,2]) then begin if (koor[size,2])<>50 then rectangle(koor[size,1]-20, koor[size,2]-20, koor[size,1], koor[size,2]); end; {Вниз} koor[1,1]:=koor[1,1]+way_x*k; koor[1,2]:=koor[1,2]+way_y*k; {-------------------------------------------------} {Попадание в стену} if (koor[1,1]>x_max) or (koor[1,2]=y_max) or (koor[1,1]=x_min) or (koor[1,2]<y_min) then begin sound(100); delay(100); nosound; break end; {---------------------------------------------------------} if point=false then { Рисование точек } repeat begin randomize; x:=(random((x_max-x_min) div k)+1)*k+x_min; y:=(random((y_max-y_min) div k)+1)*k+y_min; point:=true; for n:=1 to size do for prx:=1 to prepcol do if ((x=koor[n,1]) and (y=koor[n,2]+k)) then point:=false else if (x=prep[prx].prepx+20) and (prep[prx].prepy+20=y) then point:=false; end; until point; setfillstyle(9,14); setcolor(2); fillellipse(x-10,y-10,10,10); setcolor(0); line(0,0,0,50); {--------------------------------------------------------} if (x=koor[1,1]) and (y=koor[1,2]+k) then { Съедание точек } begin sound(900); inc(size); setfillstyle(0,0); bar(105,1,200,25); inc(score,level); str(score,score_str); setcolor(9); outtextxy(110,7,score_str); point:=false; pointcol:=pointcol+1; end; {----------------------------------------------------------} for prx:=1 to prepcol do if (prep[prx].prepx+20=koor[1,1]) and (prep[prx].prepy+20=koor[1,2]+k) then begin sound(100); delay(100); {Попадание в препятствие} nosound; goto lb2; end; {------------------------------------------------------------} for n:=2 to size do { Самопеpесечение } if (koor[1,1]=koor[n,1]) and (koor[1,2]=koor[n,2]) then begin sound(150); delay(100); nosound; exit:=true; break end; setfillstyle(0,0); bar(koor[1,1]-k, koor[1,2], koor[1,1], koor[1,2]+k); delay(181-9*level); if point=false then nosound; if keypressed then ch:=readkey end; UNTIL exit or (pointcol=20); if pointcol=20 then begin level:=level+1; prepcol:=prepcol+1; o:=o+1; if level>9 then begin setcolor(12); setfillstyle(0,0); bar(200,7,350,20); outtextxy(220, 7, 'ИГРА ПРОЙДЕНА!'); goto lb4; end; setcolor(0); goto lb1; end; lb2:setfillstyle(0,0); bar(170,7,400,25); val(best_str,best,n); setcolor(12); lb4: if score<=best then begin setcolor(4); setlinestyle(0,0,3); rectangle(225,125, 415,200); setcolor(1); setlinestyle(0,0,3); rectangle(230,130, 410,195); setcolor(13); settextstyle(2,0,4); setcolor(0); outtextxy(240, 140, 'ВЫ ПРОИГРАЛИ! ХОТИТЕ ЕЩЕ?'); setcolor(1); oldloosemenuselect:=-1; loosemenuselect:=1; outtextxy(280,160, 'ДА'); outtextxy(280,180, 'НЕТ'); repeat if keypressed then begin key:=readkey; if key=#0 then key:=readkey; case key of #80: begin loosemenuselect:=loosemenuselect+1; if loosemenuselect>2 then loosemenuselect:=1; refreshloosemenu(loosemenuselect); end; #72: begin loosemenuSelect:=loosemenuselect-1; if loosemenuselect<1 then loosemenuselect:=2; Refreshloosemenu(loosemenuSelect); end; #13: begin case loosemenuselect of 1: begin o:=o+1; if o>3 then begin level:=1; prepcol:=1; score:=0; goto lb1; end else begin score:=0; goto lb1; end; end; 2: begin break; o:=o+1; end; end; end; end; end; until (loosemenuselect=2) and (key=#13); setlinestyle(0,0,1); end else begin setcolor(4); setlinestyle(0,0,3); rectangle(225,130, 415,155); setcolor(1); setlinestyle(0,0,3); rectangle(230,135, 410,150); setcolor(13); settextstyle(2,0,4); setcolor(0); outtextxy(240, 140, 'НОВЫЙ РЕКОРД!'); setcolor(1); rewrite(f); write(f,score_str); close(f) end; repeat ch:=readkey until (ch>#0) and (ch<>#72) and (ch<>#75) and (ch<>#77) and (ch<>#80); closegraph; lb3: END; {======================================================================} PROCEDURE GAME(level, prepcol: integer); label lb1, lb2, lb3, lb4, lb5; BEGIN x_min:=30; y_min:=50; x_max:=610; y_max:=450; k:=20; o:=0; lb1: cleardevice; pole; {----------------------------------------} size:=5; x:=x_min+size*k; {Координаты "змейки"} y:=(y_max div 2)+5; setfillstyle(0,0); bar(x-size*k,y,x,y+k); way_x:=1; way_y:=0; for n:=1 to size do begin koor[n,1]:=x-n*k+k; koor[n,2]:=y end; point:=false; {----------------------------------------} settextstyle(2,0,6); { Текст навеpху } setcolor(15); outtextxy(50, 7, 'Очки:'); outtextxy(450,7, 'Рекоpg:'); setcolor(9); bar(530,7,640,0); if o>=1 then goto lb5; {---------------------------------------} assign(f,'record.snk'); { Обpаботка файла с pекоpдом } reset(f); repeat read(f,ch); best_str:=best_str+ch; until eof(f); close(f); lb5: setcolor(2); outtextxy(530,7,best_str); {--------------------------------------} setfillstyle(0,0); bar(170,7,400,25); setcolor(15); outtextxy(210,7,'Уpовень:'); setcolor(3); if level=1 then outtextxy(290,7,'ЧЕРВЬ') else if level=2 then outtextxy(290,7,'ВЫПОЛЗОК') else if level=3 then outtextxy(290,7,'УЖ') else if level=4 then outtextxy(290,7,'ГАДЮКА') else if level=5 then outtextxy(290,7,'КОБРА') else if level=6 then outtextxy(290,7,'ПИТОН') else if level=7 then outtextxy(290,7,'УДАВ') else if level=8 then outtextxy(290,7,'АНАКОНДА') else if level=9 then outtextxy(290,7,'???!!!'); {-----------------------------------------------------------------} for prX:=1 to prepcol do {Рисование препятствий} begin prep[prx].prepx:=(random((x_max-x_min) div k)+1)*k+x_min; prep[prx].prepy:=(random((y_max-y_min) div k)+1)*k+y_min; if prep[prx].prepx=610 then prep[prx].prepx:=prep[prx].prepx-20; if prep[prx].prepy=450 then prep[prx].prepy:=prep[prx].prepy-20; setfillstyle(6,12); bar(prep[prx].prepx,prep[prx].prepy, prep[prx].prepx+20,prep[prx].prepy+20); end; {----------------------------------------------} pointcol:=0; REPEAT begin if keypressed then ch:=readkey; {управление} case ch of #72: if way_y=0 then begin way_x:=0; way_y:=-1 end; #75: if way_x=0 then begin way_x:=-1; way_y:=0 end; #77: if way_x=0 then begin way_x:=1; way_y:=0 end; #80: if way_y=0 then begin way_x:=0; way_y:=1 end; end; setfillstyle(1,15); bar(koor[size,1]-k, koor[size,2], koor[size,1], koor[size,2]+k); {------------------------------------------------------} for n:=size downto 2 do for l:=size downto 1 do { Пеpесчет кооpдинат } begin koor[n,1]:=koor[n-1,1]; koor[n,2]:=koor[n-1,2]; helpkoor[l,1]:=koor[n+1,1]-10; helpkoor[l,2]:=koor[n+1,2]+10; putpixel(helpkoor[1,1], helpkoor[1,2], 11); end; setcolor(7); if (koor[size,1]=koor[size-1,1]) and (koor[size,2]>koor[size-1,2]) then begin if (koor[size,2]+20)<>450 then rectangle(koor[size,1]-20, koor[size,2]+20, koor[size,1], koor[size,2]+40) end {Вверх} else if (koor[size,1]>koor[size-1,1]) and (koor[size,2]=koor[size-1,2]) then begin if (koor[size,1])<>610 then rectangle(koor[size,1], koor[size,2], koor[size,1]+20, koor[size,2]+20) end {Влево} else if (koor[size,1]<koor[size-1,1]) and (koor[size,2]=koor[size-1,2]) then begin if (koor[size,1]-20)<>30 then rectangle(koor[size,1]-40, koor[size,2], koor[size,1]-20, koor[size,2]+20) end {Вправо} else if (koor[size,1]=koor[size-1,1]) and (koor[size,2]<koor[size-1,2]) then begin if (koor[size,2])<>50 then rectangle(koor[size,1]-20, koor[size,2]-20, koor[size,1], koor[size,2]); end; {Вниз} koor[1,1]:=koor[1,1]+way_x*k; koor[1,2]:=koor[1,2]+way_y*k; {-------------------------------------------------} {Попадание в стену} if (koor[1,1]>x_max) or (koor[1,2]=y_max) or (koor[1,1]=x_min) or (koor[1,2]<y_min) then begin sound(100); delay(100); nosound; break end; {---------------------------------------------------------} if point=false then { Рисование точек } repeat begin randomize; x:=(random((x_max-x_min) div k)+1)*k+x_min; y:=(random((y_max-y_min) div k)+1)*k+y_min; point:=true; for n:=1 to size do for prx:=1 to prepcol do if ((x=koor[n,1]) and (y=koor[n,2]+k)) then point:=false else if (x=prep[prx].prepx+20) and (prep[prx].prepy+20=y) then point:=false; end; until point; setfillstyle(9,14); setcolor(2); fillellipse(x-10,y-10,10,10); {--------------------------------------------------------} if (x=koor[1,1]) and (y=koor[1,2]+k) then { Съедание точек } begin sound(900); inc(size); setfillstyle(0,0); bar(105,1,200,25); inc(score, level); str(score,score_str); setcolor(9); outtextxy(110,7,score_str); point:=false; pointcol:=pointcol+1; end; {----------------------------------------------------------} for prx:=1 to prepcol do if (prep[prx].prepx+20=koor[1,1]) and (prep[prx].prepy+20=koor[1,2]+k) then begin sound(100); delay(100); {Попадание в препятствие} nosound; goto lb2; end; {------------------------------------------------------------} for n:=2 to size do { Самопеpесечение } if (koor[1,1]=koor[n,1]) and (koor[1,2]=koor[n,2]) then begin sound(150); delay(100); nosound; exit:=true; break end; setfillstyle(0,0); bar(koor[1,1]-k, koor[1,2], koor[1,1], koor[1,2]+k); delay(181-9*level); if point=false then nosound; if keypressed then ch:=readkey end; UNTIL exit or (pointcol=20); if pointcol=20 then begin level:=level+1; prepcol:=prepcol+1; o:=o+1; if level>9 then begin setcolor(12); setfillstyle(0,0); bar(200,7,350,20); outtextxy(220, 7, 'ИГРА ПРОЙДЕНА!'); goto lb4; end; setcolor(0); goto lb1; end; lb2:setfillstyle(0,0); bar(170,7,400,25); val(best_str,best,n); setcolor(12); lb4: if score<=best then begin setcolor(4); setlinestyle(0,0,3); rectangle(225,125, 415,200); setcolor(1); setlinestyle(0,0,3); rectangle(230,130, 410,195); setcolor(13); settextstyle(2,0,4); setcolor(0); outtextxy(240, 140, 'ВЫ ПРОИГРАЛИ! ХОТИТЕ ЕЩЕ?'); setcolor(1); oldloosemenuselect:=-1; loosemenuselect:=1; outtextxy(280,160, 'ДА'); outtextxy(280,180, 'НЕТ'); repeat if keypressed then begin key:=readkey; if key=#0 then key:=readkey; case key of #80: begin loosemenuselect:=loosemenuselect+1; if loosemenuselect>2 then loosemenuselect:=1; refreshloosemenu(loosemenuselect); end; #72: begin loosemenuSelect:=loosemenuselect-1; if loosemenuselect<1 then loosemenuselect:=2; Refreshloosemenu(loosemenuSelect); end; #13: begin case loosemenuselect of 1: begin o:=o+1; if o>3 then begin level:=1; prepcol:=1; score:=0; goto lb1; end else begin score:=0; goto lb1; end; end; 2: begin break; o:=o+1; end; end; end; end; end; until (loosemenuselect=2) and (key=#13); setlinestyle(0,0,1); end else begin setcolor(4); setlinestyle(0,0,3); rectangle(225,130, 415,155); setcolor(1); setlinestyle(0,0,3); rectangle(230,135, 410,150); setcolor(13); settextstyle(2,0,4); setcolor(0); outtextxy(240, 140, 'НОВЫЙ РЕКОРД!'); setcolor(1); rewrite(f); write(f,score_str); close(f) end; repeat ch:=readkey until (ch>#0) and (ch<>#72) and (ch<>#75) and (ch<>#77) and (ch<>#80); closegraph; lb3: END; {======================================================================} procedure refreshmenu(menuselect: integer); begin setcolor(1); if oldmenuselect=-1 then begin outtextxy(280,180, 'НОВАЯ ИГРА'); outtextxy(280,200, 'СОЗДАТЬ УРОВЕНЬ'); outtextxy(280,220, 'ПОМОЩЬ'); outtextxy(280,240, 'АВТОРЫ'); outtextxy(280,260, 'ВЫХОД'); end else case oldmenuselect of 1:outtextxy(280,180, 'НОВАЯ ИГРА'); 2:outtextxy(280,200, 'СОЗДАТЬ УРОВЕНЬ'); 3:outtextxy(280,220, 'ПОМОЩЬ'); 4:outtextxy(280,240, 'АВТОРЫ'); 5:outtextxy(280,260, 'ВЫХОД'); end; oldmenuselect:=menuselect; setcolor(4); case menuselect of 1:outtextxy(280,180, 'НОВАЯ ИГРА'); 2:outtextxy(280,200, 'СОЗДАТЬ УРОВЕНЬ'); 3:outtextxy(280,220, 'ПОМОЩЬ'); 4:outtextxy(280,240, 'АВТОРЫ'); 5:outtextxy(280,260, 'ВЫХОД'); end; setlinestyle(0,0,1); end; {================================================================} procedure help; begin cleardevice; pole; setcolor(4); setlinestyle(0,0,3); rectangle(225,125, 415,345); setcolor(1); setlinestyle(0,0,3); rectangle(230,130, 410,340); setcolor(13); settextstyle(2,0,4); setcolor(0); outtextxy(300, 150, 'ПОМОЩЬ'); setcolor(1); repeat outtextxy(290,170, 'УПРАВЛЕНИЕ: '); outtextxy(270,190, 'курсорные клавиши'); outtextxy(250,210, 'СОЗДАНИЕ ПРЕПЯТСТВИЯ:'); outtextxy(280,230, 'клавиша пробела'); outtextxy(260,250, 'ПРОИГРАТЬ СОЗДАННЫЙ'); outtextxy(250,270, 'УРОВЕНЬ: клавиша ENTER'); outtextxy(250,290, ''); outtextxy(250,310, ''); outtextxy(250,330, ''); if keypressed then key:=readkey; if key=#27 then break; until keypressed; setlinestyle(0,0,1); end; {==================================================} procedure authors; begin cleardevice; pole; setcolor(4); setlinestyle(0,0,3); rectangle(225,125, 415,345); setcolor(1); setlinestyle(0,0,3); rectangle(230,130, 410,340); setcolor(13); settextstyle(2,0,4); setcolor(0); outtextxy(300, 150, 'АВТОРЫ'); setcolor(1); repeat outtextxy(240,170, 'CREATED BY AVGUSTINOVICH A.I.'); outtextxy(280,190, '("Ale}{@ndeR")'); outtextxy(270,210, 'MEMBER OF CLANS:'); outtextxy(270,230, 'Half-Life: HLF!31'); outtextxy(270,250, 'Line][age: Night Watch'); outtextxy(290,270, 'AP-11 TEAM'); outtextxy(250,290, 'PROGRAM FOR FREEWARE USING'); outtextxy(250,310, ''); outtextxy(250,330, ''); if keypressed then key:=readkey; if key=#27 then break; until keypressed; setlinestyle(0,0,1); end; {====================================================================} procedure refreshoptions(optionsselect: integer); begin setcolor(1); if oldoptionselect=-1 then begin outtextxy(280,160, 'ЧЕРВЬ'); outtextxy(280,180, 'ВЫПОЛЗОК'); outtextxy(280,200, 'УЖ'); outtextxy(280,220, 'ГАДЮКА'); outtextxy(280,240, 'КОБРА'); outtextxy(280,260, 'ПИТОН'); outtextxy(280,280, 'УДАВ'); outtextxy(280,300, 'АНАКОНДА'); outtextxy(280,320, '???!!!'); end else case oldoptionselect of 1: outtextxy(280,160, 'ЧЕРВЬ'); 2: outtextxy(280,180, 'ВЫПОЛЗОК'); 3: outtextxy(280,200, 'УЖ'); 4: outtextxy(280,220, 'ГАДЮКА'); 5: outtextxy(280,240, 'КОБРА'); 6: outtextxy(280,260, 'ПИТОН'); 7: outtextxy(280,280, 'УДАВ'); 8: outtextxy(280,300, 'АНАКОНДА'); 9: outtextxy(280,320, '???!!!'); end; oldoptionselect:=optionselect; setcolor(4); case optionselect of 1: outtextxy(280,160, 'ЧЕРВЬ'); 2: outtextxy(280,180, 'ВЫПОЛЗОК'); 3: outtextxy(280,200, 'УЖ'); 4: outtextxy(280,220, 'ГАДЮКА'); 5: outtextxy(280,240, 'КОБРА'); 6: outtextxy(280,260, 'ПИТОН'); 7: outtextxy(280,280, 'УДАВ'); 8: outtextxy(280,300, 'АНАКОНДА'); 9: outtextxy(280,320, '???!!!'); end; setlinestyle(0,0,1); end; {==============================================================} procedure options; begin cleardevice; pole; setcolor(4); setlinestyle(0,0,3); rectangle(225,125, 415,345); setcolor(1); setlinestyle(0,0,3); rectangle(230,130, 410,340); setcolor(13); settextstyle(2,0,4); setcolor(0); outtextxy(240, 140, 'ВЫБЕРИТЕ УРОВЕНЬ СЛОЖНОСТИ'); setcolor(1); oldoptionselect:=-1; optionselect:=1; outtextxy(280,160, 'ЧЕРВЬ'); outtextxy(280,180, 'ВЫПОЛЗОК'); outtextxy(280,200, 'УЖ'); outtextxy(280,220, 'ГАДЮКА'); outtextxy(280,240, 'КОБРА'); outtextxy(280,260, 'ПИТОН'); outtextxy(280,280, 'УДАВ'); outtextxy(280,300, 'АНАКОНДА'); outtextxy(280,320, '???!!!'); repeat if keypressed then begin key:=readkey; if key=#0 then key:=readkey; case key of #80: begin optionselect:=optionselect+1; if optionselect>9 then optionselect:=1; refreshoptions(optionselect); end; #72: begin optionSelect:=optionselect-1; if optionselect<1 then optionselect:=9; Refreshoptions(optionSelect); end; #13: begin case optionselect of 1: GAME(1,1); 2: GAME(2,2); 3: GAME(3,3); 4: GAME(4,4); 5: GAME(5,5); 6: GAME(6,6); 7: GAME(7,7); 8: GAME(8,8); 9: GAME(9,9); end; end; end; end; until (key=#27)or((key=#13)and(optionselect=9)); setlinestyle(0,0,1); end; {====================================================================} procedure creatingmenuoptions; begin cleardevice; pole; setcolor(4); setlinestyle(0,0,3); rectangle(225,125, 415,345); setcolor(1); setlinestyle(0,0,3); rectangle(230,130, 410,340); setcolor(13); settextstyle(2,0,4); setcolor(0); outtextxy(240, 140, 'ВЫБЕРИТЕ УРОВЕНЬ СЛОЖНОСТИ'); setcolor(1); oldoptionselect:=-1; optionselect:=1; outtextxy(280,160, 'ЧЕРВЬ'); outtextxy(280,180, 'ВЫПОЛЗОК'); outtextxy(280,200, 'УЖ'); outtextxy(280,220, 'ГАДЮКА'); outtextxy(280,240, 'КОБРА'); outtextxy(280,260, 'ПИТОН'); outtextxy(280,280, 'УДАВ'); outtextxy(280,300, 'АНАКОНДА'); outtextxy(280,320, '???!!!'); repeat if keypressed then begin key:=readkey; if key=#0 then key:=readkey; case key of #80: begin optionselect:=optionselect+1; if optionselect>9 then optionselect:=1; refreshoptions(optionselect); end; #72: begin optionSelect:=optionselect-1; if optionselect<1 then optionselect:=9; Refreshoptions(optionSelect); end; #13: begin case optionselect of 1: GAMEWITHOUTRANDOM(prepcol,1); 2: GAMEWITHOUTRANDOM(prepcol,2); 3: GAMEWITHOUTRANDOM(prepcol,3); 4: GAMEWITHOUTRANDOM(prepcol,4); 5: GAMEWITHOUTRANDOM(prepcol,5); 6: GAMEWITHOUTRANDOM(prepcol,6); 7: GAMEWITHOUTRANDOM(prepcol,7); 8: GAMEWITHOUTRANDOM(prepcol,8); 9: GAMEWITHOUTRANDOM(prepcol,9); end; end; end; end; until (key=#27)or((key=#13)and(optionselect=9)); setlinestyle(0,0,1); end; {=================================================================} procedure levelcreating; label lab1; begin cleardevice; pole; prepcol:=1; setcolor(4); setlinestyle(0,0,1); x0:=30; y0:=50; x01:=50; y01:=70; rectangle(x0,y0,x01,y01); repeat lab1: if keypressed then begin prepchar:=readkey; case prepchar of #80: begin setcolor(4); y0:=y0+20; y01:=y01+20; rectangle(x0,y0,x01,y01); setcolor(7); line(x0,y0,x0,y0-20); line(x0,y0-20,x01,y0-20); line(x01,y0-20,x01,y0); end; #75: begin setcolor(4); x0:=x0-20; x01:=x01-20; rectangle(x0,y0,x01,y01); setcolor(7); line(x01,y0,x01+20,y0); line(x01+20,y0,x01+20,y01); line(x01+20,y01,x01,y01); end; #72: begin setcolor(4); y0:=y0-20; y01:=y01-20; rectangle(x0,y0,x01,y01); setcolor(7); line(x0,y01,x0,y01+20); line(x0,y01+20,x01,y01+20); line(x01,y01+20,x01,y01); end; #77: begin setcolor(4); x0:=x0+20; x01:=x01+20; rectangle(x0,y0,x01,y01); setcolor(7); line(x0,y0,x0-20,y0); line(x0-20,y0,x0-20,y01); line(x0-20,y01,x0,y01); end; #32: begin setfillstyle(6,12); bar(x0,y0,x01,y01); prep[prepcol].prepx:=x0; prep[prepcol].prepy:=y0; if prep[prepcol].prepx=610 then prep[prepcol].prepx:=prep[prepcol].prepx-20; if prep[prepcol].prepy=450 then prep[prepcol].prepy:=prep[prepcol].prepy-20; prepcol:=prepcol+1; end; end; end; until prepchar=#13; if prepchar=#13 then creatingmenuoptions; end; {=====================================================================} procedure mainmenu; begin gd:=detect; initgraph(gd,gm,''); x_min:=30; y_min:=50; x_max:=610; y_max:=450; k:=20; cleardevice; pole; setcolor(4); setlinestyle(0,0,3); rectangle(225,145, 415,315); setcolor(1); setlinestyle(0,0,3); rectangle(230,150, 410,310); setcolor(13); settextstyle(2,0,4); oldmenuselect:=-1; menuselect:=1; outtextxy(280,180, 'НОВАЯ ИГРА'); outtextxy(280,200, 'СОЗДАТЬ УРОВЕНЬ'); outtextxy(280,220, 'ПОМОЩЬ'); outtextxy(280,240, 'АВТОРЫ'); outtextxy(280,260, 'ВЫХОД'); setlinestyle(0,0,1); refreshmenu(1); repeat if keypressed then begin key:=readkey; if key=#0 then key:=readkey; case key of #80: begin menuselect:=menuselect+1; if menuselect>5 then menuselect:=1; refreshmenu(menuselect); end; #72: begin menuSelect:=menuselect-1; if menuselect<1 then menuselect:=5; RefreshMenu(MenuSelect); end; #13: begin case menuselect of 1: options; 2: levelcreating; 3: help; 4: authors; 5: break; end; end; end; end; until (key=#27) or ((key=#13)and(menuselect=5)); end; {==================================================================} BEGIN gd:=detect; initgraph(gd,gm,''); mainmenu; closegraph; END.