home *** CD-ROM | disk | FTP | other *** search
/ 130 MIDI Tool Box / 130 MIDI Tool Box.iso / help / prog.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-04-27  |  2.2 KB  |  99 lines
  1. program Sendacommand;
  2.  
  3. { ************************************************************** }
  4. { Program:  Sendacommand                     }
  5. { Author :  Jay Sissom                          }
  6. { Date   :  4-26-88                         }
  7. { Purpose:  Send commands to the MPU                 }
  8. { ************************************************************** }
  9.  
  10. uses Crt;
  11.  
  12. const
  13.   Dataport = $330;
  14.   Comport  = $331;
  15.   Statport = $331;
  16.   DSR      = $80;
  17.   DRR      = $40;
  18.   UART     = $3F;
  19.   ACK      = $FE;
  20.   RST      = $FF;
  21.   THRU_ON  = $89;
  22.   THRU_OFF = $88;
  23.  
  24. type
  25.   lstr     = string[100];
  26.  
  27. var
  28.   X        : integer;
  29.   j        : char;
  30.  
  31. procedure send_command(cmd : byte);
  32.  
  33. var
  34.   stat : byte;
  35.   ackn : byte;
  36.  
  37. begin
  38.   ackn := 0;
  39.   while (ackn <> $FE) do
  40.     begin
  41.       stat := 0;
  42.       while (stat and DRR) = DRR do stat := port[Statport];
  43.       port[Comport] := cmd;
  44.       stat := 0;
  45.       while (stat and DSR) = DSR do stat := port[Statport];
  46.       ackn := port[Dataport]
  47.     end
  48. end;
  49.  
  50. function send_data(d : byte) : boolean;
  51.  
  52. const
  53.   timeout = 255;
  54.  
  55. var
  56.   t : integer;
  57.  
  58. { I added the timeout stuff because the program kept locking up }
  59. { bit 6 of Statport will never go to 0.  It doesn't happen all  }
  60. { the time.  Usually the 2nd byte sent of the third run, when I }
  61. { tested it.                                                    }
  62.  
  63. begin
  64.   write('B ');
  65.   t := 0;
  66.   while ((Port[Statport] and DRR) = DRR) and (t < timeout) do inc(t);
  67.   if t = timeout
  68.      then send_data := false
  69.      else begin
  70.             port[Dataport] := d;
  71.             writeln('A')
  72.           end
  73. end;
  74.  
  75. procedure error(msg : lstr);
  76.  
  77. begin
  78.   writeln;
  79.   writeln(msg);
  80.   halt(1)
  81. end;
  82.  
  83. begin
  84.   send_command(RST);
  85.   send_command(UART);
  86.   FOR X := 50 to 70 do
  87.     begin
  88.       { Send the data on Channel 2 }
  89.       if not send_data($91) then error('Timeout on note on');
  90.       if not send_data(X)   then error('Timeout on on data');
  91.       if not send_data(10)  then error('Timeout on on velocity');
  92.       delay(129);
  93.       if not send_data($91) then error('Timeout on note off');
  94.       if not send_data(X)   then error('Timeout on off data');
  95.       if not send_data(0)   then error('Timeout on off velocity')
  96.     end;
  97.   send_command(RST)
  98. end.
  99.