home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / m / m003_1 / sdk_dos.ddi / TPASCAL / MUSIC / DEMOFM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-10-03  |  5.0 KB  |  126 lines
  1. { ------------------------------------------------------------------------ }
  2. {  @@ Source Documentation                           *** TP6 Version ***   }
  3. {                                                                          }
  4. {  Copyright (c) Creative Technology Pte Ltd, 1991. All rights reserved.   }
  5. {                                                                          }
  6. {   TITLE       : DEMOFM.PAS                                               }
  7. {                                                                          }
  8. {   DESCRIPTION :                                                          }
  9. {       This program demonstrates how to call the SBFM low level functions }
  10. {       to play a 'C major scale' using each of the 10 instruments         }
  11. {       defined.                                                           }
  12. {                                                                          }
  13. {       The program is responsible for the timing between notes.           }
  14. {                                                                          }
  15. {       The program checks the LASTER environment for the Card settings.   }
  16. {       It also performs a test based on the BLASTER environment settings  }
  17. {       to ensure they tally with the hardware settings on the Card.       }
  18. {                                                                          }
  19. { ------------------------------------------------------------------------ }
  20.  
  21. program demofm;
  22.  
  23. { Include the SBC Unit, and any other units needed }
  24. uses sbc_tp6, dos, crt;
  25.  
  26. const
  27.   { instrument table }
  28.   inst : array[0..9] of array[0..15] of byte =
  29.                 ( ( $21,$11,$4c,$00,$f1,$f2,$63,$72,
  30.                     $00,$00,$04,$00,$00,$00,$00,$00 ),
  31.  
  32.                   ( $a5,$b1,$d2,$80,$81,$f1,$03,$05,
  33.                     $00,$00,$02,$00,$00,$00,$00,$00 ),
  34.  
  35.                   ( $71,$62,$1c,$05,$51,$52,$03,$13,
  36.                     $00,$00,$0e,$00,$00,$00,$00,$00 ),
  37.  
  38.                   ( $11,$01,$8a,$40,$f1,$f1,$11,$b3,
  39.                     $00,$00,$06,$00,$00,$00,$00,$00 ),
  40.  
  41.                   ( $21,$11,$11,$00,$a3,$c4,$43,$22,
  42.                     $02,$00,$0d,$00,$00,$00,$00,$00 ),
  43.  
  44.                   ( $31,$a1,$1c,$80,$41,$92,$0b,$3b,
  45.                     $00,$00,$0e,$00,$00,$00,$00,$00 ),
  46.  
  47.                   ( $71,$62,$c5,$05,$6e,$8b,$17,$0e,
  48.                     $00,$00,$02,$00,$00,$00,$00,$00 ),
  49.  
  50.                   ( $41,$91,$83,$00,$65,$32,$05,$74,
  51.                     $00,$00,$0a,$00,$00,$00,$00,$00 ),
  52.  
  53.                   ( $32,$16,$87,$80,$a1,$7d,$10,$33,
  54.                     $00,$00,$08,$00,$00,$00,$00,$00 ),
  55.  
  56.                   ( $01,$13,$8d,$00,$51,$52,$53,$7c,
  57.                     $01,$00,$0c,$00,$00,$00,$00,$00 ) );
  58.  
  59.  
  60. { ------------------------------------------------------------------------ }
  61. {  @@ Usage                                                                }
  62. {                                                                          }
  63. {   procedure PlayScale                                                    }
  64. {                                                                          }
  65. {   DESCRIPTION:                                                           }
  66. {       Play a 'major scale' for each of the 10 instruments defined.       }
  67. {                                                                          }
  68. {   ENTRY:                                                                 }
  69. {       None                                                               }
  70. {                                                                          }
  71. {   EXIT:                                                                  }
  72. {       None                                                               }
  73. {                                                                          }
  74. { ------------------------------------------------------------------------ }
  75.  
  76. procedure PlayScale;
  77. const
  78.     { look up table starting for a scale starting from 'Middle C' }
  79.     note_num : array[0..7] of byte = ( 60,62,64,65,67,69,71,72 );
  80.  
  81. var
  82.     i,j : word;
  83.     instrument, note : byte;
  84.  
  85. begin
  86.  
  87.     for instrument := 0 to 9 do begin
  88.         sbfd_program_change(0,instrument);
  89.  
  90.         for note := 0 to 7 do begin
  91.             sbfd_note_on(0,note_num[note],$40);
  92.  
  93.             for i := 0 to 150 do
  94.                 for j := 0 to 1000 do begin
  95.                 end;
  96.  
  97.             sbfd_note_off(0,note_num[note],$40);
  98.         end;
  99.     end;
  100.  
  101. end;
  102.  
  103.  
  104. { ------------------------------------------------------------------------ }
  105.  
  106. { main function }
  107. begin
  108.  
  109.     if GetEnvSetting = 0 then begin
  110.  
  111.         if boolean( sbc_check_card and $0002 ) then begin
  112.  
  113.             sbfd_init;
  114.             sbfd_instrument(@inst);
  115.             PlayScale;
  116.             sbfd_reset;
  117.  
  118.         end
  119.         else
  120.             writeln('Sound Blaster card not found or wrong I/O setting.');
  121.     end
  122.     else
  123.         writeln('BLASTER environment variable not set or incomplete or invalid.');
  124.  
  125. end.
  126.