home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / m / m003_1 / sdk_dos.ddi / TPASCAL / MIDI / MIDIIN.PAS next >
Encoding:
Pascal/Delphi Source File  |  1991-09-27  |  5.2 KB  |  139 lines
  1. { ------------------------------------------------------------------------ }
  2. {  @@ Source Documentation                           *** TP6 Version ***   }
  3. {                                                                          }
  4. {  Copyright (c) Creative Technology Pte Ltd, 1991. All rights reserved.   }
  5. {                                                                          }
  6. {   TITLE       : MIDIIN.PAS                                               }
  7. {                                                                          }
  8. {   DESCRIPTION :                                                          }
  9. {       This program demostrates how to use the SBK MIDI interface         }
  10. {       functions to read in the MIDI code through DSP and display         }
  11. {       it on screen. The user can terminate the process by pressing       }
  12. {       ESC key.                                                           }
  13. {                                                                          }
  14. {       The program checks BLASTER environment for the Card settings.      }
  15. {       It also performs test base on BLASTER environment settings to      }
  16. {       ensure they are tally with the hardware settings on the Card.      }
  17. {                                                                          }
  18. { ------------------------------------------------------------------------ }
  19.  
  20. program midiin;
  21.  
  22. { Include the SBC Unit, and any other units needed }
  23. uses sbc_tp6, dos, crt;
  24.  
  25. type
  26.     TwoChar = array[0..1] of char;
  27.     TwoCharPtr = ^TwoChar;
  28.  
  29. var
  30.     HexStr : TwoChar;
  31.  
  32.  
  33. { ------------------------------------------------------------------------ }
  34. {  @@ Usage                                                                }
  35. {                                                                          }
  36. {   function IntToHexStr(x : byte) : TwoCharPtr                            }
  37. {                                                                          }
  38. {   DESCRIPTION:                                                           }
  39. {       Convert byte to hex array.                                         }
  40. {                                                                          }
  41. {   ENTRY:                                                                 }
  42. {       x :- byte to be converted.                                         }
  43. {                                                                          }
  44. {   EXIT:                                                                  }
  45. {       pointer to the converted hex array.                                }
  46. {                                                                          }
  47. { ------------------------------------------------------------------------ }
  48.  
  49. { Function to convert byte to hex array }
  50. function IntToHexStr(x : byte) : TwoCharPtr;
  51. var
  52.     tmp, l : byte;
  53.  
  54. begin
  55.  
  56.     for l := 1 downto 0 do begin
  57.         tmp := x and $0f;
  58.  
  59.         if (tmp >= 10) and (tmp <= 15) then
  60.             HexStr[l] := CHR(tmp+$41-10)
  61.         else
  62.             HexStr[l] := CHR(tmp+$30);
  63.  
  64.         x := x shr 4;
  65.     end;
  66.  
  67.     IntToHexStr := @HexStr;
  68.  
  69. end;
  70.  
  71.  
  72. { ------------------------------------------------------------------------ }
  73.  
  74. { main function }
  75. var
  76.     midi_code, time_stamp : longint;
  77.     midi_byte : byte;
  78.     stop_flag : boolean;
  79.  
  80. begin
  81.  
  82.     if GetEnvSetting = 0 then begin
  83.  
  84.         if boolean( sbc_check_card and $0004 ) then begin
  85.  
  86.             if boolean(sbc_test_int) then begin
  87.  
  88.                 { Start input }
  89.                 sbmidi_start_input;
  90.  
  91.                 stop_flag := False;
  92.  
  93.                 repeat
  94.                     { Check for ESC key }
  95.                     if KeyPressed then
  96.                         if ReadKey = #27 then
  97.                             stop_flag := True;
  98.  
  99.                     { Read the MIDI input from buffer }
  100.                     midi_code := sbmidi_get_input;
  101.  
  102.                     if ( midi_code <> longint(0) ) then begin
  103.                         midi_byte := byte(midi_code and $000000ff);
  104.                         time_stamp := midi_code shr 8;
  105.                     
  106.                         writeln('MIDI Byte : ',(IntToHexStr(midi_byte))^:2,
  107.                                 ' hex    Time Stamp : ',time_stamp:8,' msec');
  108.                     end;
  109.                 until stop_flag;
  110.  
  111.  
  112.                 { Stop input }
  113.                 sbmidi_stop_input;
  114.  
  115.  
  116.                 { read the remaining codes in the buffer }
  117.                 repeat
  118.                     midi_code := sbmidi_get_input;
  119.  
  120.                     if ( midi_code <> longint(0) ) then begin
  121.                         midi_byte := byte(midi_code and $000000ff);
  122.                         time_stamp := midi_code shr 8;
  123.  
  124.                         writeln('MIDI Byte : ',(IntToHexStr(midi_byte))^:2,
  125.                                 ' hex    Time Stamp : ',time_stamp:8,' msec');
  126.                     end;
  127.                 until not boolean(midi_code);
  128.  
  129.             end
  130.             else
  131.                 writeln('Error on interrupt.');
  132.         end
  133.         else
  134.             writeln('Sound Blaster card not found or wrong I/O setting.');
  135.     end
  136.     else
  137.         writeln('BLASTER environment variable not set or incomplete or invalid.');
  138. end.
  139.