[소스] Tetris - Pascal > 기타

본문 바로가기
사이트 내 전체검색

기타

8비트 시절부터 접했던 자료들에 대한 개인적인 이야기. 다운로드는 기본적으로 제공하지 않고 있습니다.

[소스] Tetris - Pascal

페이지 정보

profile_image
작성자 BiHon
댓글 0건 조회 2,172회 작성일 15-05-30 23:28

본문

1432995965532781_cezpjtvxkh8y8q86m00h5v55adn1ncii5.png
Tetris
1986
(C) AcademySoft CCAS USSR Moscow, 1986 - A. Pajitnov & V. Gerasimov

26.10 KiB

테트리스 파스칼 소스입니다.

TETRIS.PAS
program Tetris;

uses dos,crt;

label loop,loop1;

const
Esc = #27;
Logo_str : array[1..16] of string[79] = ('','',
' WWWWWWWWWWW WWWWWWWWWWW WWWWWWWWWWW WWWWWWWWWW WWWWWWW WWWWWWWWW',
' WWWWWWWWWWW WWWWWWWWWWW WWWWWWWWWWW WWWWWWWWWWW WWW WWWWWWWWWWW',
' WWW WWW WWW WWW WWW WWW WWW WWW',
' WWW WWW WWW WWW WWW WWW WWW',
' WWW WWW WWW WWW WWW WWW WWW',
' WWW WWW WWW WWW WWW WWW WWW',
' WWW WWWWWWWW WWW WWWWWWWWWWW WWW WWWWWWW',
' WWW WWWWWWWW WWW WWWWWWWWWW WWW WWWWWWW',
' WWW WWW WWW WWWWWWWW WWW WWW',
' WWW WWW WWW WWWWWWW WWW WWW',
' WWW WWW WWW WWW WWWW WWW WWW WWW',
' WWW WWW WWW WWW WWWW WWW WWW WWW',
' WWW WWWWWWWWWWW WWW WWW WWWW WWW WWWWWWWWWWW',
' WWW WWWWWWWWWWW WWW WWW WWWW WWWWWWW WWWWWWWW' );

Tcolor : array[1..8] of integer =
( 1,2,3,4,5,6,7,9 );

type
Result = record
case intcod:integer of
0 : (ax,bx,cx,dx,bp,si,di,ds,es,flags:word);
1 : (al,ah,bl,bh,cl,ch,dl,dh:byte);
end;
Scr_arr = array[1..8000] of byte;
Scr_pt = ^Scr_arr;
Scoreb = record
name : String[15];
lev : integer;
sco : real;
end;
Art = array[1..4] of integer;
Art1 = array[1..8] of integer;
Arx = Record
xxx : art;
yyy : art;
end;
Str80 = string[80];

var
Ch : char;
Crt_mode : boolean;
Scr_st : Scr_pt;
Scr_save : Scr_arr;
Xsave : byte;
Ysave : byte;
Cursm_s : integer;
Rot_pt : array[1..40] of integer;
Tet_shape : array[1..20] of arx;
Pot : array[0..11,0..21] of integer;
Time_fact : integer;
Cur_tet : integer;
Cur_tc : integer;
Horz : integer;
Vert : integer;
Movok : boolean;
Lin_st : array[0..20] of integer;
Score : integer;
Alm_pt : integer;
Level : integer;
Ent_lev : integer;
Next_t : integer;
View_next : boolean;
Fl_cnt : integer;
Levup_pt : array[0..9] of integer;
Stat_tet : array[1..7] of integer;
Dp_tet_pt : array[0..7,1..2] of integer;
Resfile : file of scoreb;
Scor_arr : array[1..20] of Scoreb;
Str15 : string[15];
Run_count : integer;
Grade_mk : integer;
Gen_b : integer;
T1 : integer;
T2 : integer;

procedure Get_crtmod;

begin
Crt_mode := ( Mem[$0040:$0049] = 7 );
{ if Crt_mode = 80*25 b&w card then true else false }
end;

procedure Curs_off;
var x : Registers;
Begin
with x do
begin
ax := $100;
cx := $3030;
end;
intr ($10,x);
end;

procedure Curs_on;
var x : Registers;
begin
with x do
begin
ax := $100;
cx := $25a2;
end;
intr ($10,x);
end;

procedure Atxy ( x,y : byte);
begin
if Crt_mode then Gotoxy (x+x-1,y)
else Gotoxy (x,y);
end;

procedure Disp_str ( s : Str80; f : char);
var c : byte;
begin
if Crt_mode then
for c :=1 to length(s) do
write (s[c]:0,f:0)
else write (s:0);
end;

procedure Set_crtmod ( mode : byte);

begin
if Crt_mode then Textmode(7) { 80*25 b&w card }
else Textmode(mode);
end;

procedure Set_color( color : byte);

begin
if Crt_mode then
begin
if color > 0 then Textcolor(7)
else Textcolor(0);
end
else Textcolor(color);
end;

procedure Set_back (back : byte);

begin
if Crt_mode then
begin
if back>0 then TextBackground (7)
else TextBackground (0);
end
else TextBackground (back);
end;

procedure Save_screen;

begin
if Crt_mode then Scr_st := ptr ($b000,$0)
else Scr_st := ptr ($b800,$0);
Scr_save := Scr_st^;
Xsave := Wherex;
Ysave := Wherey;
Cursm_s := memw[$0040:$0060];
Clrscr;
Set_crtmod (3);
Curs_off;
end;

procedure Load_screen;

begin
Curs_on;
Set_crtmod(3);
Scr_st^ := Scr_save;
Gotoxy (Xsave,Ysave);
Writeln;
Set_color (0);
Set_back (4);
Write (' ');
Set_back(0);
Writeln;
Set_back (4);
Write (' Play TETRIS ! ');
Set_back (0);
Writeln;
Set_back (4);
Write (' ');
Set_color(3);
Set_back (0);
Writeln;
Halt;
end;

procedure Logo;

var i,j,k : integer;
l : boolean;

begin
j := 1;
l := false;
Repeat
Set_color (0);
Set_back (j);
Gotoxy (1,1);
k := 1;
while ((k <= 16) and not(keypressed and l)) do
begin
for i:=1 to Length(Logo_str[k]) do
begin
if Logo_Str[k][i] <> ' ' then write (' ')
else Gotoxy (i+1,k);
end; { for }
Delay ($50);
k := k + 1;
end; { while }
if j < 7 then j := j + 1
else j := 1;
Set_back (0);
Set_color(7);
Gotoxy (20,21);
Write ('(C) AcademySoft CCAS USSR Moscow, 1986');
Set_color (4);
Gotoxy (20,23);
Write ('Game by A. Pajitnov & V. Gerasimov ');
l := true;
until Keypressed;
Ch := Readkey;
if ch = Esc then
if Keypressed then ch := Readkey
else Load_screen;
end;

procedure Write_scr;

var i : integer;

begin
Rewrite (Resfile);
for i:=1 to 20 do
write (Resfile,Scor_arr[i]);
Close (Resfile);
end ;

procedure Enter_name;

var i : integer;

procedure Get_line;

var j : integer;
k : boolean;

procedure SoundDn;
begin
Sound (200);
Delay (100);
Sound (400);
Delay (100);
Nosound;
end;

begin { Get_line }
Str15 := '';
j := 0;
k := false;
repeat
ch := Readkey;
case Ch of
#$20..#$FE :
if j < 15 then
begin
write (Ch:0);
j := j + 1;
Str15 := Str15 + Ch;
end
else SoundDn;
#$08 :
if j > 0 then
begin
Write (^H' '^H);
Delete (Str15,j,1);
j := j - 1;
end
else SoundDn;
#$0D : k := True;
Esc :
if Keypressed then
begin
Ch := Readkey;
SoundDn;
end
else Load_screen;
else SoundDn;
end; { case }
until k;
end; { Get_line }


begin { Enter_name }
Set_back (0);
Gotoxy (1,24);
Set_color (4);
Write ('Enter Your Name:');
Get_line;
if Str15 <> '' then
begin
i := 20;
while (i>1) and (score > Scor_arr[i-1].sco) do
begin
if (score > Scor_arr[i].sco) then
begin
Scor_arr[i] := Scor_arr[i-1];
i := i - 1;
end;
end; { while }
Grade_mk := i;
Scor_arr[i].name := Str15;
Scor_arr[i].lev := level;
Scor_arr[i].sco := score;
Write_scr;
end;
end; { Enter_name }

procedure Scoreb_main (Rf : boolean );

var v : array[1..20] of integer;
h : array[1..20] of integer;
c : array[1..20] of integer;

procedure Set_scrt;

var j : integer;

begin { Set_scrt }
if Rf then
begin
Set_crtmod (3);
Set_back (0);
Clrscr;
Gotoxy (26,1);
Set_color (6);
Write ('TETRIS Game 20 Highest Results');
end;
for j := 1 to 10 do
v[j] := j+4;
for j:=11 to 20 do
v[j] := (17 + (j-1) mod 5 );
for j :=1 to 10 do
h[j] := 25;
for j:=11 to 15 do
h[j] := 5;
for j:=16 to 20 do
h[j] := 45;
c[1] := 7;
c[2] := 4;
c[3] := 4;
for j:=4 to 6 do
c[j] := 2;
for j:=7 to 10 do
c[j] := 3;
for j:=11 to 15 do
c[j] := 1;
for j:=16 to 20 do
c[j] := 5;
end; { Set_scrt }

procedure Clear_scrb;

var j : integer;

begin { Clear_scrb }
for j :=1 to 20 do
begin
Scor_arr[j].name := ' ';
Scor_arr[j].lev := 0;
Scor_arr[j].sco := 0;
end;
Write_scr;
end; { Clear_scrb }

procedure Read_score;
var io : boolean;
k : integer;

begin { Read_score }
assign (Resfile,'tetris.res');
{$I-}
reset (Resfile);
{$I+}
io := (IOresult <> 0);
if io then
Clear_scrb
else
begin
for k:=1 to 20 do
read (Resfile,Scor_arr[k]);
close (Resfile);
end;
end; { Read_score }

procedure Prt_scorb;

var j : integer;
k : integer;

begin { Prt_scorb }
for j :=1 to 20 do
if Scor_arr[j].sco <> 0 then
begin
if j <> Grade_mk then
Gotoxy (h[j],v[j])
else begin
Gotoxy (h[j]-2,v[j]);
Set_color (6);
Write ('* ');
end;
Set_color (c[j]);
for k:=length(Scor_arr[j].name) to 15 do
Scor_arr[j].name := Scor_arr[j].name + ' ';
write ( j :2,'.':0,Scor_arr[j].name:0,
Scor_arr[j].lev:2,Scor_arr[j].sco:10:0);
end;
end; { Prt_scorb }

begin { Scoreb_main }

Set_scrt;
if not Rf then Read_score
else Prt_scorb;
end; { Scoreb_main }

procedure Wait_key;
begin
while Keypressed do
Ch := Readkey;
end;

procedure Init_tet ; { Init_tet }
var j,k : integer;
rx : arx;

procedure Rev_ts (px : arx); { Rev_ts }

var i : integer;
begin { Rev_ts }
rx.xxx := px.yyy;
for i:=1 to 4 do
rx.yyy[i] := -px.xxx[i];
end; { Rev_ts }

begin
for j:=1 to 4 do
begin
Tet_shape[1].yyy[j] := j div 3;
Tet_shape[1].xxx[j] := -(j mod 2)
end;
for k := 1 to 4 do
begin
with Tet_shape[k+3] do
begin
for j :=1 to 3 do
begin
yyy[j] := 0;
xxx[j] := j - 2;
end; { for j }
yyy[4] := 1;
xxx[4] := k-3;
end; { with }
end; {for k }
Tet_shape[4].yyy[4] := 0;
Tet_shape[2] := Tet_shape[6];
Tet_shape[2].yyy[1] := 1;
Tet_shape[3] := Tet_shape[6];
Tet_shape[3].yyy[3] := 1;
Rot_pt[1] := 1;
for j := 2 to 4 do
begin
Rev_ts ( Tet_shape[j]);
Tet_shape[j+6] := rx;
Rot_pt [j] := j + 6;
Rot_pt [j+6] := j;
end;
for j:=1 to 3 do
begin
rx := Tet_shape[j+4];
Rot_pt [j+4] := 3*j+8;
for k:=1 to 3 do
begin
Rev_ts (rx);
Tet_shape [ 7 + 3 * j + k] := rx;
Rot_pt [ 7 + 3 * j + k] := 8 + 3 * j + k;
end;
Rot_pt [ 10 + 3 * j] := j + 4;
end;
for j := 0 to 9 do
Levup_pt [j] := 10*(j + 1);
Dp_tet_pt[1,1] := 4;
Dp_tet_pt[1,2] := 10;
Dp_tet_pt[2,1] := 3;
Dp_tet_pt[2,2] := 6;
Dp_tet_pt[3,1] := 0;
Dp_tet_pt[3,2] := 8;
Dp_tet_pt[4,1] := 3;
Dp_tet_pt[4,2] := 2;
Dp_tet_pt[5,1] := 0;
Dp_tet_pt[5,2] := 0;
Dp_tet_pt[6,1] := 0;
Dp_tet_pt[6,2] := 4;
Dp_tet_pt[7,1] := 0;
Dp_tet_pt[7,2] :=12;
end;

procedure Draw_tet (x,y:integer);

var i: integer;

begin
Set_back (Tcolor[Cur_tc]);
for i:=1 to 4 do
begin
Set_color (0);
Atxy ( 15+(x+Tet_shape[20].xxx[i]) , 1+(y+Tet_shape[20].yyy[i]));
Disp_str (' ',' ');
end;
end; { Draw_tet }

procedure Erase_tet (x,y:integer);

var i : integer;

begin
Set_back (0);
Set_color (1);
for i:=1 to 4 do
begin
Atxy (15+(x+Tet_shape[20].xxx[i]),1+(y+Tet_shape[20].yyy[i]));
if odd(x+Tet_shape[20].xxx[i]) then
Disp_str (' ',' ')
else Disp_str ('.',' ');
end;
end; { Erase_tet }

procedure Clr_nextt;
var i : integer;
begin
Set_back (0);
Set_color (7);
for i := 0 to 1 do
begin
Atxy (6-3,22+i);
Disp_str (' ',' ');
end;
end;

procedure Disp_nextt;
var i : integer;
begin
Clr_nextt;
Set_color (0);
Set_back (Tcolor[Next_t]);
with Tet_shape[Next_t] do
for i :=1 to 4 do
begin
Atxy (6+xxx[i],22 + yyy[i]);
Disp_str (' ',' ');
end;
Score := Score - 5;
end;

procedure Initialize;

var i,j : integer;

begin
for i:=1 to 10 do
for j:=1 to 20 do
Pot[i,j] := 0;
for i:=1 to 10 do
begin
Pot[i,0] := Tcolor[8];
Pot[i,21] := Tcolor[8];
end;
for j:=0 to 21 do
begin
Pot[0,j] := Tcolor[8];
Pot[11,j] := Tcolor[8];
end;
for j:= 0 to 20 do
Lin_st[j] := 0;
Score := 0;
Alm_pt := 1000;
Next_t := Random (7) + 1;
View_next := false;
Fl_cnt := 0;
Dp_tet_pt[0,1] := 0;
for i:=1 to 7 do
Stat_tet[i] := 0;
end; { Initialize }


procedure Disp_pot (ix,iy:integer);
var i,j : integer;

begin
for j := ix to iy do
begin
Atxy(15+1,1+j);
for i := 1 to 10 do
begin
if Pot[i,j] <> 0 then
begin
Set_color (0);
Set_back (Pot[i,j]);
Disp_str (' ',' ');
end else
begin
Set_back (0);
Set_color (1);
if odd(i) then
Disp_str (' ',' ')
else Disp_str ('.',' ');
end;
end; { for i}
end; { for j}
end;

procedure Make_GScr;

var i,j : integer;

begin
Set_back (0);
Set_color (9);
for i:=1 to 20 do
begin
Atxy (15,1+i);
Disp_str (#15,#15);
Atxy (15+11,1+i);
Disp_str (#15,#15);
end;
Atxy (15,1+21);
for i:= 0 to 11 do
Disp_str (#15,#15);
Disp_pot (1,20);
Atxy (6-3,22-3);
Set_back (0);
Set_color (7);
Disp_str (' ',' ');
Atxy (6-3,22-2);
Disp_str (' Next:',' ');
Atxy (6-3,22-1);
Disp_str (' ',' ');
Clr_nextt;
Atxy (6-3,22+2);
Disp_str (' ',' ');
Atxy (1,-1+9);
Disp_str (' ',' ');
Atxy (1,0+9);
Disp_str (' H E L P ',' ');
Atxy (1,1+9);
Disp_str (' ',' ');
Atxy (1,2+9);
Disp_str (' 7:Left ',' ');
Atxy (1,3+9);
Disp_str (' 9:Right ',' ');
Atxy (1,4+9);
Disp_str (' 8:Rotate ',' ');
Atxy (1,5+9);
Disp_str (' 1:Draw next ',' ');
Atxy (1, 6+9);
Disp_str (' 6:Speed up ',' ');
Atxy (1,7+9);
Disp_str (' 4:Drop ',' ');
Atxy (1,8+9);
Disp_str (' SPACE:Drop ',' ');
Atxy (1,9+9);
Disp_str (' ',' ');
Set_back (0);
Set_color (7);
Atxy (29,6-3);
Disp_str (' ',' ');
Atxy (29,6-2);
Disp_str ('STATISTICS ',' ');
Atxy (29,6-1);
Disp_str (' ',' ');
for i:=1 to 7 do
begin
Set_color (Tcolor[i]);
Atxy (29+6,6+Dp_tet_pt[i,2]);
Disp_str (' - 0 ',' ');
Set_back (Tcolor[i]);
Set_color (0);
for j :=1 to 4 do
begin
Atxy (29+Dp_tet_pt[i,1]+Tet_shape[i].xxx[j]+1,
6+Dp_tet_pt[i,2]+Tet_shape[i].yyy[j]);
Disp_str (' ',' ');
end;
Set_back (0);
end; { for }
Set_color (7);
Atxy (29,6+14);
Disp_str ('------------','-');
Atxy (29,6+15);
Disp_str (' ',' ');
Disp_str (chr($e4),' ');
Disp_str (' : 0',' ');
Atxy (15,24);
Set_back (0);
Set_color (4);
Disp_str ('Play TETRIS !',' ');
end; { Make_GScr }

function Check_can_move ( Cx,Cy : integer ) : boolean;
var i : integer;

begin
Check_can_move := true;
for i :=1 to 4 do
if Pot[
(Cx + Tet_shape[20].xxx[i]),(Cy + Tet_shape[20].yyy[i]) ] <> 0
then
begin
Check_can_move := false;
exit
end;
end;

function Check_endgame : boolean;
var i : integer;

begin
Cur_tet := Next_t;
Next_t := Random(7) + 1;
Tet_shape[20] := Tet_shape[Cur_tet];
Horz := 6;
Vert := 1;
Check_endgame := Check_can_move(Horz,Vert);
Cur_tc := Cur_tet;
Draw_tet (Horz,Vert);
if View_next then Disp_nextt;
Stat_tet[Cur_tet] := Stat_tet[Cur_tet] + 1;
Dp_tet_pt[0,1] := Dp_tet_pt[0,1] + 1;
Set_back (0);
Set_color (Tcolor[Cur_tet]);
Atxy ( 29+8,6+Dp_tet_pt[Cur_tet,2]);
if Crt_mode then Write (' ');
write ( Stat_tet[Cur_tet] :4 );
Set_color (7);
Atxy (29+8,6+15);
if Crt_mode then Write (' ');
write (Dp_tet_pt[0,1] : 4 );
end;

procedure Move_tet; { Move_tet }

begin
if Check_can_move ( Horz,Vert+1) then
begin
Erase_tet (Horz,Vert);
Vert := Vert + 1;
Draw_tet (Horz,Vert);
end
else Movok := True;
Score := Score - 1;
end; { Move_tet }

procedure Left;

begin
if Check_can_move(horz-1,Vert) then
begin
Erase_tet (Horz,Vert);
Horz := Horz - 1;
Draw_tet (Horz,Vert);
Movok := false;
end;
end; { left }

procedure Right;

begin
if Check_can_move (Horz + 1,Vert) then
begin
Erase_tet (Horz,Vert);
Horz := Horz + 1;
Draw_tet (Horz,Vert);
Movok := false;
end;
end;

procedure Rotate; { Rotate }
var x : Arx;

begin
Erase_tet (Horz,Vert);
x := Tet_shape[20];
Tet_shape[20] := Tet_shape [ Rot_pt[Cur_tet] ];
if Check_can_move(Horz,Vert) then
begin
Cur_tet := Rot_pt[Cur_tet];
Draw_tet (Horz,Vert);
Movok := false;
end else
begin
Tet_shape[20] := x;
Draw_tet (Horz,Vert);
end;
end;

procedure Drop;

var i : integer;

begin
i := Vert;
while Check_can_move (Horz,Vert+1) do
Vert := Vert + 1;
Movok := True;
Erase_tet (Horz,i);
Draw_tet (Horz,Vert);
end; { Drop }

procedure Input_level;

var CC : char;

begin { Input_level }
Set_crtmod (3);
Clrscr;
Gotoxy (26,12);
Write ('Enter your level (0-9) [5] > ');
CC := Readkey;
if CC=Esc then
if Keypressed then
CC := Readkey
else Load_screen;
if cc in ['0'..'9']
then Ent_lev := ord(cc) - (ord('0') )
else Ent_lev := 7;
write (Ent_lev:0);
Delay (50);
Set_crtmod (1);
Curs_off;
end; { Input_level }

procedure Set_pott;
var i : integer;

begin
for i:=1 to 4 do
begin
Pot[ (Horz + Tet_shape[20].xxx[i]) , (Vert + Tet_shape[20].yyy[i]) ]
:= Tcolor[Cur_tc];
Lin_st[ (Vert+Tet_shape[20].yyy[i]) ]
:= Lin_st[ (Vert+Tet_shape[20].yyy[i]) ] + 1;
end;
Score := Score + 25 + 3 * level ;
end;

procedure Sound_full_line;

begin
Sound (300);
Delay (20);
Sound (200);
Delay (20);
Sound (400);
Delay (20);
Nosound;
end; { Sound_full_line }

procedure Check_full_line;

Label exitl,exitl1;

var i : integer;
Ed_l : integer;
ST_l : integer;
j : integer;
Floc : integer;
k : integer;

begin { Check_full_line }
Floc := 0;
for i := 20 downto 1 do
if Lin_st[i] = 10 then
begin
Floc := i;
goto exitl1;
end;
exitl1:
if Floc = 0 then goto exitl;
ST_l := Floc;
Ed_l := Floc;
while (Lin_st[Ed_l]<>0) and (Ed_l > 0 ) do
begin
if Lin_st[Ed_l] <> 10 then
begin
for k := 1 to 10 do
Pot[k,Floc] := Pot[k,Ed_l];
Lin_st[Floc] := Lin_st[Ed_l];
Floc := Floc -1;
end else
begin { else }
Fl_cnt := Fl_cnt + 1;
Atxy ( 15 + 1, 1 + Ed_l );
for i:=1 to 10 do
begin
Set_back (0);
if odd(i) then
Set_color (3)
else Set_color (19);
write (' ':0);
end; { for }
Sound_full_line;
end; { else }
Ed_l := Ed_l - 1;
end; { while }
for j := Ed_l + 1 to Floc do
begin
for k :=1 to 10 do
Pot[k,j] := 0;
Lin_st[j] := 0;
end;
Disp_pot ( Ed_l,ST_l );
if (Fl_cnt > Levup_pt[Level]) and (level < 9 ) then
begin
level := Level + 1;
Time_fact := Time_fact - 5;
end;
exitl:
end; { Check_full_line }

procedure Prt_stat ( Sc_flag : boolean );

begin
Set_back (0);
Set_color (7);
Atxy (1,2);
Disp_str ('Your level:',' ');
write (level:2);
Atxy (1,3);
Disp_str ('Full lines:',' ');
write (Fl_cnt:2);
Atxy (1,5);
Disp_str (' SCORE ',' ');
Set_color (6);
if Sc_flag then
write (Score:5,' ':0);
if Score >= Alm_pt then
begin
Alm_pt := Alm_pt + 1000;
Sound (1000);
Delay (8);
Sound (500);
Delay (8);
Sound (1000);
Delay (8);
Sound (500);
Delay (8);
Nosound;
end;
end; { Prt_stat }

procedure Key_proc;
var cc : char;

begin
cc := #$01;
if keypressed then
CC := Readkey;
if cc = Esc then
if keypressed then CC := Readkey
else Load_screen;
case cc of
'4',#75,#32 : Drop; { drop }
'7',#71 : Left; { left }
'8',#72 : Rotate; { rotate }
'9',#73 : Right; { right }
'1',#79 : begin { view next }
View_next := not (View_next);
if View_next then Disp_nextt
else Clr_nextt;
end;
'6',#77 : if level < 9 then { level up }
begin
level := level + 1;
Time_fact := Time_fact - 5;
Prt_stat (false);
end;
end; { case }
end; { Key_proc }

Begin { main }
Get_crtmod;
Save_screen;
Init_tet;
Randomize;
Run_count := 1;
Logo;
Scoreb_main (false);
loop:
Input_level;
loop1:
level := Ent_lev;
Time_fact := 50 - 5 * level;
Initialize;
Clrscr;
Make_GScr;
Prt_stat (True);
while Check_endgame do
begin
Movok := false;
repeat
Delay (Time_fact * 5);
Key_proc;
Move_tet;
Delay (Time_fact * 5);
Key_proc;
until Movok;
Set_pott;
Check_full_line;
Prt_stat ( True );
end; { while }
for Gen_B := 1 to 25 do
Begin
Sound (Gen_B * 300 + 200);
Delay (4);
end;
Nosound;
Atxy (16,12);
Set_back (0);
Atxy (16,10);
Disp_str (' ',' ');
Atxy (16,14);
Disp_str (' ',' ');
Set_color (0);
Set_back (7);
Atxy (15,11);
Disp_str (' ',' ');
Atxy (15,12);
Disp_str (' GAME OVER ',' ');
Atxy (15,13);
Disp_str (' ',' ');
Set_back (0);
Wait_key;
Gen_B := 0;
while (Gen_B< 10000) and (not Keypressed) do
begin { while }
Delay (10);
Gen_B := Gen_B + 1;
end; { while }
Ch := Readkey;
case Upcase(Ch) of
Esc : if not keypressed then Load_screen;
'R' : Goto loop1;
end; { case }
Wait_key;
Clrscr;
Set_crtmod (3);
Grade_mk := 0;
if Score > Scor_arr[20].sco then
Enter_name;
Scoreb_main (True);
Run_count := Run_count + 1;
gotoxy (1,25);
Wait_key;
Write ('Once more? (Y/N) > ');
Ch := Readkey;
if (ch=Esc) and (not Keypressed) then Load_screen;
if upcase(Ch) <> 'N' then
begin
Write ('Yes');
goto loop
end;
Write ('No');
Load_screen;
End. { main }

댓글목록

등록된 댓글이 없습니다.

Total 71건 1 페이지

검색

회원 가입이 필요하지 않습니다.
* 글/댓글 허용
 자유게시판, 질문&답변, 방명록
* 댓글 허용
 모든 게시판

회원로그인

회원가입
Special thanks
The Ad Lib Legacy
혹시 기부 가능한 분?
XT/AT/386/486 등
정상 작동 본체 환영!
그래픽 카드, 사운드 카드,
한글 카드 등도 환영!
Bookmarks
[자료] BiHonSS
[교육] 천자문 for Web
[재미] 3D 객체
[재미] DreamPHP.com Intro
[취미] PHPSchool.com
[추억] 웹폰트 - 폰트피아
비혼의 조그만 세상

회사소개 개인정보처리방침 서비스이용약관 모바일버전
Copyright © DreamPHP.com All rights reserved.