program buldozer; uses crt,graph; var gd,gm:integer; c:char; poz,ns:byte; rez1,rez,ok:boolean; x,y,xofst1,yofst1,xofst2,yofst2,xofst3,yofst3:integer; function stena(x,y:integer;poz:byte):boolean;forward; function shar(x,y,xofst1,yofst1,xofst2,yofst2,xofst3,yofst3:integer; poz:byte; var ns:byte;var ok:boolean):boolean;forward; function stena(x,y:integer;poz:byte):boolean; begin case poz of 1: if(y>20)and(x<>100)and(x<>500)then stena:=true else stena:=false; 2: if(y<340)and(x<>100)and(x<>500)then stena:=true else stena:=false; 3: if(X>20)and(y=180)then stena:=true else if x>180 then stena:=true else stena:=false; 4: if(x<500)and(y=180)then stena:=true else if(x<420)and(x<>20) then stena:=true else stena:=false; end; end; function shar(x,y,xofst1,yofst1,xofst2,yofst2,xofst3,yofst3:integer; poz:byte; var ns:byte; var ok:boolean):boolean; var x1,y1:word; begin x1:=0; y1:=0; shar:=false; ok:=false; ns:=0; case poz of 2: if(x+30=xofst1)and(y+110=yofst1)then begin x1:=xofst1;y1:=yofst1;ns:=1;end else if(x+30=xofst2)and(y+110=yofst2)then begin x1:=xofst2;y1:=yofst2;ns:=2;end else if(x+30=xofst3)and(y+110=yofst3)then begin x1:=xofst3;y1:=yofst3;ns:=3;end; 1: if(x+30=xofst1)and(y-50=yofst1)then begin x1:=xofst1;y1:=yofst1;ns:=1;end else if(x+30=xofst2)and(y-50=yofst2)then begin x1:=xofst2;y1:=yofst2;ns:=2;end else if(x+30=xofst3)and(y-50=yofst3)then begin x1:=xofst3;y1:=yofst3;ns:=3;end; 3: if(x-50=xofst1)and(y+30=yofst1)then begin x1:=xofst1;y1:=yofst1;ns:=1;end else if(x-50=xofst2)and(y+30=yofst2)then begin x1:=xofst2;y1:=yofst2;ns:=2;end else if(x-50=xofst3)and(y+30=yofst3)then begin x1:=xofst3;y1:=yofst3;ns:=3;end; 4: if(x+110=xofst1)and(y+30=yofst1)then begin x1:=xofst1;y1:=yofst1;ns:=1;end else if(x+110=xofst2)and(y+30=yofst2)then begin x1:=xofst2;y1:=yofst2;ns:=2;end else if(x+110=xofst3)and(y+30=yofst3)then begin x1:=xofst3;y1:=yofst3;ns:=3;end; end; if x1>0 then begin shar:=true; case poz of 1: if y1>50 then if ns=2 then if (x1<>xofst3)or(y1-80<>yofst3) then ok:=true else ok:=false else if(x1<>xofst2)or(y1-80<>yofst2)then ok:=true else ok:=false; 2: if y1<370 then if ns=2 then if(x1<>xofst3)or(y1+80<>yofst3) then ok:=true else ok:=false else if(x1<>xofst2)or(y1+80<>yofst2)then ok:=true else ok:=false; 3: if(x1>50)and(y1=210)then if ns=2 then if(y1<>yofst3)or(x1-80<>xofst3)then ok:=true else ok:=false else if(y1<>yofst2)or(x1-80<>xofst2)then ok:=true else ok:=false else if x1>210 then if ns=2 then if(y1<>yofst3)or(x1-80<>xofst3)then ok:=true else ok:=false else if(y1<>yofst2)or(x1-80<>xofst2)then ok:=true else ok:=false; 4: if(x1<530)and(y1=210)then if ns=2 then if(y1<>yofst3)or(x1+80<>xofst3)then ok:=true else ok:=false else if(y1<>yofst2)or(x1+80<>xofst2)then ok:=true else ok:=false else if x1<450 then if ns=2 then if(y1<>yofst3)or(x1+80<>xofst3)then ok:=true else ok:=false else if(y1<>yofst2)or(x1+80<>xofst2)then ok:=true else ok:=false; end; end; end; procedure init(i:byte); begin setcolor(white); {Karta nachalo} line(10,10,10,410); line(10,10,90,10); line(90,10,90,170); line(10,410,90,410); line(90,410,90,250); line(90,250,170,250); line(90,170,170,170); line(170,170,170,10); line(170,10,490,10); line(490,10,490,170); line(490,170,570,170); line(570,170,570,250); line(570,250,490,250); line(490,250,490,410); line(490,410,170,410); line(170,410,170,250); {Karta konec} {Tochki nachalo} setfillstyle(1,red); setcolor(red); circle(50,370,35); circle(370,370,35); circle(530,210,35); setcolor(white); rectangle(20,340,80,400); rectangle(340,340,400,400); rectangle(500,180,560,240); setfillstyle(1,white); floodfill(21,341,white); floodfill(341,341,white); floodfill(501,181,white); setcolor(black); rectangle(20,340,80,400); rectangle(340,340,400,400); rectangle(500,180,560,240); setfillstyle(1,black); floodfill(21,341,black); floodfill(341,341,black); floodfill(501,181,black); {Tochki konec} {Kamni Nachalo} xofst1:=50; yofst1:=210; xofst3:=370; yofst3:=210; xofst2:=370; yofst2:=130; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,darkgray); circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,darkgray); circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,darkgray); {Kamni konec} {Buldozer start} poz:=2; setfillstyle(1,white); x:=20; y:=20; setcolor(white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); {Buldozer finish} end; procedure niz (var x,y:integer; var poz:byte); begin setcolor(black); setfillstyle(1,black); case poz of 1: begin line(x+10,y-1,x+10,y-9); line(x+50,y-1,x+50,y-9); line(x,y-9,x+60,y-9); setcolor(white); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); poz:=2; end; 3: begin line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); setcolor(white); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); poz:=2; end; 4: begin line(x+61,y+10,x+69,y+10); line(x+61,y+50,x+69,y+50); line(x+69,y,x+69,y+60); setcolor(white); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); poz:=2; end; 2: begin rez:=false; rez1:=false; ns:=0; ok:=false; rez:=stena(x,y,poz); rez1:=shar(x,y,xofst1,yofst1,xofst2,yofst2,xofst3,yofst3,poz,ns,ok); if(rez=true)and(rez1=false) then begin rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); y:=y+80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); end else if(rez=true)and(rez1=true)and(ok=true)then case ns of 1: begin circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,black); yofst1:=yofst1+80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); y:=y+80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); end; 2: begin circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,black); yofst2:=yofst2+80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); y:=y+80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); end; 3: begin circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,black); yofst3:=yofst3+80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); y:=y+80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y+69); line(x+50,y+60,x+50,y+69); line(x,y+69,x+60,y+69); end; end; end; end; end; procedure levo (var x,y:integer; var poz:byte); begin setcolor(black); setfillstyle(1,black); case poz of 1: begin line(x+10,y-1,x+10,y-9); line(x+50,y-1,x+50,y-9); line(x,y-9,x+60,y-9); setcolor(white); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); poz:=3; end; 2: begin line(x+10,y+61,x+10,y+69); line(x+50,y+61,x+50,y+69); line(x,y+69,x+69,y+69); setcolor(white); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); poz:=3; end; 4: begin line(x+61,y+10,x+69,y+10); line(x+61,y+50,x+69,y+50); line(x+69,y,x+69,y+60); setcolor(white); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); poz:=3; end; 3: begin rez:=false; rez1:=false; ns:=0; ok:=false; rez:=stena(x,y,poz); rez1:=shar(x,y,xofst1,yofst1,xofst2,yofst2,xofst3,yofst3,poz,ns,ok); if(rez=true)and(rez1=false) then begin rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); x:=x-80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); end else if(rez=true)and(rez1=true)and(ok=true)then case ns of 1: begin circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,black); xofst1:=xofst1-80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); x:=x-80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); end; 2: begin circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,black); xofst2:=xofst2-80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); x:=x-80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); end; 3: begin circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,black); xofst3:=xofst3-80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); x:=x-80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); end; end; end; end; end; procedure verh (var x,y:integer; var poz:byte); begin setcolor(black); setfillstyle(1,black); case poz of 2: begin line(x+10,y+61,x+10,y+69); line(x+50,y+61,x+50,y+69); line(x,y+69,x+60,y+69); setcolor(white); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); poz:=1; end; 3: begin line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); setcolor(white); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); poz:=1; end; 4: begin line(x+61,y+10,x+69,y+10); line(x+61,y+50,x+69,y+50); line(x+69,y,x+69,y+60); setcolor(white); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); poz:=1; end; 1: begin rez:=false; rez1:=false; ns:=0; ok:=false; rez:=stena(x,y,poz); rez1:=shar(x,y,xofst1,yofst1,xofst2,yofst2,xofst3,yofst3,poz,ns,ok); if(rez=true)and(rez1=false) then begin rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); y:=y-80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); end else if(rez=true)and(rez1=true)and(ok=true)then case ns of 1: begin circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,black); yofst1:=yofst1-80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); y:=y-80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); end; 2: begin circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,black); yofst2:=yofst2-80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); y:=y-80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); end; 3: begin circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,black); yofst3:=yofst3-80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); y:=y-80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+10,y+60,x+10,y-9); line(x+50,y+60,x+50,y-9); line(x,y-9,x+60,y-9); end; end; end; end; end; procedure pravo (var x,y:integer;var poz:byte); begin setcolor(black); setfillstyle(1,black); case poz of 2: begin line(x+10,y+61,x+10,y+69); line(x+50,y+61,x+50,y+69); line(x,y+69,x+60,y+69); setcolor(white); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); poz:=4; end; 3: begin line(x-1,y+10,x-9,y+10); line(x-1,y+50,x-9,y+50); line(x-9,y,x-9,y+60); setcolor(white); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); poz:=4; end; 1: begin line(x+10,y-1,x+10,y-9); line(x+50,y-1,x+50,y-9); line(x,y-9,x+60,y-9); setcolor(white); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); poz:=4; end; 4: begin rez:=false; rez1:=false; ns:=0; ok:=false; rez:=stena(x,y,poz); rez1:=shar(x,y,xofst1,yofst1,xofst2,yofst2,xofst3,yofst3,poz,ns,ok); if(rez=true)and(rez1=false) then begin rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); x:=x+80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); end else if(rez=true)and(rez1=true)and(ok=true)then case ns of 1: begin circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,black); xofst1:=xofst1+80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst1,yofst1,35); floodfill(xofst1,yofst1,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); x:=x+80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); end; 2: begin circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,black); xofst2:=xofst2+80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst2,yofst2,35); floodfill(xofst2,yofst2,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); x:=x+80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); end; 3: begin circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,black); xofst3:=xofst3+80; setcolor(darkgray); setfillstyle(1,darkgray); circle(xofst3,yofst3,35); floodfill(xofst3,yofst3,darkgray); setcolor(black); setfillstyle(1,black); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,black); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); x:=x+80; setcolor(white); setfillstyle(1,white); rectangle(x,y,x+60,y+60); floodfill(x+1,y+1,white); line(x+60,y+10,x+69,y+10); line(x+60,y+50,x+69,y+50); line(x+69,y,x+69,y+60); end; end; end; end; end; procedure win(poz:integer); begin closegraph; writeln('Vy pobedili'); readln; c:=#27; end; begin poz:=2; gd:=detect; initgraph(gd,gm,''); init(poz); repeat c:=readkey; if c=#72 then verh(x,y,poz) else if c=#80 then niz(x,y,poz) else if c=#75 then levo(x,y,poz) else if c=#77 then pravo(x,y,poz) else if c=' ' then begin clrscr; setcolor(black); setfillstyle(1,black); rectangle(1,1,640,480); floodfill(2,2,black); init(poz); end; if(yofst1=370)and(xofst2=370)and(yofst2=370)and(xofst3=530)and(yofst3=210)then win(poz)else if(xofst3=370)and(yofst3=370)and(yofst1=370)and(xofst2=530)and(yofst2=210)then win(poz) until (c=#27)or(c='g'); end.
автор hoost http://www.cyberforum.ru/
Можно алгоритм к программе?
ОтветитьУдалить