Uses dos, graph, crt ;

Label xx;

Const
  R  = 0; {Rest}
  C  = 1;
  Cs = 2;  Db = 2;
  D  = 3;
  Ds = 4;  Eb = 4;
  E  = 5;
  F  = 6;
  Fs = 7;  Gb = 7;
  G  = 8;
  Gs = 9;  Ab = 9;
  A  = 10;
  As = 11; Bb = 11;
  B  = 12;

Var
  Oct_Val       : array[0..8] OF Real;
  Freq_Val      : array[C..B] OF Real;
  ust_tuslar    : string;
  alt_tuslar    : string;
  x,y,i,j       : integer;
  kp            : char;
  p             : pointer;
  son           : integer;
  s             : string;
  okt,nota      : byte;
  zaman,kes     : word;
  oldint        : procedure;
  lz,hz         : byte;
  dosya         : text;
  dosya_adi     : string;
  Size          : Word;
  oktev         : array[1..500] of byte;
  notev         : array[1..500] of byte;
  zamev         : array[1..500] of integer;



{F+}
Procedure tik_tak;interrupt;
begin
  inc(zaman);
  inline ($9C);
  oldint;
end;
{F-}


Procedure tus_bekle;
begin
  kp:=readkey;
end;

Procedure curoff;
var r:registers;
begin
  r.ah:=$1;r.cx:=$ffff;
  intr($10,r);
end;

Procedure Frekans_ayar;
var
  n : Byte;
begin
    Freq_Val[1] := 1;
    FOR n := 2 TO 12 DO
      Freq_Val[n] := Freq_Val[n - 1] * 1.0594630944;
    Oct_Val[0] := 32.70319566;
    FOR n := 1 TO 8 DO
      Oct_Val[n] := Oct_Val[n - 1] * 2;
end;

Procedure Nota_cal(oktav : Byte;
                    nota : Byte;
                     sure: Word);
begin
  IF nota = R then
     NoSound
     else
      Sound(Round(Oct_Val[oktav] * Freq_Val[nota]));
  Delay(sure);
  NoSound;
end;

Procedure calmaya_basla(Octave : Byte;
                        Note   : Byte);
begin
  IF Note = R then NoSound
     else Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));
    okt:=octave;
    nota:=note;
end;

Procedure txt(a,b,c:byte;s:string);
begin
  gotoxy(a,b);
  textattr:=c;
  write(s);
end;


Procedure ilk;
begin
  frekans_ayar;
  nosound;

  for x:=1 to 4 do begin
      for y:=1 to 12 do nota_cal(x,y,25);
      end;

  nota_cal(4,12,500);
  for x:=4 downto 1 do begin
      for y:=12 downto 1 do nota_cal(x,y,25);
      end;
end;

Procedure grafik;
var
  grDriver : Integer;
  grMode   : Integer;
  ErrCode  : Integer;
begin
  grDriver := detect;
  InitGraph(grDriver,grmode,'');
  ErrCode := GraphResult;
  if ErrCode <> grOk then
  WriteLn('Graphics error:',
  GraphErrorMsg(ErrCode));
end;

Procedure nota_ciz(x,y,r:integer;renk:byte);
var
  size       : word;
  eski_renk  : byte;
begin
  eski_renk:=getcolor;
  setcolor(renk);
  setfillstyle(solidfill,renk);
  pieslice(x,y,0,360,r);
  line(x+r,y,x+r,y-15);
  arc(x+r,y-10,0,90,8);
  arc(x+r,y-8,0,90,8);
end;

Procedure pencere_kapat(x,y,z,t:integer);
var a,b:integer;
begin
  setlinestyle(0,0,3);
  setcolor(black);
     a:=0;b:=0;
     repeat
          rectangle(x+a,y+b,z-a,t-b);
          a:=a+2;
          b:=b+2;
     until (a>trunc((z-x)/2)) or (b>trunc((t-y)/2));
end;

Procedure acilis;
var x,y:integer;
begin
  grafik;
  for x:=1 to 70 do
  nota_ciz(random(getmaxx),random(getmaxy),5,random(getmaxcolor));
  setlinestyle(0,0,1);
  setcolor(red);
  rectangle(0,0,getmaxx,getmaxy);
  settextstyle(gothicfont,horizdir,7);
  setfillstyle(solidfill,black);
bar(trunc(getmaxx/5),trunc(getmaxy/5)+20,trunc(getmaxx/5)+400,trunc(getmaxy/5)
+70);

  setcolor(darkgray);
  for x:=1 to 5 do
      outtextxy(trunc(getmaxx/5)+x,trunc(getmaxy/5)+x,'Mzik Edit”r');
  setcolor(lightgray);
  outtextxy(trunc(getmaxx/5),trunc(getmaxy/5),'Mzik Edit”r');

  setfillstyle(solidfill,red);
  bar(20,310,620,327);
  settextstyle(smallfont,horizdir,5);
  setcolor(lightred);
  outtextxy(32,312,'Bu Program Cenk TARHAN tarafindan Programlama Sanati eki i‡in hazirlanmistir');
  setcolor(white);
  outtextxy(30,310,'Bu Program Cenk TARHAN tarafindan Programlama Sanati eki i‡in hazirlanmistir');
  ilk;
  tus_bekle;
  ilk;
  pencere_kapat(0,0,getmaxx,getmaxy);
end;

Procedure tus(x,y:integer;renk:byte);
begin
  setfillstyle(solidfill,renk);
  bar(x,y,x+10,y+45);
  setcolor(black);
  rectangle(x-1,y-1,x+11,y+46);
end;

Procedure editor_ekrani;
begin
  setlinestyle(0,0,1);
  setcolor(red);
  rectangle(0,0,getmaxx,getmaxy);
  rectangle(0,0,getmaxx,trunc(getmaxy/20));
  rectangle(0,0,getmaxx,trunc(getmaxy/10));
  rectangle(0,getmaxy-25,getmaxx,getmaxy);
  rectangle(0,getmaxy-50,getmaxx,getmaxy);

  setfillstyle(solidfill,blue);
  floodfill(1,trunc(getmaxy/20-1),red);
  floodfill(1,trunc(getmaxy-1),red);

  setfillstyle(solidfill,darkgray);
  floodfill(1,trunc(getmaxy/10-1),red);
  setcolor(white);
  settextstyle(smallfont,horizdir,5);
  outtextxy(270,0,'Mzik Edit”r');
  s:='Bu program Cenk Tarhan tarafindan Programlama Sanati eki icin'+
  ' hazirlanmistir...';
  outtextxy(30,getmaxy-20,s);
  setcolor(lightred);
  outtextxy(20,27,'Dosya     CAl      Basla      Kayit     Cikis');
  setcolor(white);
  outtextxy(20,27,' osya     C l       asla       ayit      ikis');

  outtextxy(540,27,'(F1) Yardim');
  rectangle(50,260,590,270);
  setfillstyle(solidfill,blue);
  floodfill(51,261,white);
  setfillstyle(solidfill,lightblue);
  bar(40,270,600,320);

  x:=1;
  repeat
    tus(40+x*12,290,lightgray);
    inc(x);
  until x=46;
  x:=1;
  repeat
    tus(45+x*12,275,darkgray);
    tus(45+x*12+12,275,darkgray);
        x:=x+7;
  until x>50;
  x:=1;
  repeat
    tus(82+x*12,275,darkgray);
    tus(82+x*12+12,275,darkgray);
    tus(82+x*12+24,275,darkgray);

    x:=x+7;
  until x>40;
end;

Procedure tus_kontrol;
begin
  kp:=readkey;
  if kp=#32 then nosound;
  for x:=1 to length(ust_tuslar) do begin
      if upcase(kp)=ust_tuslar[x] then begin
         if x<13 then calmaya_basla(2,x);
         if x>=13 then calmaya_basla(3,x-12);
         end;
      end;
  for x:=1 to length(alt_tuslar) do begin
      if upcase(kp)=alt_tuslar[x] then begin
         if x<6 then calmaya_basla(3,(x+7) mod 13);
         if x>=6 then  calmaya_basla(4,(x-5) mod 13);
         end;
      end;
end;

Procedure ana_menu(menu:byte);
begin
  setfillstyle(solidfill,darkgray);
  bar(1,25,getmaxx-1,45);
  case menu of
    1 : begin
         setfillstyle(solidfill,magenta);
         bar(10,25,70,45);
         end;
    2 : begin
         setfillstyle(solidfill,magenta);
         bar(80,25,150,45);
         end;
    3 : begin
         setfillstyle(solidfill,magenta);
         bar(160,25,240,45);
         end;
    4 : begin
         setfillstyle(solidfill,magenta);
         bar(250,25,320,45);
         end;
    5 : begin
         setfillstyle(solidfill,magenta);
         bar(330,25,390,45);
         end;
    end;
  setcolor(white);
  settextstyle(smallfont,horizdir,5);

  setcolor(lightred);
  outtextxy(20,27,'Dosya     CAl      Basla      Kayit     Cikis');
  setcolor(white);
  outtextxy(20,27,' osya     C l       asla       ayit      ikis');
  outtextxy(540,27,'(F1) Yardim');
end;

Procedure menu(x,y:integer; elemanlar:string);
var
  a,b,c,q: byte;
  eleman:string;
begin
  b:=1;
  for a:=1 to length(elemanlar) do if elemanlar[a]='|' then inc(b);
  setfillstyle(solidfill,darkgray);
  bar(x,y,x+70,y+b*18+15);
  setcolor(lightred);
  rectangle(x,y,x+70,y+b*18+15);
  settextstyle(defaultfont,horizdir,1);
  setcolor(white);
  a:=1;
  q:=0;
  repeat
    c:=1;
    repeat
      eleman[c]:=elemanlar[c+q];
      inc(c);
    until elemanlar[c+1]='|';
    q:=q+c;
    outtextxy(x+5,y+a*18-10,eleman);
    inc(a);
  until a=b;
  tus_bekle;
  setfillstyle(solidfill,black);
  bar(x,y,x+70,y+b*18+15);
end;

Procedure dosya_menusu;
begin
  ana_menu(1);
  menu(20,50,'Yukle|Kaydet|Isim|');
end;

Procedure calma_menusu;
begin
  bar(1,getmaxy-49,getmaxx-1,getmaxy-26);
  setcolor(yellow);
  outtextxy(60,getmaxy-49,'Su anda yapmis oldugunuz kayit calinmaktadir... Iyi eglenceler !');
  ana_menu(2);
  assign(dosya,dosya_adi);
  reset(dosya);
  readln(dosya,i);
  for x:=1 to i do begin
      readln(dosya,oktev[x]);
      readln(dosya,notev[x]);
      readln(dosya,zamev[x]);
      end;

  close(dosya);

  zaman:=0;
  for x:=1 to i-2 do begin
      calmaya_basla(oktev[x],notev[x]);
      delay(trunc(zamev[x+1]-zamev[x])*182);
      end;
  nosound;
end;

Procedure basla_menusu;
begin
  bar(1,getmaxy-49,getmaxx-1,getmaxy-26);
  setcolor(yellow);
  outtextxy(30,getmaxy-49,'Klavyeyi kullanarak calabilirsiniz.. (standart Q klavye)        <ESC> bitirir');
  ana_menu(3);
  repeat
  tus_kontrol;
  until kp=#27;
  nosound;
end;

Procedure kayit_menusu;
begin
  bar(1,getmaxy-49,getmaxx-1,getmaxy-26);
  setcolor(yellow);
  outtextxy(30,getmaxy-49,'Kayit yapabilirsiniz. Kayitlariniz "DENEME.MUZ" adinda bir dosyaya yapilacak');
  ana_menu(4);
  setfillstyle(solidfill,lightgray);
  bar(100,100,600,150);
  setfillstyle(solidfill,lightred);
  bar(100,130,600,150);
  setcolor(yellow);
  outtextxy(102,115,'Kayit basi');
  outtextxy(522,115,'Kayit sonu');
  zaman:=0;
  setcolor(black);
  outtextxy(222,115,'baslamak icin bir tusa basiniz');
  tus_bekle;
  setfillstyle(solidfill,lightgray);
  bar(222,115,500,129);
  outtextxy(230,115,'Kayittasiniz...     <ESC> durdur');
  zaman:=0;
  i:=1;
  repeat
    tus_kontrol;
    oktev[i]:=okt;
    notev[i]:=nota;
    zamev[i]:=zaman;
    inc(i);
  until (kp=#27);
  assign(dosya,dosya_adi);
  rewrite(dosya);
  writeln(dosya,i);
  for x:=1 to i do begin
      writeln(dosya,oktev[x]);
      writeln(dosya,notev[x]);
      writeln(dosya,zamev[x]);
      end;
  close(dosya);

  nosound;
  setfillstyle(solidfill,lightgray);
  bar(222,115,500,129);
  outtextxy(330,115,'Kayit bitti...');
  zaman:=0;
  repeat
  until zaman>20; {*Z*}
  setfillstyle(solidfill,lightgray);
  bar(222,115,500,129);
  setfillstyle(solidfill,black);
  pencere_kapat(100,100,600,150);
end;

Procedure cikis_menusu;
begin
  bar(1,getmaxy-49,getmaxx-1,getmaxy-26);
  setcolor(yellow);
  outtextxy(30,getmaxy-49,'Programdan cikmak icin <E> programa devam etmek icin <H> tusuna basiniz...');
  ana_menu(5);
  rectangle(200,120,420,145);
  outtextxy(220,125,'Programdan Cikis ? (E/H)');
  setcolor(lightgray);
  outtextxy(221,126,'Programdan Cikis ? (E/H)');
  tus_bekle;
  if upcase(kp)='E' then begin
     pencere_kapat(0,0,getmaxx,getmaxy);
     closegraph;
     setintvec($8,@oldint);
     clrscr;
     writeln('Programimi kullandiginiz icin tesekkurler...');
     halt;
    end else begin
     setfillstyle(solidfill,black);
     bar(200,120,420,145);
     end;
end;

Procedure yardim(x,y,z,q:integer);
begin
  size:=imagesize(x,y,z,q);
  getmem(p,size);
  getimage(x,y,z,q,p^);
  setcolor(white);
  rectangle(x,y,z,q);
  setcolor(lightgray);
  rectangle(x,y,z-1,q-1);
  setfillstyle(solidfill,darkgray);
  bar(x,y,z-2,q-2);
  setcolor(lightgreen);
  settextstyle(defaultfont,horizdir,1);
  outtextxy(x+10,y+20,'Yardim menusu henuz hazir degil!');
  tus_bekle;
  putimage(x,y,p^,normalput);
end;

Procedure islem_secimi;
begin
  repeat;
    setfillstyle(solidfill,black);
    bar(1,getmaxy-49,getmaxx-1,getmaxy-26);
    setcolor(yellow);
    outtextxy(150,getmaxy-49,'Menu seceneklerinden birini tercih ediniz...');

    kp:=readkey;
    case upcase(kp) of
       'D' : dosya_menusu;
       'A' : calma_menusu;
       'B' : basla_menusu;
       'K' : kayit_menusu;
       'C' : cikis_menusu;
       #59 : yardim(200,100,500,150);
       end;

    ana_menu(0);
  until 1=2;
end;

{ ANA PROGRAM BURADA BASLIYOR }

BEGIN
  getintvec($8,@oldint);
  setintvec($8,@tik_tak);

  dosya_adi:='deneme.muz';
  nosound;
  ust_tuslar := 'Q2W3ER5T6Y7UI9O0P[=';
  alt_tuslar := 'ZSXDCVGBHNMK,L.;/';
  frekans_ayar;
  grafik;
  randomize;
  acilis;
  editor_ekrani;
  islem_secimi;
  pencere_kapat(0,0,getmaxx,getmaxy);
  closegraph;
  setintvec($8,@oldint);
  clrscr;
  writeln('Programimi kullandiginiz icin tesekkurler...');
END.