Ask Question

Name:
Title:
Your Question:

Answer Question

Name:
Your Answer:
User Submitted Source Code!


Description:
  test
Language: C/C++
Code:
uses crt;

const d1=10;
      d2=200;
      t=400;
      credits:array[1..6] of string=('Turnurile',' din','Hanoi',
                                      'de','Radu Mic','Marian');
      tpos:array[1..3] of byte=(19,39,59);

var n,i,j : integer;
    cp,lcp,sp : real;
    seyes,smouth : string;
    towers : array[1..3] of byte;
    nt : byte;
    md : integer;

procedure put(x,y,c : byte);
begin
     gotoxy(x,y);
     textcolor(c);
     write('Û');
end;

procedure put2(x,y,c : byte);
begin
     gotoxy(x,y);
     textcolor(c);
     write('²');
end;

procedure putl(y,p,s : byte);
var i : byte;
begin
     textbackground(p);
     for i:=1 to 80 do
         begin
              case random(4) of
                   0:put(i,y,p);
                   1:put(i,y,s);
                   2:put2(i,y,s);
                   3:put2(i,y,s);
              end;
         end;
end;

procedure wput(x,y : byte;s : string);
begin
     if y<18
        then
            begin
                 gotoxy(x,y);
                 write(s);
            end;
end;

procedure sun(x,y : word);
begin
     textbackground(1);
     textcolor(14);
     wput(x,y,'                   ');
     inc(y);
     wput(x,y,'     ³     Ú       ');
     inc(y);
     wput(x,y,'  ³  À¿  ÚÄÙ   ÚÄ  ');
     inc(y);
     wput(x,y,'  ÀÄ¿ÚÁÄÄÁÄ¿ ÚÄÙ   ');
     inc(y);
     wput(x,y,'    À´ '+seyes+' ÃÄÙ     ');
     inc(y);
     wput(x,y,' ÚÄÄÄ´'+smouth+'ÿ      ');
     inc(y);
     wput(x,y,' Ù ÚÄÁÄÂÄÂÄÙÀ¿     ');
     inc(y);
     wput(x,y,'  ÚÙ  ÚÙ À¿  ÀÄ    ');
     inc(y);
     wput(x,y,'      Ù   ³        ');
end;

procedure sunmove;
begin
     sun(trunc(sp),1+trunc(sp) div 8);
     sp:=sp+60/t;
end;

procedure show_credits;
begin
     gotoxy(trunc(sp)-6,trunc(cp));
     if lcp<>trunc(cp)
        then write(credits[trunc(cp)]);
     lcp:=trunc(cp);
     cp:=cp+7/t;
end;

procedure water;
begin
     for i:=1 to t do
         begin
              gotoxy(1,18);
              insline;
              putl(18,7,3);
              for j:=trunc(sp)+3 to trunc(sp)+17 do
                  if random(4)=0
                     then put(j,18,14);
              delay(d1);
              sunmove;
              show_credits;
         end;
end;

procedure sunset;
begin
     seyes:='- -';
     smouth:=' ÄÄÄ ';
     for i:=10 to 18 do
         begin
              sun(60,i);
              putl(i-1,1,1);
              gotoxy(1,18);
              insline;
              putl(18,7,3);
              for j:=trunc(sp)+3 to trunc(sp)+17 do
                  if random(4)=0
                     then put(j,18,14);
              delay(d2);
         end;
     for i:=1 to 17 do
         putl(i,0,0);
end;

procedure stop;
begin
     textbackground(0);
     textcolor(7);
     clrscr;
     asm
        mov ah,1
        mov ch,15
        mov cl,16
        int 10h
     end;
     halt;
end;

procedure getcomm;
begin
     gotoxy(1,1);
     textbackground(0);
     textcolor(14);
     write('              ');
     gotoxy(1,1);
     write('Viteza: ',100-md);
     if keypressed
        then
            case readkey of
                 #27:stop;
                 '+':
                     begin
                          dec(md,10);
                          if md<0
                             then md:=0;
                     end;
                 '-':
                     if md<100
                        then inc(md,10);
            end;
end;

procedure tower(x,y,w,d,c : word);
var i,j:byte;
begin
     getcomm;
     if c=1
        then
            begin
                 textbackground(6);
                 textcolor(14);
            end
        else
            begin
                 textbackground(0);
                 textcolor(0);
            end;
     for i:=0 to d-1 do
         begin
              gotoxy(x+i,y-i);
              for j:=1 to w-2*i do
                  write('ß');
         end;
end;

procedure towers_appear;
var i,j : byte;
begin
     for i:=1 to nt do
         begin
              tower(tpos[1]-i,17,2*i,i,1);
              gotoxy(1,18);
              insline;
              if i>2
                 then putl(18,2,6)
                 else
                     begin
                          putl(18,1,7);
                          tower(tpos[1]-i,18,2*i,i,1);
                     end;
              delay(d2);
         end;
     for i:=nt to 8 do
         begin
              gotoxy(1,18);
              insline;
              putl(18,2,6);
              delay(d2);
         end;
     for i:=1 to 2 do
         begin
              gotoxy(1,18);
              insline;
              putl(18,2,6);
              delay(d2);
         end;
end;

procedure readnt;
var ch : char;
    c : integer;
begin
     repeat
           gotoxy(30,10);
           write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
           gotoxy(30,11);
           write('³ Numar discuri (1..9):     ³');
           gotoxy(30,12);
           write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄ');
           gotoxy(55,11);
           ch:=readkey;
           write(ch);
           readkey;
           val(ch,nt,c);
     until (nt>=1) and (nt<=10) and (c=0);
end;

procedure intro;
begin
     randomize;
     seyes:='O O';
     smouth:='ÀÄÄÄÙ';
     cp:=0;
     lcp:=0;
     sp:=1;
     water;
     readnt;
     sunset;
     towers_appear;
end;

procedure moveup(d,t : byte);
var p : byte;
begin
     for i:=18-towers[t] downto 17-nt do
         begin
              tower(tpos[t]-d,i,2*d,1,1);
              delay(md);
              if i<>17-nt
                 then tower(tpos[t]-d,i,2*d,1,0);
         end;
     dec(towers[t]);
end;

procedure moveright(d,a,b : byte);
begin
     for i:=tpos[a]-d to tpos[b]-d do
         begin
              tower(i,17-nt,2*d,1,1);
              delay(md);
              if i<>tpos[b]+towers[b]
                 then tower(i,17-nt,2*d,1,0);
         end;
end;

procedure moveleft(d,a,b : byte);
begin
     for i:=tpos[a]-d downto tpos[b]-d do
         begin
              tower(i,17-nt,2*d,1,1);
              delay(md);
              if i<>tpos[b]-d
                 then tower(i,17-nt,2*d,1,0);
         end;
end;

procedure movedown(d,t : byte);
var p : byte;
begin
     inc(towers[t]);
     for i:=17-nt to 18-towers[t] do
         begin
              tower(tpos[t]-d,i,2*d,1,1);
              delay(md);
              if i<>18-towers[t]
                 then tower(tpos[t]-d,i,2*d,1,0);
         end;
end;

procedure move(n,a,b : byte);
begin
     moveup(n,a);
     if a<b
        then moveright(n,a,b)
        else moveleft(n,a,b);
     movedown(n,b);
end;

procedure hanoi(n : integer;a, b, c : byte);
begin
     if n=1
        then move(n,a,b)
        else
            begin
                 hanoi(n-1,a,c,b);
                 move(n,a,b);
                 hanoi(n-1,c,b,a);
            end;
end;

begin
     textbackground(1);
     textcolor(14);
     clrscr;
     asm
        mov ah,1
        mov ch,1
        mov cl,0
        int 10h
     end;
     intro;
     towers[1]:=nt;
     towers[2]:=0;
     towers[3]:=0;
     md:=50;
     hanoi(nt,1,2,3);
     gotoxy(18,5);
     writeln(' Apasati o tasta pentru a parasi programul... ');
     readkey;
     stop;
end.

          
Comments: