Nhảy Audition trên Pascal

Uses crt;
const
bpm=178;
leng=180;


var
scoreplus:longint;
clock:longint absolute $0000:$046C;
time,score,start:longint;
npf,ngr,nco,nb,nm:longint;
dem,perfectx,rythm,l,j,i,lv:longint;
c:char;
deldance,press:boolean;
misses:integer;
s,s1:string;
f:set of 1..10;


{ ================================================== ============= }

procedure hd;
begin

clrscr;
i:=10;

gotoxy(17,i);
textcolor(red); writeln('WELL COME TO AUDITION, WAS WRITTEN BY PASCAN');

inc(i);
gotoxy(2,i);

textcolor(white); writeln('Ban nhan phim ',#24,' ',#25,' ',#26,' ',#27 ,' theo hien thi cua man hinh');

inc(i);
gotoxy(2,i); writeln('Nhan khoang trang de ghi diem khi con tro vao o trung tam');

inc(i);
gotoxy(2,i); write('De vao che do');

textcolor(5); write(' DEL ');
textcolor(white); writeln('(So diem tang len nhieu hon) ban nhan phim Delete');

inc(i);
gotoxy(2,i); writeln('Khi do phim do xuat hien ban phai nhay nguoc lai voi hien thi');

inc(i);
gotoxy(2,i); write('De ket thuc chuong trinh ban hay nhan phim ');

textcolor(yellow); writeln('q');
textcolor(white);

readln;
clrscr;


end;
{ ================================================== ============= }
procedure finish;
var q:byte; cont:boolean;
begin

gotoxy(15,10); writeln('FINISH MOVE');
gotoxy(34,12);
s1:=s;
f:=[];
repeat
cont:=true;
q:=random(9)+1;
if not (q in f) then
begin
f:=f+[q]; delete(s1,q,1);
cont:=false;
case ord(s[q]) of
24: insert(chr(25),s1,q);
25: insert(chr(24),s1,q);
26: insert(chr(27),s1,q);
27: insert(chr(26),s1,q);
end;
end;
until not cont;
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
end;
{ ================================================== ============= }
procedure clear;
begin
textcolor(0);
gotoxy(33,12); writeln('-----------------------------');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure perfect;
begin
misses:=0;
inc(npf);

inc(perfectx);

textcolor(lightred);
gotoxy(34,10);

if perfectx<=0 then
begin
scoreplus:=150*(lv+1)*4+ord(lv>1)*lv*lv*lv*lv;
writeln('PERFECT');
end else
begin
scoreplus:=250*(lv+1)*perfectx*4+ord(lv>1)*lv*lv*lv*lv;
writeln('PERFECT X ',perfectx);
end;
if lv =10 then score:=score+30000;
textcolor(lightgray);
clear;
end;
{ ================================================== ============= }
procedure great;
begin
misses:=0;
inc(ngr);
perfectx:=-1;

textcolor(green); gotoxy(34,10); writeln('GREAT');
scoreplus:=150*(lv+1)*3+ord(lv>1)*lv*lv*lv;

if lv=10 then score:=score+28000;
clear;
end;
{ ================================================== ============= }
procedure cool;
begin
misses:=0;
inc(nco);
perfectx:=-1;
textcolor(blue); gotoxy(34,10); writeln('COOL');

scoreplus:=150*(lv+1)*2+ord(lv>1)*lv*lv;

if lv =10 then score:=score+25000;
clear;


end;
{ ================================================== ============= }
procedure bad;
begin

misses:=0;
inc(nb);
perfectx:=-1;
textcolor(red);
gotoxy(34,10);
writeln('BAD');
scoreplus:=150*(lv+1)+ord(lv>1)*lv;
if lv =10 then score:=score+22500;
clear;


end;
{ ================================================== ============= }
procedure create;
begin
textcolor(blue); gotoxy(43,13); writeln('C');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure remove;
begin
textcolor(0); gotoxy(43,13); writeln('C');
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure again;
var q:byte;
begin
j:=1;
gotoxy(34,12); textcolor(lightgray);

if ((not deldance) or (lv<6)) and ( not (lv=10) ) then writeln(s)
else
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
textcolor(lightgray);
end;
{ ================================================== ============= }
procedure miss;
begin
if misses<>3 then inc(nm);
misses:=3;
textcolor(red); gotoxy(34,10); write('MISS');
textcolor(lightgray);
perfectx:=-1;
clear;
scoreplus:=0;


end;
{ ================================================== ============= }
procedure replace(var j:longint; x:longint);
begin

textcolor(green); gotoxy(j+33,12); write(chr(x));
textcolor(lightgray);
inc(j);
end;
{ ================================================== ============= }
procedure perform;
var p,q:byte; cont:boolean;
begin
s1:=s;
f:=[];
for p:=1 to 3 do
repeat
cont:=true;
q:=random(lv-1)+1;
if not (q in f) then
begin
f:=f+[q]; delete(s1,q,1);
cont:=false;
case ord(s[q]) of
24: insert(chr(25),s1,q);
25: insert(chr(24),s1,q);
26: insert(chr(27),s1,q);
27: insert(chr(26),s1,q);
end;
end;
until not cont;
for q:=1 to lv do
begin
if q in f then textcolor(red) else textcolor(lightgray);
write(s1[q]);
end;
end;
{ ================================================== ============= }
procedure timeout;
var o:longint;
begin
o:=(clock-start) div 18;
gotoxy(19,16);
if (leng-o) mod 60 <10 then writeln((leng-o) div 60,':0',(leng-o) mod 60:1)
else
writeln((leng-o) div 60,':',(leng-o) mod 60);
end;
{ ================================================== ============= }
procedure screen;
var p:byte;
begin
textcolor(lightblue);
gotoxy(15,11); writeln('{ }');
gotoxy(40,11); writeln('°±ÛÛÛÛÛ±°');

textcolor(white);
gotoxy( (time*41 div rythm) +15,11);writeln('Û');
textcolor(lightgray);


end;
{ ================================================== ============= }
procedure count;
var x:integer;
begin

x:=time*123 div rythm +3;
if (j>lv) and (misses=1) then
begin
case x of
90:perfect;
87..89,91..93:perfect;
81..86,94..99:cool;
78..80,100..102:bad;
else miss;
end; { end case }
if deldance and (lv>5) then scoreplus:=(scoreplus*3) div 2;
score:=score+scoreplus;
end else
if (misses<>0) and (misses<>3) then
begin
misses:=2;
miss;
end;
end;
{ ================================================== ============= }
procedure main;
begin
score:=0;
deldance:=false;
lv:=1;
time:=0;
rythm:=9000 div bpm;
randomize;
textcolor(lightgray); gotoxy(24,16); writeln('(',bpm:3,' bpm)');
dem:=0;
repeat
screen;
timeout;
textcolor(0); gotoxy(49,14); writeln('----------------------');
textcolor(lightgray); gotoxy(49,14); writeln(score);
if (time mod rythm=0) then
begin
misses:=1;
time:=0;
if lv=10 then
begin
lv:=6;
dem:=0;
end else
if (dem = (lv div 2 +trunc(sqrt(lv))) ) then
begin
dem:=0;
inc(lv);
end;
s:='';
j:=1;
textcolor(0); gotoxy(15,10); writeln('---------------------------------------');
textcolor(lightgray); gotoxy(34,12);

for i:=1 to lv do s:=s+chr(random(4)+24);

if deldance and (lv >5) and (lv<10) then perform else writeln(s);

if lv= 10 then finish;
if lv < 10 then
begin

gotoxy(15,10);
writeln('Level ',lv);
inc(dem);
end;
end;
if keypressed then c:=readkey else c:=#0;
if (ord(c )=72) and (ord(s[j])=24) then replace(j,24) else
if (ord(c )=80) and (ord(s[j])=25) then replace(j,25) else
if (ord(c )=77) and (ord(s[j])=26) then replace(j,26) else
if (ord(c )=75) and (ord(s[j])=27) then replace(j,27) else
if (ord(c )=83) then deldance:= not deldance else
if (ord(c )=32) then count else
if (c<>#0) and (j<=length(s)) then again;

if deldance then create else remove;

delay(90);
inc(time);
if (time*41 div rythm +1> 34) and ((j<=lv) or (misses=1)) and (misses<>0) then miss;
until (c='q') or (clock-start>leng*18);
end;
{ ================================================== ============= }
begin
clrscr;
npf:=0;
ngr:=0;
nco:=0;
nb:=0;
nm:=0;
hd;
start:=clock;
perfectx:=-1;
clrscr;
textcolor(lightgray);
main;
gotoxy(10,18);
writeln('Perfect Great Cool Bad Miss Score');
gotoxy(13,19);
writeln(npf:2,' ',ngr:2,' ',nco:2,' ',nb:2,' ',nm:2,' ',score:8);
readln;
end.

Nếu không nhảy được thì các bạn vào đường lick sau để down file .txt về rồi copy từ file đó ra để chạy
http://uploading.com/files/WYZW2KEE/Audition.txt.html