📄 eg9413.pas
字号:
OutTextXY(320, 215,
'This program comes with ABSOLUTELY NO WARRANTY; see the accompanying GNU '+
'General Public License for full');
OutTextXY(320, 227,
'details. You should have received a copy along with this program (see the '+
'file COPYING). If not, write to:');
OutTextXY(320, 239,
'Free Software Foundation, Inc., 675 Massachusetts Avenue, Cambridge, '+
'Massachusetts 02139');
OutTextXY(320, 323,
'Eric Ng, 1906 Milvia Street, Berkeley, California 94704');
OutTextXY(320, 335, 'Internet: erc@irss.njit.edu');
SetColor(colornormal);
OutTextXY(160, 257, 'To obtain the full source code and/or the');
OutTextXY(160, 269, 'latest version of this program, call');
OutTextXY(160, 305, 'or see the included file GETTING.');
OutTextXY(480, 257, 'Requirements: IBM PC, PS/2, or 100%');
OutTextXY(480, 269, 'compatible (8 MHz or faster CPU is strongly');
OutTextXY(480, 281, 'recommended); an EGA with 256k RAM, VGA,');
OutTextXY(480, 293, 'Hercules graphics adapter; and 256k free');
OutTextXY(480, 305, 'system RAM.');
SetColor(colorhigh);
OutTextXY(160, 281, 'The Odyssey +1 201 984 6574');
OutTextXY(160, 293, 'The PC GFX Exchange +1 415 337 5416');
{ OutTextXY(160, 293, 'The Bandersnatch +1 201 766-3801') }
end;
SetVisualPage(page);
page := 1-page;
SetActivePage(page);
ClearDevice;
if title then
begin
Repeat Until KeyPressed;
Repeat
ch := getkey
Until Not KeyPressed
end
End; {-drawtitle-}
procedure getkeybindings;
procedure drawkeybindings;
begin
SetTextJustify(CenterText, TopText);
SetColor(colorhigh);
SetTextStyle(SansSerifFont, HorizDir, 4);
OutTextXY(320, 2, id+' '+version);
SetColor(colornormal);
SetTextStyle(DefaultFont, HorizDir, 1);
OutTextXY(320, 40, 'Key Bindings');
SetFillStyle(SolidFill, colornormal);
placewindow(237, 60, 403, 132);
SetTextStyle(SmallFont, HorizDir, 4);
outtextxy(320, 86, 'Press the key for');
end;
procedure getgetkey(n : integer);
var
ch : word;
i : integer;
begin
repeat
repeat
ch := getkey
until lo(ch) in [32..126];
i := 1;
while (keybindingtab[nkeybindings, i] <> hi(ch)) and (i < n) do
inc(i);
if i = n then
begin
keybindingtab[nkeybindings, n] := hi(ch);
if tones then
begin
Sound(cleartone);
Delay(cleartonedelay);
NoSound
end
end
until i = n
end; {-getgetkey-}
begin {-getkeybindings-}
drawkeybindings;
setvisualpage(page);
setcolor(colorhigh); outtextxy(320, 98, 'Drop');
getgetkey(keydrop);
setcolor(black); outtextxy(320, 98, 'Drop');
setcolor(colorhigh); outtextxy(320, 98, 'Move Left');
getgetkey(keyleft);
setcolor(black); outtextxy(320, 98, 'Move Left');
setcolor(colorhigh); outtextxy(320, 98, 'Move Right');
getgetkey(keyright);
setcolor(black); outtextxy(320, 98, 'Move Right');
setcolor(colorhigh); outtextxy(320, 98, 'Rotate Left');
getgetkey(keyrotateleft);
setcolor(black); outtextxy(320, 98, 'Rotate Left');
setcolor(colorhigh); outtextxy(320, 98, 'Rotate Right');
getgetkey(keyrotateright);
setcolor(black); outtextxy(320, 98, 'Rotate Right')
end; {-getkeybindings-}
Procedure initgame;
Var
i, j : integer;
Procedure getoptions;
Const
noptions = 10;
optiontitles : Array [1..noptions] Of String [22] =
('Tournament Game',
'Tournament Game Number',
'Initial Level',
'Initial Height',
'Show Next',
'Extended Shapes',
'Block Style',
'Key Bindings',
'Pit Depth',
'Show Guide');
optiony = 80;
optionyinc = 22;
Var
done : boolean;
o : byte;
bigheight : byte;
ch : word;
Procedure drawoptions;
Var
i : integer;
Begin {-drawoptions-}
SetTextJustify(CenterText, TopText);
SetColor(colorhigh);
SetTextStyle(SansSerifFont, HorizDir, 4);
OutTextXY(320, 2, id+' '+version);
SetColor(colornormal);
SetTextStyle(DefaultFont, HorizDir, 1);
OutTextXY(320, 40, 'Options');
OutTextXY(320, 330,
'Press the arrow keys to move, Enter to rotate, and the Space Bar when done.');
SetFillStyle(SolidFill, colornormal);
placewindow(150, 65, 490, 307);
SetTextJustify(LeftText, TopText);
For i := 1 To noptions Do
OutTextXY(200, optiony+(optionyinc*(i-1))+3, optiontitles[i])
End; {-drawoptions-}
Procedure showflag(f : boolean;
y : integer);
Begin
If f Then
OutTextXY(440, optiony+(optionyinc*(y-1)), 'Yes')
Else
OutTextXY(440, optiony+(optionyinc*(y-1)), 'No')
End; {-showflag-}
Procedure showoption(o : byte);
Begin
Case o Of
1: showflag(tournament, o);
2: Begin
Str(tournamentgame, buf);
OutTextXY(440, optiony+(optionyinc*(o-1)), buf)
End;
3: Begin
Str(level, buf);
OutTextXY(440, optiony+(optionyinc*(o-1)), buf)
End;
4: Begin
If height > maxheight Then
begin
str(height-maxheight, buf);
buf := 'Hidden '+buf
end
Else
Str(height, buf);
OutTextXY(440, optiony+(optionyinc*(o-1)), buf)
End;
5: showflag(shownext, o);
6: OutTextXY(440, optiony+(optionyinc*(o-1)), xshapetitles[xshape]);
7: OutTextXY(440, optiony+(optionyinc*(o-1)), styleblocktitles[styleblocks]);
8: OutTextXY(440, optiony+(optionyinc*(o-1)), keybindingtitles[binding]);
9: begin
str(depth, buf);
outtextxy(440, optiony+(optionyinc*(o-1)), buf);
end;
10: showflag(showguide, o);
End
End; {-showoptions-}
Procedure rotateopt(o : byte);
Begin
SetTextJustify(RightText, TopText);
SetTextStyle(SmallFont, HorizDir, 4);
SetColor(Black);
showoption(o);
Case o Of
1: tournament := Not tournament;
2: tournamentgame := (tournamentgame+1) Mod ngames;
3: level := (level Mod maxlevel)+1;
4: height := (height+1) Mod ((2*maxheight)+1);
5: shownext := Not shownext;
6: xshape := (xshape Mod xshapelevels)+1;
7: styleblocks := (styleblocks Mod nstyletabs)+1;
8: begin
binding := (binding mod nkeybindings)+1;
if binding = nkeybindings then
keybindingtab[nkeybindings, 1] := 0
end;
9: begin
inc(depth);
if depth > maxdepth then depth := mindepth;
end;
10: showguide := not showguide;
End;
SetColor(colorhigh);
showoption(o)
End; {-rotateopt-}
Begin {-getoptions-}
drawoptions;
level := initlevel;
SetTextJustify(RightText, TopText);
SetTextStyle(SmallFont, HorizDir, 4);
SetColor(colorhigh);
For o := 1 To noptions Do
showoption(o);
SetVisualPage(page);
done := False;
o := 1;
Repeat
SetTextJustify(LeftText, TopText);
SetTextStyle(DefaultFont, HorizDir, 1);
SetColor(colorhigh);
OutTextXY(200, optiony+(optionyinc*(o-1))+3, optiontitles[o]);
OutTextXY(190, optiony+(optionyinc*(o-1))+3, #254);
Repeat Until KeyPressed;
ch := getkey;
Case hi(ch) of
1: Begin { escape }
done := True;
endrun := True
End;
57: done := True; { space }
35, 36, 72, 75: begin { H J up left }
SetColor(colornormal);
OutTextXY(200, optiony+(optionyinc*(o-1))+3, optiontitles[o]);
SetColor(0);
OutTextXY(190, optiony+(optionyinc*(o-1))+3, #254);
If o < 2 Then
o := noptions
Else
Dec(o)
End;
23, 28, 37: rotateopt(o); { I enter K }
38, 77, 80: begin { L right down }
SetColor(colornormal);
OutTextXY(200, optiony+(optionyinc*(o-1))+3, optiontitles[o]);
SetColor(0);
OutTextXY(190, optiony+(optionyinc*(o-1))+3, #254);
If o > noptions-1 Then
o := 1
Else
Inc(o)
End
End
Until done;
page := 1-page;
SetActivePage(page);
ClearDevice;
End; {-getoptions-}
Procedure fillfield(h : byte);
Var
i, j : integer;
k : byte;
Begin {-fillfield-}
For i := depth DownTo depth-(h-1) Do
Begin
k := Random(filladd)+fillbase;
For j := 1 To k Do
field[i, Random(blockcols)+1] := True
End
End; {-fillfield-}
Begin {-initgame-}
getoptions;
FillChar(field, SizeOf(field)-blockcols, 0);
FillChar(field[depth+1, 1], blockcols, 1);
{ FillChar(fieldshadows, SizeOf(fieldshadows), 0); }
If tournament Then
RandSeed := tournamentgame;
If height <> 0 Then
Begin
If height > maxheight Then
begin
if depth-(height-maxheight) < mindepth then
height := (depth-mindepth)+maxheight;
fillfield(height-maxheight);
bonus := (height-maxheight)+bonushidden
end
Else
Begin
if depth-height < mindepth then
height := depth-mindepth;
fillfield(height);
bonus := height
End
End
Else
bonus := 0;
If Not shownext Then
Inc(bonus, bonusnext);
if not showguide then
inc(bonus, bonusguide);
If Not showshadow Then
Inc(bonus, bonusshadow);
inc(bonus, (maxdepth-depth)*2);
rowsclear := 0;
score := 0;
Case xshape Of
1: shapemap := xshapeclassic;
2: shapemap := xshapeeasy;
3: shapemap := xshapemedium;
4: shapemap := xshapehard
End;
Move(xstyletabs[styleblocks], styletab, SizeOf(styletab));
if not endrun then
if binding = nkeybindings then
begin
if keybindingtab[nkeybindings, 1] = 0 then
getkeybindings
end
else
fillchar(keybindingtab[nkeybindings], sizeof(keybinding), 0);
move(keybindingtab[binding], keybinding, sizeof(keybinding))
End; {-initgame-}
procedure drawguide(c:byte);
var i:integer;
begin
setcolor(c);
setlinestyle(userbitln,$aaaa,normwidth);
for i := 1 to blockcols-1 do
line(colmin+(pixelsperblock*i)+1, rowmin,
colmin+(pixelsperblock*i)+1, rowmin+(pixelsperblock*depth));
setlinestyle(solidln,0,normwidth)
end;
Procedure drawscreen;
Procedure drawfieldwin;
Var
rowmaxpel : integer;
colminpel : integer;
colmaxpel : integer;
i : integer;
Begin {-drawfieldwin-}
rowmaxpel := getmaxy;
colminpel := colmin-pixelsperblock;
colmaxpel := colmax+pixelsperblock;
SetColor(colornormal);
SetFillPattern(filltab[1], colornormal);
Bar(colminpel, rowmin, colmin, rowmaxpel);
Bar(colmin, rowmax, colmax, rowmaxpel);
Bar(colmax, rowmin, colmaxpel, rowmaxpel);
Line(colminpel, rowmin, colminpel, rowmaxpel);
Line(colmin, rowmin, colmin, rowmax);
Line(colmax, rowmin, colmax, rowmax);
Line(colmaxpel, rowmin, colmaxpel, rowmaxpel);
Line(colminpel, rowmin, colmin, rowmin);
Line(colmin, rowmax, colmax, rowmax);
Line(colmax, rowmin, colmaxpel, rowmin);
Line(colminpel, rowmaxpel, colmaxpel, rowmaxpel);
if depth <> maxdepth then
begin
setfillpattern(filltab[1], colornormal);
bar(colmin+2, rowmin+(pixelsperblock*depth)+1, colmax-2,
rowmin+(pixelsperblock*maxdepth)-1);
end;
if showguide then
drawguide(colornormal)
End; {-drawfieldwin-}
Procedure drawnextwin;
Begin
SetColor(colornormal);
SetFillStyle(SolidFill, colornormal);
placewindow(35, 16, 201, 126);
SetTextStyle(DefaultFont, HorizDir, 1);
settextjustify(centertext, toptext);
OutTextXY(118, 114, 'Next')
End;
Procedure drawscorewin;
Begin
SetColor(colornormal);
SetFillStyle(SolidFill, colornormal);
placewindow(439, 16, 605, 126);
SetColor(colorhigh);
SetTextStyle(SansSerifFont, HorizDir, 4);
SetTextJustify(CenterText, TopText);
OutTextXY(522, 21, id);
SetColor(colornormal);
SetTextStyle(SmallFont, HorizDir, 4);
OutTextXY(522, 60, copyright);
SetTextStyle(DefaultFont, HorizDir, 1);
SetTextJustify(LeftText, TopText);
OutTextXY(466, 75, 'Score:');
OutTextXY(466, 87, 'Value:');
OutTextXY(466, 99, 'Level:');
OutTextXY(466, 111, ' Rows:');
End; {-drawscorewin-}
Procedure drawhelpwin;
Begin
SetColor(colornormal);
SetFillStyle(SolidFill, colornormal);
placewindow(35, 224, 201, 334);
placewindow(439, 224, 605, 334);
SetColor(colorhigh);
SetTextStyle(DefaultFont, HorizDir, 1);
OutTextXY(58, 246, keynames[binding, keyleft]);
OutTextXY(58, 258, keynames[binding, keyrotateleft]);
OutTextXY(58, 270, keynames[binding, keyrotateright]);
OutTextXY(58, 282, keynames[binding, keyright]);
OutTextXY(58, 294, keynames[binding, keydrop]);
OutTextXY(58, 306, 'Esc');
OutTextXY(462, 246, '^B');
OutTextXY(462, 258, '^L');
OutTextXY(462, 270, '^N');
OutTextXY(462, 282, '^S');
OutTextXY(462, 294, '^X');
OutTextXY(462, 306, '^\');
SetColor(colornormal);
SetTextStyle(SmallFont, HorizDir, 4);
OutTextXY(90, 243, 'move left');
OutTextXY(90, 255, 'rotate left');
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -