| |||
| HOME ПРИМЕРЫ THANKS НОВИЧКАМ ДОКИ LINKS JavaScript Mail | |||
 | |||
| |||
| |
|
uses crt,dos; const NMaxX=40; NMaxY=25; Level:array[1..3,1..3] of byte = ((8,8,10),(16,16,40),(30,16,99)); BorderColor=16*9+11; ScrCh=' '; ScrColor=16*8; { color of screen } MenCh='L'; MenColor=16*14+1; MinCh='M'; MinColor=16*15+1; NoMinCh='P'; NoMinColor=16*12+2; ErrorMinCh='X'; ErrorMinColor=16*12+15; DigColors:array[0..8] of byte =(16*9+11,16*9+1,16*9+10,16*9+4,16*9+12,16*9+15,12*16+14,127,143); DigCh: array[0..8] of char =(' ','1','2','3','4','5','6','7','8'); MoveIJ:array[1..8,1..2] of shortint= ((0,-1),(1,-1),(1,0),(1,1),(0,1),(-1,1),(-1,0),(-1,-1)); Ramk:string=#218#191#192#217#179#196; {'-¬L-¦-'} SU=#24; SD=#25; SL=#26; SR=#27; ENT=#17#217; hlp_string=SU+','+SD+','+SL+','+SR+'-move player, '+ENT+'-open cell, SPACE-mark/unmark, C-check cell around'; hlp_string2=' N - new game; ESC - exit'; type PoleTp=array[1..NMaxX,1..NMaxY] of byte; ScrPtr=array[1..25,1..80] of record ch,at:char; end; var scr:^ScrPtr; Pole:PoleTp; nx,ny,nm,im,jm,mleft:byte; i,j,k,i1,j1,Lev:byte; ch:char; p:^byte; MinX,MinY:byte; GameOver:boolean; hs, ms, ss, SpentTime,SpentTimeC: Word; h, m, s, hund, CellLeft: Word; Function InPole(i,j:integer):boolean; begin InPole:=(i>0) and (i<=nx) and (j>0) and (j<=ny); end; Procedure FillPole; var i,j,k,d,im,jm:integer; begin for i:=1 to nx do for j:=1 to ny do Pole[i,j]:=0; randomize; i:=1+random(nx); j:=1+random(ny); { Заполнение поля и подсчет количества мин, находящихся рядом с каждой клеткой } for k:=1 to nm do begin while Pole[i,j]=9 do begin i:=1+random(nx); j:=1+random(ny) end; Pole[i,j]:=9; { Установлена мина } { Подсчет количества мин, находящихся рядом с каждой клеткой } for d:=1 to 8 do begin im:=i+MoveIJ[d,1]; jm:=j+MoveIJ[d,2]; if InPole(im,jm) then if Pole[im,jm]<9 then inc(Pole[im,jm]); end; i:=1+random(nx); j:=1+random(ny) end; mleft:=nm; { Цифра от 0 до 8 соответствует числу мин, расположенных рядом с клеткой. 9 - означает мину. Пока клетка не видима, она имеет значение на 10 больше. Когда игрок помечает клетку как клетку с миной - значение увеличивается еще на 10 } for i:=1 to nx do for j:=1 to ny do if Pole[i,j]<10 then inc(Pole[i,j],10); end; Procedure OutCell(i,j:integer;first:boolean); var col,ch:char; begin case Pole[i,j] of 0..8: begin col:=chr(DigColors[Pole[i,j]]); ch:=DigCh[Pole[i,j]]; end; 9: begin col:=chr(MinColor); ch:=MinCh; end; 10..19: if First then begin col:=chr(ScrColor); ch:=ScrCh; end else if (Pole[i,j]=19) then begin col:=chr(NoMinColor); ch:=NoMinCh; end else begin col:=chr(ErrorMinColor); ch:=ErrorMinCh; end; 20..29: begin col:=chr(NoMinColor); ch:=NoMinCh; end; end; scr^[MinY+j,MinX+2*i-1].at:=col; scr^[MinY+j,MinX+2*i].at:=col; scr^[MinY+j,MinX+2*i].ch:=ch; end; Procedure ShowMen(i,j:integer); begin scr^[MinY+j,MinX+2*i-1].at:=chr(MenColor); scr^[MinY+j,MinX+2*i].at:=chr(MenColor); end; Procedure HideMen(i,j:integer); begin OutCell(i,j,true); end; Procedure OutCh(x,y,atr:byte;ch:char); begin scr^[y,x].at:=chr(atr); scr^[y,x].ch:=ch; end; Procedure WriteString(s:string); begin i:=1; while (i<80) and (i<Length(s)) do for i:=1 to 80 do if (i<=Length(s)) then OutCh(i,25,16*7+1,s[i]) else OutCh(i,25,16*7+1,' ') end; Procedure OutPole(first:boolean); var i,j:byte; begin window(MinX+1,MinY+1,MinX+2*nx,MinY+ny); ClrScr; window(1,1,80,25); if (first) then begin OutCh(MinX,MinY,BorderColor,Ramk[1]); OutCh(MinX,MinY+ny+1,BorderColor,Ramk[3]); OutCh(MinX+2*nx+1,MinY+ny+1,BorderColor,Ramk[4]); OutCh(MinX+2*nx+1,MinY,BorderColor,Ramk[2]); for i:=1 to nx do begin OutCh(MinX+i*2-1,MinY,BorderColor,Ramk[6]); OutCh(MinX+i*2,MinY,BorderColor,Ramk[6]); OutCh(MinX+i*2-1,MinY+ny+1,BorderColor,Ramk[6]); OutCh(MinX+i*2,MinY+ny+1,BorderColor,Ramk[6]); end; end; for j:=1 to ny do begin if (first) then begin OutCh(MinX,MinY+j,BorderColor,'¦'); OutCh(MinX+2*nx+1,MinY+j,BorderColor,'¦'); end; for i:=1 to nx do OutCell(i,j,first); end; end; Procedure ClearPole(i,j:byte); var d,im,jm:byte; begin for d:=1 to 8 do begin im:=i+MoveIJ[d,1]; jm:=j+MoveIJ[d,2]; if InPole(im,jm) then begin if Pole[im,jm]=10 then begin inc(Pole[im,jm],10); ClearPole(im,jm); dec(Pole[im,jm],20); Dec(CellLeft); end; if Pole[im,jm] in [10..19] then begin dec(Pole[im,jm],10); Dec(CellLeft); end; OutCell(im,jm,true); end; end; end; Procedure WriteMinLeft; begin GotoXY(MinX+1,MinY); if (Lev>1) then begin GotoXY(MinX+1,MinY); Write(' Min'); end; TextAttr:=BorderColor; Write(' Left:',mleft:3,' '); end; Procedure TryCell(im,jm:byte;ShowMenAfter:boolean); begin if Pole[im,jm]<=19 then begin HideMen(im,jm); if Pole[im,jm]=19 then { mina } begin GotoXY(MinX+nx,MinY+ny+1);TextAttr:=BorderColor;Write(' BAM! '); for i:=1 to nx do for j:=1 to ny do if Pole[i,j]>=10 then Dec(Pole[i,j],10); GameOver:=true; WriteString(hlp_string2); OutPole(false); scr^[MinY+jm,MinX+2*im-1].at:=chr(ErrorMinColor); scr^[MinY+jm,MinX+2*im].at:=chr(ErrorMinColor); end else begin if Pole[im,jm]>=10 then begin Dec(Pole[im,jm],10); Dec(CellLeft); end; if Pole[im,jm]=0 then ClearPole(im,jm); OutCell(im,jm,true); if ShowMenAfter then ShowMen(im,jm); end; end; { 13 } end; begin { main } p:=Ptr($40, $49); { Адрес байта, хранящего текущую моду (режим экрана) } if p^=7 then Scr:=Ptr($b000,0) else Scr:=Ptr($b800,0); repeat TextAttr:=7; clrscr; window(30,9,50,15); TextAttr:=31; clrscr; window(1,1,80,25); GotoXY(35,10); writeln('Your level:'); GotoXY(32,11); writeln('1: Beginner;'); GotoXY(32,12); writeln('2: Intermediate;'); GotoXY(32,13); writeln('3: Expert;'); GotoXY(32,14); readln(Lev); until Lev in [1..3]; clrscr; nx:=level[Lev,1]; ny:=Level[Lev,2]; nm:=Level[Lev,3]; ch:=' '; im:=nx div 2; jm:=ny div 2; MinX:=NMaxX-nx; MinY:=(NMaxY-ny) div 2; FillPole; OutPole(true); ShowMen(im,jm); WriteString(hlp_string); WriteMinLeft; GameOver:=false; GetTime(hs,ms,ss,hund); SpentTime:=0; CellLeft:=nx*ny; WriteMinLeft; repeat if KeyPressed then begin ch:=ReadKey; case ch of #0:if (not GameOver) then begin ch:=ReadKey; HideMen(im,jm); if not GameOver then case ch of 'I': jm:=1; {PgUp} 'Q': jm:=ny; {PgDwn} 'G': begin jm:=1; im:=1; end; {Home} 'O': begin jm:=ny; im:=nx; end; {End} #72: if jm>1 then dec(jm); #75: if im>1 then dec(im); #77: if im<nx then inc(im); #80: if jm<ny then inc(jm); end; { case } ShowMen(im,jm); end; { 0 } 'n','N': begin { Start new Game } FillPole; GameOver:=false; GetTime(hs,ms,ss,hund); SpentTime:=0; CellLeft:=nx*ny; OutPole(true); im:=nx div 2; jm:=ny div 2; ShowMen(im,jm); WriteString(hlp_string); WriteMinLeft; end; #13:TryCell(im,jm,true); 'c',#10:if (Pole[im,jm] in [1..8]) then {#10 - Ctrl-Enter } begin HideMen(im,jm); k:=0; { подсчет количества открытых мин } i1:=im; j1:=jm; for i:=1 to 8 do if (InPole(i1+MoveIJ[i,1],j1+MoveIJ[i,2])) then if (Pole[i1+MoveIJ[i,1],j1+MoveIJ[i,2]] in [20..29]) then inc(k); if (Pole[im,jm]=k) then for i:=1 to 8 do if not GameOver then if (InPole(i1+MoveIJ[i,1],j1+MoveIJ[i,2])) then TryCell(im+MoveIJ[i,1],jm+MoveIJ[i,2],false); ShowMen(im,jm); end; ' ': if Pole[im,jm]>19 then begin Dec(Pole[im,jm],10);Inc(mleft);Inc(CellLeft); WriteMinLeft; OutCell(im,jm,true); ShowMen(im,jm); end else if Pole[im,jm]>=10 then begin Inc(Pole[im,jm],10); Dec(MLeft);Dec(CellLeft); WriteMinLeft; OutCell(im,jm,true); ShowMen(im,jm); end; end; { case } end; if (not GameOver) then begin { calculating spent time } GetTime(h,m,s,hund); SpentTimeC:=(h-hs)*3600+(m-ms)*60+s-ss; if SpentTimeC-SpentTime>=1 then begin GotoXY(MinX+nx*2-5,MinY); TextAttr:=BorderColor; if (Lev>1) then begin GotoXY(MinX+nx*2-12,MinY); Write(' Time:'); end; Write(SpentTimeC:4,' '); SpentTime:=SpentTimeC; end; end; if (CellLeft=0) and (not GameOver) then begin GotoXY(MinX+nx-9,MinY+ny+1);TextAttr:=BorderColor;Write(' CONGRATULATIONS! '); GameOver:=true; HideMen(im,jm); WriteString(hlp_string2); end; until ch=#27; end.
|
|
HOME |