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

uses noiz,drums;
var j,k: integer;

procedure down(a,b,c: integer);
begin
  drums.down(a,b,c);
  quiet;
end;

procedure up(a,b,c: integer);
begin
  drums.up(a,b,c);
  quiet;
end;

procedure crash(dur: integer);
begin
  up(1,14,1);
  down(0,dur,1);
end;

procedure roll1;
var i: integer;
begin
  for i:=1 to 4 do down(0,2,1);
  for i:=1 to 4 do down(1,2,1);
  for i:=1 to 4 do down(2,2,1);
  for i:=1 to 4 do up(3,2,1);
  down(0,20,1);
end;

procedure roll2;
var i: integer;
begin
  for i:=1 to 4 do up(1,2,1);
  for i:=1 to 4 do down(2,2,1);
  for i:=1 to 4 do up(0,2,1);
  for i:=1 to 4 do down(0,3,1);
  up(0,20,1);
end;

procedure roll3;
var i: integer;
begin
  bass(2,4);
  lowtom(8,2); tom(8,2); snare(8,2);
  bass(2,4);
  snare(8,2); tom(8,2); lowtom(8,2);
  bass(8,2);
  down(0,20,1);
end;

procedure roll4;
begin
  snare(8,2);
  lowtom(4,4); lowtom(4,2);
  tom(4,4); roto1(4,1);
end;

procedure filler(b: boolean);
begin
  sound(e2); snare(2,8);
  sound(g2); snare(2,6);
  sound(a3); snare(4,2);
  sound(as2); lowtom(4,4);
  sound(b2); lowtom(4,2);
  sound(d2); tom(4,4);
  sound(b2); bass(4,2);
  sound(d2); snare(2,5);
  bend(d2,e2,40,12,1);
  if b then
  begin
    sound(e2);
    chord(e3,b3,e4,6,12);
    nosound;
    snare(2,2);
  end else
    snare(2,2);
end;

procedure lick1(reps,dur: integer);
const
  eblues: array[1..8] of integer =
          (e3,fs3,g3,a4,as4,b4,d4,e4);
var i,j: integer;
begin
  if (reps <= 0) then exit;
  j:=1;
  for i:=1 to reps do
  begin
    j:=1;
    repeat
      plays(eblues[j],dur,0,9,0);
      inc(j);
    until j=9;
    bend(d4,e4,24,2,1);
    plays(g4,20,10,0,0);
    bend(e4,d4,24,2,1);
    quiet;
  end;
end;

procedure guitar_solo;
begin
  sound(e2);
  chord(e3,b3,e4,15,25); quiet;
  scale2(e3,g3,a4,as4,b4,d4,ds4,e4,10,2,9,0);
  crash(2); crash(5);
  sound(as2);
  chord(as4,f4,as5,15,25); quiet;
  bend(d5,e5,40,0,3);
  plays(e5,50,0,10,0);
  scale2(g5,e5,d5,b5,g5,e5,d5,b5,25,5,0,0);
  scale2(g5,e5,d5,b5,as5,a5,g4,e4,25,5,0,0);
  bend(d5,e5,40,0,3); plays(g5,50,0,0,0);
  bend(e5,d5,40,4,1); plays(b5,50,0,0,0);
  bend(g5,a6,20,0,3);
  scale2(b6,as6,a6,g5,b6,as6,a6,g5,10,10,0,0);
  bend(d5,e5,20,5,1);
  scale2(g5,e5,d5,b5,as5,a5,g4,e4,0,7,7,0);
  crash(2); crash(6);
  sound(e2);
  echo(40,long);
  chord(e3,b3,e4,1,30);
  down(2,15,1);
end;

procedure ending;
begin
  up(1,25,1);
  sound(as2); chord(as4,f4,as5,27,25);
  up(0,25,1);
  sound(c2); chord(g3,c4,g4,27,10);
  up(2,46,1);
  sound(e1); chord(e3,b4,e4,27,15);
  up(1,5,1); down(2,50,1); quiet; halt;
end;

procedure beat1(reps: integer);
var i,mode,counter: integer;
label tg;
begin
  k:=0; mode:=0;
  up(2,50,1); filler(true);
Tg:
  case mode of
    0:;
    1: sound(e3);
    2: sound(b3);
    3: begin
         sound(a2); mode:=0;
       end;
  end;
  inc(mode);
  down(2,8,1);
  if (i = 2) then
  begin
    if (k in [12,16,20,24,28,32,36]) then
    begin
      case k of
        12: begin
              sound(g2);
              chord(g2,c3,g4,1,12);
              down(2,15,1);
            end;
        16: begin
              sound(d2);
              chord(d3,a4,c4,1,5);
              down(2,15,1);
            end;
        20: begin
              filler(false);
              sound(e2);
              chord(e3,b3,e4,1,12);
              down(2,15,1);
            end;
        24: begin
              sound(e2); lick1(1,12);
              sound(e2);
              chord(e3,b3,e4,1,30);
              down(2,15,1);
            end;
        28: begin
              sound(as2);
              chord(as4,f4,as5,1,25);
              down(2,15,1);
            end;
        32: guitar_solo;
        36: begin
              sound(as2);
              chord(as4,f4,as5,1,25);
              down(2,15,1);
              k:=0;
            end;
      end;
    end else
    begin
      nosound; 
      sound(e2);
      chord(e3,b3,e4,1,12);
      down(2,15,1);
    end;
  end;
  j:=0; i:=0;
  for counter:=1 to reps do
  begin
    if ((keyhit) and (fkey=#3)) then ending;
    inc(i); inc(j); inc(k);
    down(0,5,1);
    wait(50);
    if j=2 then
    begin
      up(1,5,1); j:=11; i:=0;
    end;
    if (i = 2) then goto tg;
    down(0,3,1);
    down(2,8,1);
    down(2,8,1);
  end;
  roll1; crash(15);
end;

begin
  drums.inturbo:=false; noiz.inturbo:=false;
  roll3; roll2; roll1;
  writeln('Hit Crtl-C to End');
  beat1(8);
end.