{******************************************************************************

Play sounds via keyboard

Yes, its the standard annoying utility to turn your keyoard into an organ.

******************************************************************************}

program keyboard(input);

uses trmlib,
     strlib,
     sndlib;

label 99;

const second  = 10000;
      keydown = 10;

var 

   er:     evtrec;   { event record }
   chan:   channel;  { channel }
   velo:   integer {velocity}; { velocity }
   port:   integer;  { synth port to output to }
   keycnt: array [1..36] of 0..keydown;
   ki:     1..36;

procedure wait(t: integer);

var er: evtrec; { event record }

begin

   timer(input, 1, t, false);
   repeat event(input, er) until (er.etype = ettim) or (er.etype = etterm);
   if er.etype = etterm then goto 99

end;

procedure keyon(n: integer);

begin

   
   if keycnt[n] = 0 then { key not already down }
      case n of { key }

      1:  noteon(port, 0, chan, note_c+octave_4, velo);
      2:  noteon(port, 0, chan, note_c_sharp+octave_4, velo);
      3:  noteon(port, 0, chan, note_d+octave_4, velo);
      4:  noteon(port, 0, chan, note_d_sharp+octave_4, velo);
      5:  noteon(port, 0, chan, note_e+octave_4, velo);
      6:  noteon(port, 0, chan, note_f+octave_4, velo);
      7:  noteon(port, 0, chan, note_f_sharp+octave_4, velo);
      8:  noteon(port, 0, chan, note_g+octave_4, velo);
      9:  noteon(port, 0, chan, note_g_sharp+octave_4, velo);
      10: noteon(port, 0, chan, note_a+octave_4, velo);
      11: noteon(port, 0, chan, note_a_sharp+octave_4, velo);
      12: noteon(port, 0, chan, note_b+octave_4, velo);
      13: noteon(port, 0, chan, note_c+octave_5, velo);
      14: noteon(port, 0, chan, note_c_sharp+octave_5, velo);
      15: noteon(port, 0, chan, note_d+octave_5, velo);
      16: noteon(port, 0, chan, note_d_sharp+octave_5, velo);
      17: noteon(port, 0, chan, note_e+octave_5, velo);
      18: noteon(port, 0, chan, note_f+octave_5, velo);
      19: noteon(port, 0, chan, note_f_sharp+octave_5, velo);
      20: noteon(port, 0, chan, note_g+octave_5, velo);
      21: noteon(port, 0, chan, note_g_sharp+octave_5, velo);
      22: noteon(port, 0, chan, note_a+octave_5, velo);
      23: noteon(port, 0, chan, note_a_sharp+octave_5, velo);
      24: noteon(port, 0, chan, note_b+octave_5, velo);
      25: noteon(port, 0, chan, note_c+octave_6, velo);
      26: noteon(port, 0, chan, note_c_sharp+octave_6, velo);
      27: noteon(port, 0, chan, note_d+octave_6, velo);
      28: noteon(port, 0, chan, note_d_sharp+octave_6, velo);
      29: noteon(port, 0, chan, note_e+octave_6, velo);
      30: noteon(port, 0, chan, note_f+octave_6, velo);
      31: noteon(port, 0, chan, note_f_sharp+octave_6, velo);
      32: noteon(port, 0, chan, note_g+octave_6, velo);
      33: noteon(port, 0, chan, note_g_sharp+octave_6, velo);
      34: noteon(port, 0, chan, note_a+octave_6, velo);
      35: noteon(port, 0, chan, note_a_sharp+octave_6, velo);
      36: noteon(port, 0, chan, note_b+octave_6, velo)

   end;
   keycnt[n] := keydown { start, or restart, key down count }

end;

procedure keyoff(n: integer);

begin

   case n of { key }

      1:  noteoff(port, 0, chan, note_c+octave_4, velo);
      2:  noteoff(port, 0, chan, note_c_sharp+octave_4, velo);
      3:  noteoff(port, 0, chan, note_d+octave_4, velo);
      4:  noteoff(port, 0, chan, note_d_sharp+octave_4, velo);
      5:  noteoff(port, 0, chan, note_e+octave_4, velo);
      6:  noteoff(port, 0, chan, note_f+octave_4, velo);
      7:  noteoff(port, 0, chan, note_f_sharp+octave_4, velo);
      8:  noteoff(port, 0, chan, note_g+octave_4, velo);
      9:  noteoff(port, 0, chan, note_g_sharp+octave_4, velo);
      10: noteoff(port, 0, chan, note_a+octave_4, velo);
      11: noteoff(port, 0, chan, note_a_sharp+octave_4, velo);
      12: noteoff(port, 0, chan, note_b+octave_4, velo);
      13: noteoff(port, 0, chan, note_c+octave_5, velo);
      14: noteoff(port, 0, chan, note_c_sharp+octave_5, velo);
      15: noteoff(port, 0, chan, note_d+octave_5, velo);
      16: noteoff(port, 0, chan, note_d_sharp+octave_5, velo);
      17: noteoff(port, 0, chan, note_e+octave_5, velo);
      18: noteoff(port, 0, chan, note_f+octave_5, velo);
      19: noteoff(port, 0, chan, note_f_sharp+octave_5, velo);
      20: noteoff(port, 0, chan, note_g+octave_5, velo);
      21: noteoff(port, 0, chan, note_g_sharp+octave_5, velo);
      22: noteoff(port, 0, chan, note_a+octave_5, velo);
      23: noteoff(port, 0, chan, note_a_sharp+octave_5, velo);
      24: noteoff(port, 0, chan, note_b+octave_5, velo);
      25: noteoff(port, 0, chan, note_c+octave_6, velo);
      26: noteoff(port, 0, chan, note_c_sharp+octave_6, velo);
      27: noteoff(port, 0, chan, note_d+octave_6, velo);
      28: noteoff(port, 0, chan, note_d_sharp+octave_6, velo);
      29: noteoff(port, 0, chan, note_e+octave_6, velo);
      30: noteoff(port, 0, chan, note_f+octave_6, velo);
      31: noteoff(port, 0, chan, note_f_sharp+octave_6, velo);
      32: noteoff(port, 0, chan, note_g+octave_6, velo);
      33: noteoff(port, 0, chan, note_g_sharp+octave_6, velo);
      34: noteoff(port, 0, chan, note_a+octave_6, velo);
      35: noteoff(port, 0, chan, note_a_sharp+octave_6, velo);
      36: noteoff(port, 0, chan, note_b+octave_6, velo)

   end

end;

procedure tick;

var i: 1..36;

begin

   for i := 1 to 36 do { scan keys }
      if keycnt[i] > 0 then begin { there is an active key }

      keycnt[i] := keycnt[i]-1; { count }
      if keycnt[i] = 0 then keyoff(i) { process key off }

   end

end;

begin

   port := 1; { set standard output port }
   opensynthout(port); { open main synthesiser }
   chan := 1; { set channel 1 }
   velo := maxint; { set velocity }
   for ki := 1 to 36 do keycnt[ki] := 0; { clear key down counts } 
   timer(input, 1, second div 4 div 10, true); { set basic timer }
   repeat { events }

      event(input, er); { get next event }
      if er.etype = etchar then begin { its a standard key }
      
         if lcase(er.char) in ['0','1','2','3','4','5','6','7','8','9','-','=', 
                               'q','w','e','r','t','y','u','i','o','p','[',']',
                               'a','s','d','f','g','h','j','k','l',';',''''] then
            case lcase(er.char) of 

            '1':  keyon(1);
            '2':  keyon(2);
            '3':  keyon(3);
            '4':  keyon(4);
            '5':  keyon(5);
            '6':  keyon(6);
            '7':  keyon(7);
            '8':  keyon(8);
            '9':  keyon(9);
            '0':  keyon(10);
            '-':  keyon(11);
            '=':  keyon(12);
            'q':  keyon(13);
            'w':  keyon(14);
            'e':  keyon(15);
            'r':  keyon(16);
            't':  keyon(17);
            'y':  keyon(18);
            'u':  keyon(19);
            'i':  keyon(20);
            'o':  keyon(21);
            'p':  keyon(22);
            '[':  keyon(23);
            ']':  keyon(24);
            'a':  keyon(25);
            's':  keyon(26);
            'd':  keyon(27);
            'f':  keyon(28);
            'g':  keyon(29);
            'h':  keyon(30);
            'j':  keyon(31);
            'k':  keyon(32);
            'l':  keyon(33);
            ';':  keyon(34);
            '''': keyon(35)

         end

      end else if er.etype = etenter then keyon(36)
      else if er.etype = etfun then begin

         if er.fkey = 1 then instchange(port, 0, 1, inst_Acoustic_Grand)
         else if er.fkey = 2 then instchange(port, 0, 1, inst_electric_Grand)
         else if er.fkey = 3 then instchange(port, 0, 1, inst_Rock_Organ)
         else if er.fkey = 4 then instchange(port, 0, 1, inst_Church_Organ)
         else if er.fkey = 5 then instchange(port, 0, 1, inst_Nylon_String_Guitar)
         else if er.fkey = 6 then instchange(port, 0, 1, inst_Overdriven_Guitar)
         else if er.fkey = 7 then instchange(port, 0, 1, inst_Trumpet)
         else if er.fkey = 8 then instchange(port, 0, 1, inst_Lead_1_square)
         else if er.fkey = 9 then instchange(port, 0, 1, inst_Lead_2_sawtooth)
         else if er.fkey = 10 then instchange(port, 0, 1, inst_pad_1_new_age)
         else if er.fkey = 11 then instchange(port, 0, 1, inst_pad_3_polysynth)
         else if er.fkey = 12 then instchange(port, 0, 1, inst_Woodblock)

      end else if er.etype = ettim then tick { process key timers }

   until er.etype = etterm;

   99:

end.