{ SONG.PAS - Demo of music and drum routines for Tandy 1000 and/or PCJr }

uses noiz,drums;

procedure check_key(var ch: char);
begin
  if keyhit then
  begin
    ch:=upcase(fkey);
    case ch of
      '1': roto1(10,1);
      '2': roto2(6,10);
      '3': roto5(8,0,5);
      '4': snare(10,2);
      '5': begin
             snare(4,8); snare(8,2); snare(4,4);
           end;
      'Q',
      #27: begin
             up(1,19,1); sound(e1); wait(50);
             chord(e3,b3,fs4,32,17);
             sound(e2); echo(80,long); writeln;
             quiet; halt;
           end;
      'F': begin
             writeln; quiet; halt;
           end;
    end;
  end;
end;

procedure beat;
var
  i,j: integer;
  ch: char;
begin
  i:=0; j:=0;
  repeat
    check_key(ch);
    inc(i); inc(j);
    case i of
      10: begin
            quiet;
            roto5(8,20,2); sims(10,1);snare(8,2); tom(4,4); lowtom(8,2);
            i:=0; j:=0;
          end;
    end;
    case j of
      1: chord(d4,fs4,b5,1,14);
      2: chord(c4,g4,d4,1,14);
      3: chord(a4,cs4,fs4,1,14);
      4: chord(d4,a4,d5,1,14);
      5: begin
           snare(2,5); lowtom(1,10);
           roto1(2,2); roto2(2,20);
           j:=0;
         end;
    end;
    sound(a2); bass(1,10);
    sound(b2); snare(1,10);
    sound(g2); lowtom(2,5);
    sound(e2); snare(1,10);
  until true = false;
end;

procedure main;
const
  ray: array[1..8] of string[80] =
       ('1)   Roto 1',
        '2)   Roto 2',
        '3)   Roto 5',
        '4)   Snare roll',
        '5)   Snare lick',
        'Q)   Quit with Ending',
        'ESC) Quit with Ending',
        'F)   Halt with no Ending');

var
  i: integer;

begin
  writeln(#10'       -  Menu  -'#10);
  for i:=1 to 8 do writeln('    '+ray[i]);
  write(#10' Command [1,2,3,4,5,Q,F]: ');
  beat;
end;

begin
  drums.inturbo:=false; noiz.inturbo:=false;
  main;
end.