eg9413.pas

一个类似俄罗斯方块的游戏

   oldxvalue	:= xvalue;
   oldxshape	:= xshape;
   oldrowsclear := 0; }

   If shownext Then
    putshape(111, 54, nextshape, styletab[nextcolor, nextstyle]);
   SetVisualPage(page);
   page := 1-page;
   SetActivePage(page);
   If shownext Then
    putshape(111, 54, nextshape, styletab[nextcolor, nextstyle]);

   Repeat
    Inc(score, xvalue);
    shape   := nextshape;
    orient  := 0;
    row     := initrow;
    col     := initcol;
    color   := nextcolor;
    style   := nextstyle;
    dropped := False;
    xsize   := shapetab[shape, info, 1];
    xvalue  := level*shapetab[shape, info, 2]+bonus;
    nextshape := Random(shapemap)+1;
    nextcolor := Random(ncolors)+1;
    nextstyle := Random(nstyles)+1;

    drawshape;
    dispscore;
    If shownext Then
     Begin
      putshape(111, 54, shape, styletab[color, style]);
      putshape(111, 54, nextshape, styletab[nextcolor, nextstyle])
     End;
    SetVisualPage(page);
    page := 1-page;
    SetActivePage(page);
    dispscore;
    If shownext Then
     Begin
      putshape(111, 54, shape, styletab[color, style]);
      putshape(111, 54, nextshape, styletab[nextcolor, nextstyle])
     End;
    oldscore	 := score;
    oldxvalue	 := xvalue;
    oldlevel	 := level;
    oldxshape	 := xshape;
    oldrowsclear := rowsclear;

    t := gettimer+tdelay;
    Repeat Until (gettimer > t);
    While KeyPressed Do
     ch := getkey;

    If chk Then
     endgame := True
    Else
     Begin
      Repeat
       Inc(row);
       drawshape;
       SetVisualPage(page);
       page := 1-page;
       SetActivePage(page);
       Dec(row);
       drawshape;
       Inc(row);

       t := gettimer+tdelay;
       Repeat
	Repeat Until KeyPressed Or (gettimer > t);
	If KeyPressed Then
	 Begin
	  ch := getkey;
	  if lo(ch) < 29 then
	   case hi(ch) of
 { Esc }	 1: begin
	   { 1, 68: Begin
		     if hi(ch) = 68 then
		      fake; }
		     Repeat Until KeyPressed;
		     ch := getkey;
		     If chr(lo(ch)) = #27 Then
		      Begin
		       dropshape;
		       endgame := True
		      End
		    End;
 { ^W }       { 17: Begin
		     showshadow := Not showshadow;
		     drawshape;
		     SetVisualPage(page);
		     page := 1-page;
		     SetActivePage(page);
		     showshadow := Not showshadow;
		     drawshape;
		     showshadow := Not showshadow;
		     If showshadow Then
		      Dec(bonus, bonusshadow)
		     Else
		      Inc(bonus, bonusshadow);
		     While KeyPressed Do
		      ch := getkey
		    End; }
 { ^S } 	31: tones := not tones;
 { ^L }     38, 47: Begin
		     level := (level Mod maxlevel)+1;
		     tdelay := timedelaytab[level];
		     drawshape;
		     dispscore;
		     SetVisualPage(page);
		     page := 1-page;
		     SetActivePage(page);
		     drawshape;
		     dispscore;
		     oldlevel := level;
		     While KeyPressed Do
		      ch := getKey
		    End;
 { ^\ } 	43: begin
		     cleanup;
		     halt
		    end;
 { ^X } 	45: Begin
		     xshape := (xshape Mod xshapelevels)+1;
		     Case xshape Of
		      1: shapemap := xshapeclassic;
		      2: shapemap := xshapeeasy;
		      3: shapemap := xshapemedium;
		      4: shapemap := xshapehard
		     End;
		     drawshape;
		     dispscore;
		     SetVisualPage(page);
		     page := 1-page;
		     SetActivePage(page);
		     drawshape;
		     dispscore;
		     oldxshape := xshape;
		     While KeyPressed Do
		      ch := getkey
		    End;
 { ^B } 	48: Begin
		     i := styleblocks;
		     If shownext Then
		      putshape(111, 54, nextshape,
			       styletab[nextcolor, nextstyle]);
		     styleblocks := (styleblocks Mod nstyletabs)+1;
		     Move(xstyletabs[styleblocks], styletab,
			  SizeOf(styletab));
		     drawshape;
		     If shownext Then
		      putshape(111, 54, nextshape,
			       styletab[nextcolor, nextstyle]);
		     SetVisualPage(page);
		     page := 1-page;
		     SetActivePage(page);
		     Move(xstyletabs[i], styletab,
			  SizeOf(styletab));
		     drawshape;
		     If shownext Then
		      putshape(111, 54, nextshape,
			       styletab[nextcolor, nextstyle]);
		     Move(xstyletabs[styleblocks], styletab,
			  SizeOf(styletab));
		     If shownext Then
		      putshape(111, 54, nextshape,
			       styletab[nextcolor, nextstyle]);
		     While KeyPressed Do
		      ch := getkey
		    End;
 { ^G }       { 34: begin
		     showguide := not showguide;
		     if showguide then
		      begin
		       dec(bonus, bonusguide);
		       drawshape;
		       drawguide(colornormal);
		       SetVisualPage(page);
		       page := 1-page;
		       SetActivePage(page);
		       drawshape;
		       drawguide(colornormal);
		      end
		     else begin
		      inc(bonus, bonusguide);
		      drawshape;
		      drawguide(0);
		      SetVisualPage(page);
		      page := 1-page;
		      SetActivePage(page);
		      drawshape;
		      drawguide(0);
		     end;
		    end; }
 { ^N } 	49: Begin
		     shownext := Not shownext;
		     If shownext Then
		      Dec(bonus, bonusnext)
		     Else
		      Inc(bonus, bonusnext);
		     putshape(111, 54, nextshape,
			      styletab[nextcolor, nextstyle]);
		     drawshape;
		     SetVisualPage(page);
		     page := 1-page;
		     SetActivePage(page);
		     putshape(111, 54, nextshape,
			      styletab[nextcolor, nextstyle]);
		     drawshape;
		     While KeyPressed Do
		      ch := getkey
		    End
	   end
	  else
	   begin
	    k := 1;
	    while (hi(ch) <> keybinding[k]) and (k <= nkeys) do
	     inc(k);
	    if k <= nkeys then
	     case k of
		     keydrop: dropshape;
		     keyleft: chkmv(left);
		    keyright: chkmv(right);
	      keyrotateright: chkrot((orient+1) Mod (norients+1));
	       keyrotateleft: chkrot((norients+orient) Mod (norients+1))
	     end
	    end;
	 end;
       Until dropped Or (gettimer > t);
      Until dropped Or chk;

      drawshape;

      field[row, col] := True;
      For i := 1 To xsize Do
       field[row+yshapetab[shape, orient, i, 1],
	     col+yshapetab[shape, orient, i, 2]] := True;

      chkrows;

      t := gettimer+(tdelay Shr 1);
      Repeat Until (gettimer > t);
      While KeyPressed Do
       ch := getkey
     End;
   Until endgame;

   dispscore;
   SetVisualPage(page);
   page := 1-page;
   SetActivePage(page);
   dispscore;
   oldscore	:= score;
   oldxvalue	:= xvalue;
   oldlevel	:= level;
   oldxshape	:= xshape;
   oldrowsclear := rowsclear;

   While KeyPressed Do
    ch := getkey;
   gameover;

   Repeat Until KeyPressed;
   While KeyPressed Do
    ch := getkey
  End;

 Procedure postgame;

  Var
   ch		  : word;
   today	  : DateTime;
   i, j 	  : word;
   rank, x, s	  : integer;

  Begin
   rank := 0;

   If rowsclear > 0 Then
    Begin
     i	  := 1;
     While (i <= nhiscores) And (hiscore[i].score >= score) Do
      Inc(i);
     If i <= nhiscores Then
      Begin
       rank := i;
       For j := nhiscores-1 DownTo i Do
	hiscore[j+1] := hiscore[j];
       hiscore[i].score     := score;
       hiscore[i].level     := level;
       hiscore[i].rowsclear := rowsclear;

       GetTime(today.hour, today.min, today.sec, j);
       GetDate(today.year, today.month, today.day, j);
       Dec(today.year, 1900);
       Str(today.month:2, hiscore[i].date);
       Str(today.day:2, buf);
       hiscore[i].date := hiscore[i].date+'/'+buf;
       Str(today.year:2, buf);
       hiscore[i].date := hiscore[i].date+'/'+buf;
       fillzero(hiscore[i].date);
       Str(today.hour:2, hiscore[i].time);
       Str(today.min:2, buf);
       hiscore[i].time := hiscore[i].time+':'+buf;
       Str(today.sec:2, buf);
       hiscore[i].time := hiscore[i].time+':'+buf;
       fillzero(hiscore[i].time);
       hiscore[i].version := version;

       ClearDevice;

       SetTextJustify(CenterText, TopText);
       SetTextStyle(SansSerifFont, HorizDir, 4);
       SetColor(colorhigh);
       OutTextXY(320, 5, 'Congratulations!');

       SetTextStyle(DefaultFont, HorizDir, 1);
       SetColor(colornormal);
       OutTextXY(320, 46, 'You''ve made it into the Glorious Fifteen;');
       OutTextXY(320, 58, 'please enter your name for posterity:');

       SetColor(colornormal);
       placewindow(214, 155, 426, 195);

       SetVisualPage(page);
       page := 1-page;

       SetTextStyle(SmallFont, HorizDir, 4);
       x := 1;
       Repeat
	SetColor(colorhigh);
	OutTextXY(224+6*(x-1), 171, '_');
	Repeat Until KeyPressed;
	ch := getkey;
	Case lo(ch) Of
	   0: While KeyPressed Do
	       ch := getkey;
	   8: If x > 1 Then
	       Begin
		SetColor(Black);
		OutTextXY(224+6*(x-1), 171, '_');
		Dec(x);
		OutTextXY(224+6*(x-1), 171, hiscore[i].name[x])
	       End;
	  13: hiscore[i].name[0] := Chr(x-1);
	  27: If x > 1 Then
	       Begin
		SetColor(Black);
		OutTextXY(224+6*(x-1), 171, '_');
		For s := x DownTo 1 Do
		 OutTextXY(224+6*(s-1), 171, hiscore[i].name[s]);
		x := 1
	       End;
	 Else If x < SizeOf(bufstr) Then
	       Begin
		SetColor(Black);
		OutTextXY(224+6*(x-1), 171, '_');
		SetColor(colorhigh);
		OutTextXY(224+6*(x-1), 171, chr(lo(ch)));
		hiscore[i].name[x] := chr(lo(ch));
		Inc(x)
	       End
	End
       Until (lo(ch) = 13) or (x > SizeOf(bufstr))
      End
    End;

   SetActivePage(page);
   ClearDevice;

   SetTextStyle(SansSerifFont, HorizDir, 4);
   SetTextJustify(CenterText, TopText);
   SetColor(colorhigh);
   OutTextXY(320, 5, 'The Glorious Fifteen');

   SetColor(colornormal);
   SetFillStyle(SolidFill, colornormal);
   placewindow(16, 50, 615, 256);

   SetTextStyle(DefaultFont, HorizDir, 1);
   SetTextJustify(LeftText, TopText);
   SetColor(colorhigh);
   OutTextXY(24, 60, 'Rank  Score  Level Rows   Date     Time   Name');

   SetColor(colornormal);
   SetTextStyle(SmallFont, HorizDir, 4);
   For i := 1 To nhiscores Do
    Begin
     If rank = i Then
      SetColor(colorhigh);
     SetTextJustify(CenterText, TopText);
     Str(i:2, buf);
     OutTextXY(40, 72+12*(i-1), buf);
     If hiscore[i].score <> 0 Then
      Begin
       Str(hiscore[i].score:7, buf);
       OutTextXY(92, 72+12*(i-1), buf);
       Str(hiscore[i].level:2, buf);
       OutTextXY(148, 72+12*(i-1), buf);
       Str(hiscore[i].rowsclear:4, buf);
       OutTextXY(192, 72+12*(i-1), buf);
       OutTextXY(248, 72+12*(i-1), hiscore[i].date);
       OutTextXY(320, 72+12*(i-1), hiscore[i].time);
       SetTextJustify(LeftText, TopText);
       OutTextXY(360, 72+12*(i-1), hiscore[i].name);
       OutTextXY(563, 72+12*(i-1), hiscore[i].version)
      End;
     If rank = i Then
      SetColor(colornormal)
    End;

   SetTextStyle(DefaultFont, HorizDir, 1);
   SetTextJustify(CenterText, TopText);
   SetColor(colornormal);
   OutTextXY(320, 300, 'Press Y to try again or N to exit.');

   SetVisualPage(page);
   page := 1-page;
   SetActivePage(page);
   ClearDevice;

   Repeat
    Repeat Until KeyPressed;
    ch := getkey;
   Until (hi(ch) In [21, 49]);

   endrun := hi(ch) = 49
  End;

{ 12345678901234567890123456789012345678901234567890123456789012345678901234
  rank	score  level rows   date     time   name'
   00  0000000	 00  0000 00/00/00 00:00:00 12345678901234567890123456789012
}

 Procedure cleanup;

  Var
   i		  : integer;

  Procedure configflag(f : boolean);
   Begin
    If f Then
     WriteLn(fconfig, 'Yes')
    Else
     WriteLn(fconfig, 'No')
   End; {-configflag-}

  Begin {-cleanup-}
   dotext;

   Assign(fhiscore, hiscorename);
   filemode := 2;
   Rewrite(fhiscore);
   if ioresult = 0 then
    begin
     i := 1;
     While (i <= nhiscores) And (hiscore[i].score > 0) Do
      Begin
       Write(fhiscore, hiscore[i]);
       Inc(i)
      End;
     Close(fhiscore)
    end;

   Assign(fconfig, configname);
   filemode := 2;
   Rewrite(fconfig);
   if ioresult = 0 then
    begin
     WriteLn(fconfig, '# ', id, '':1, version, ' configuration file');
   { WriteLn(fconfig, '# ', copyright); }
     Write(fconfig, 'display=');
     Case display Of
      bw    : writeln(fconfig, 'BW');
      color : WriteLn(fconfig, 'Color');
      mono  : WriteLn(fconfig, 'Mono');