Ooops
October 29, 2020, 02:21:03 AM

Author Topic: [bb] MakeAudio by Ziltch [ 1+ years ago ]  (Read 1353 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] MakeAudio by Ziltch [ 1+ years ago ]
« on: June 29, 2017, 12:28:42 AM »
Title : MakeAudio
Author : Ziltch
Posted : 1+ years ago

Description : Create wav format sound files and play them from memory

"MakeAudio.bb"


Code :
Code: BlitzBasic
  1. ; Blitz Sound From Memory banks function library
  2. ; ADAmor ZILTCH June 2003
  3. ;
  4. ; version .8  28/06/2003
  5. ;         .9  06/04/2004 Speed up by adding WavDataStartPos Param to read/write
  6. ;        1.0  20/05/2004 Fixed ReadWavBank Bug
  7.  
  8. ;--------------------------------------------------------------
  9. ;  Add to winmm.decls (or create) in userlib directory
  10. ;
  11. ;.lib "winmm.dll"
  12. ;winmm_PlaySound%(lpszName*,hModule%,dwFlags%):"PlaySoundA"
  13. ;winmm_StopSound%(lpszName%,hModule%,dwFlags%):"PlaySoundA"
  14.  
  15. ;--------------------------------------------------------------
  16.  
  17. ;NOTE:
  18. ;You can load ,play and save all wave files,but only alter PCM type files.
  19. ;PCM wav files contain uncompressed sample data so they are easier to deal with.
  20.  
  21. ;ALSO:
  22. ;Unfortunately only ONE sample at a time can be played from a sound bank.
  23. ;But you can alter sounds as you play them!
  24. ;Blitz sounds commands will work at the same time.
  25.  
  26.  
  27. Const SND_APPLICATION = $80         ;  look for application specific association
  28. Const SND_ALIAS = $10000            ;  name is a WIN.INI [sounds] entry
  29. Const SND_ALIAS_ID = $110000        ;  name is a WIN.INI [sounds] entry identifier
  30. Const SND_ASYNC = $1                ;  play asynchronously
  31. Const SND_FILENAME = $20000         ;  name is a file name
  32. Const SND_LOOP = $8                 ;  loop the sound until next sndPlaySound
  33. Const SND_MEMORY = $4               ;  lpszSoundName points to a memory file
  34. Const SND_NODEFAULT = $2            ;  silence not default, if sound not found
  35. Const SND_NOSTOP = $10              ;  don;t stop any currently playing sound
  36. Const SND_NOWAIT = $2000            ;  don;t wait if the driver is busy
  37. Const SND_PURGE = $40               ;  purge non-static events for task
  38. Const SND_RESOURCE = $40004         ;  name is a resource name or atom
  39. Const SND_SYNC = $0                 ;  play synchronously (default)
  40. Const ALL_CHANNELS    = 0
  41. Const LEFT_CHANNEL    = 1
  42. Const RIGHT_CHANNEL   = 2
  43. Const EightBitMidpoint = 127         ; 8bit samples range from 0-255
  44.                                     ; use this to move the sample data up.
  45.                                     ; See CreateSinWav function for example
  46. Global WavDataStartPos, WavDataSize
  47.  
  48. Dim echoData(8)
  49.  
  50. Type WavTypes
  51.  Field WavTypeNames$,WavTypeID%,WavTypeCompany$
  52. End Type
  53.  
  54. Function CreateWavBank(NumSamples,SampleRate=44100,BitsPerSample=16,Channels=1)
  55.  
  56.  
  57.    BlockSize  = Channels*(BitsPerSample/8)
  58.    DataLength = NumSamples*BlockSize
  59.  
  60.    ;Make sure DataLength is an even number
  61.    If DataLength/2 <> DataLength/2.0 Then DataLength = DataLength + 1
  62.  
  63.    FileLength = Datalength + 44
  64.    tbank       = CreateBank(FileLength)
  65.  
  66.    PokeStr$(tbank,"RIFF",0)
  67.    PokeInt(tbank,4,FileLength-8)
  68.    PokeStr$(tbank,"WAVE",8)
  69.    PokeStr$(tbank,"fmt ",12)
  70.    PokeInt(tbank,16,16)
  71.    PokeShort(tbank,20,1)       ;1=PCM This is raw uncompressed wav file format
  72.    PokeShort(tbank,22,Channels);1=mono,2=stereo
  73.    PokeInt(tbank,24,SampleRate);eg 44100,22050,11025 sound cards only support some freq's.
  74.    PokeInt(tbank,28,BlockSize*SampleRate)
  75.    PokeShort(tbank,32,BlockSize)
  76.    PokeShort(tbank,34,BitsPerSample)
  77.    PokeStr$(tbank,"data",36)
  78.    PokeInt(tbank,40,DataLength)
  79.    WavDataStartPos = 44
  80.    WavDataSize = NumSamples
  81. ;
  82.   Return tbank
  83.  
  84. End Function
  85.  
  86.  
  87.  
  88. Function WriteWavBankData(tbank,Offset,WavData,ChannelToWrite=1,WavDataStartPos=0)
  89.  
  90.   BitsPerSample=GetWavBitsPerSample(tbank)
  91.   Channels=GetWavChannelCount(tbank)
  92.   If WavDataStartPos =0 Then WavDataStartPos=GetWavDataStartPos(tbank)
  93.   blocksize = Channels*BitsPerSample/8
  94.   Offset = (Offset*blocksize) + WavDataStartPos  + ((ChannelToWrite-1)*(BitsPerSample/8))
  95. ;debuglog "  Offset = "+(Offset*blocksize)+" + "+WavDataStartPos+" + "  + ((ChannelToWrite-1)*(BitsPerSample))
  96. ;stop
  97.   If offset > ( BankSize(tbank)-blocksize) Then
  98.     DebugLog Offset+" Offset to large"
  99.     Return 1
  100.   EndIf
  101.  
  102.   If BitsPerSample=16 Then
  103.  
  104.     If WavData > 32767  Then
  105.       WavData =  32767
  106.     Else If WavData < -32767 Then
  107.       WavData = -32767
  108.     End If
  109.  
  110.     PokeByte tbank,Offset,WavData And $FF
  111.     PokeByte tbank,Offset+1,(WavData And $FF00) Shr 8
  112.  
  113.   Else If BitsPerSample=8 Then
  114.  
  115.     If WavData > 255  Then
  116.       WavData =  255
  117.     Else If WavData < 0 Then
  118.       WavData = 0
  119.     End If
  120.  
  121.     PokeByte tbank,Offset,WavData
  122.  
  123.   End If
  124.  
  125.   Return 1
  126.  
  127. End Function
  128.  
  129.  
  130.  
  131. Function ReadWavBankData(tbank,Offset,ChannelToRead=1,WavDataStartPos=0)
  132.  
  133.   BitsPerSample=GetWavBitsPerSample(tbank)
  134.   Channels=GetWavChannelCount(tbank)
  135.   If WavDataStartPos = 0 Then WavDataStartPos=GetWavDataStartPos(tbank)
  136.   blocksize = Channels*BitsPerSample/8
  137.   Offset = (Offset*blocksize) + ((ChannelToRead-1)*BitsPerSample/8)+ WavDataStartPos
  138.   Bsize = BankSize(tbank)-blocksize
  139.  
  140.   If ChannelToRead  > Channels Then
  141.     DebugLog "Channel "+ChannelToRead +" to large. Sample has "+ Channels + " Channels."
  142.     Return
  143.   EndIf
  144.  
  145.   If offset  > Bsize Then
  146.     DebugLog Offset+" Offset to large. Banksize is "+ Bsize
  147.     Return
  148.   EndIf
  149.  
  150.   If BitsPerSample=16 Then
  151.       LoByte = PeekByte (tbank,Offset)
  152.       HiByte = PeekByte (tbank,Offset+1)
  153.       sign =   hibyte Shr 7
  154. ;      OutData =  LoByte + ((HiByte And 127)Shl 7)
  155.       OutData =  LoByte +( (HiByte And 127)* 256) -(32768*sign)
  156. ;      debuglog "HI "+HiByte +" lo "+LoByte +" sign "+ sign  +"   XX "  +outdata
  157.   ElseIf BitsPerSample=8 Then
  158.      OutData = PeekByte (tbank,Offset)
  159.   End If
  160.  
  161.   Return OutData
  162.  
  163. End Function
  164.  
  165.  
  166.  
  167. Function PlaySoundBank(TBank,flags=0)
  168.   If tbank <> 0 Then
  169.     flags=flags Or SND_MEMORY Or SND_ASYNC Or SND_NODEFAULT ; These flags set up playing samples from memory
  170.     winmm_PlaySound(TBank,0,flags)
  171.   Else
  172.     Return 1
  173.   End If
  174. End Function
  175.  
  176.  
  177. ;for playing windows default sounds
  178. Function WinPlaySound(TBank,flags=0)
  179.   If tbank <> 0 Then
  180.     flags=flags Or SND_SYNC; Or SND_NODEFAULT ; These flags set up playing samples from memory
  181.     winmm_PlaySound(TBank,0,flags)
  182.   Else
  183.     Return 1
  184.   End If
  185. End Function
  186.  
  187.  
  188.  
  189. ;you must do this to stop a looping sound and to clean up at end of program.
  190. Function StopSoundBank()
  191.     winmm_StopSound(0,0,SND_PURGE Or SND_NODEFAULT)
  192. End Function
  193.  
  194.  
  195.  
  196. ;-- These functions get info from the wav header
  197.  
  198. ;-- Not all PCM wav files data starts at byte 44
  199. ;   So we need to use this function on some loaded samples if they are to be altered.
  200. Function GetWavDataStartPos(tbank)
  201.    DataStart=36 ; jump over header
  202.    Dummy$=""
  203.    TBanksize = BankSize(tbank)
  204.  
  205.    Repeat
  206.  
  207.       Dummy$ = Dummy$ + Chr$(PeekByte(tbank,DataStart))
  208.       Dummy  = Lower(Right$(Dummy,4))
  209.       If Dummy = "data" Then Exit
  210.       DataStart = DataStart +1
  211.       If DataStart >= TBanksize Then
  212.         RuntimeError " Can Not Find Data In Wave File."
  213.         Return
  214.       End If
  215.  
  216.    Forever
  217.  
  218.    Return DataStart  +5
  219. End Function
  220.  
  221.  
  222. Function GetWavDataLength(tbank)
  223.    Return PeekInt(tbank,GetWavDataStartPos(tbank)-4)
  224. End Function
  225.  
  226. Function GetWavNumberOfSamples(tbank)
  227.    Return GetWavDataLength(tbank)/GetWavBlocksize(tbank)
  228. End Function
  229.  
  230.  
  231. Function GetWavChannelCount(tbank)
  232.    Return PeekShort(tbank,22)     ; Channel  (1=Mono ; 2=Stereo)
  233. End Function
  234.  
  235. Function GetWavSampleRate(tbank)
  236.    Return PeekInt(tbank,24)     ; Sample freq e.g. 44100KHz
  237. End Function
  238.  
  239. Function GetWavBlocksize(tbank)
  240.    Return PeekShort(tbank,32)  ; Data Blocksize
  241. End Function
  242.  
  243. Function GetWavBitsPerSample(tbank)
  244.    Return PeekShort(tbank,34)  ; Bits per sample
  245. End Function
  246.  
  247. Function GetWavBytesPerSecond(tbank)
  248.    Return PeekShort(tbank,28)  ; Bytes per second
  249. End Function
  250.  
  251. Function GetWavSeconds#(tbank)  ; Sample length in seconds
  252.    Return  GetWavDataLength(tbank)/Float(GetWavBytesPerSecond(tbank))
  253. End Function
  254.  
  255. Function GetWavType(tbank)     ; Use this to see if a sample is
  256.    Return PeekShort(tbank,20)  ; type 1 (PCM). Only these can be read/writen to.
  257. End Function                   ; See create echo for example.
  258.  
  259.  
  260. Function GetWavTypeName$(tbank,show_company=True) ;Returns Wav type name
  261.    If First WavTypes = Null Then ReadWavTypes()
  262.    WavType = PeekShort(tbank,20)
  263.  
  264.    For  twtype.WavTypes = Each WavTypes
  265.  
  266.      If WavType = twtypeWavTypeID% Then
  267.        If show_company Then
  268.          Return  twtypeWavTypeNames$+" by " +twtypeWavTypeCompany$
  269.        Else
  270.          Return  twtypeWavTypeNames$
  271.        End If
  272.      End If
  273.  
  274.    Next
  275.  
  276.    Return
  277. End Function
  278.  
  279.  
  280. Function ReadWavTypes()
  281.   Restore Wavtypedata
  282.  
  283.   For count = 1 To 55
  284.    twtype.WavTypes = New WavTypes
  285.    Read twtypeWavTypeNames$,twtypeWavTypeID%,twtypeWavTypeCompany$
  286.   Next
  287.  
  288. End Function
  289.  
  290.  
  291. ;-- Use this to change the speed of samples
  292. Function SetWavSampleRate(tbank,freq)
  293.    PokeInt(tbank,24,freq)      ; Sample freq e.g. 41MHz
  294.    Blocksize = GetWavBlocksize(tbank)
  295.    PokeShort(tbank,28,freq*Blocksize)  ; Bytes per second
  296.  
  297. End Function
  298.  
  299.  
  300. Function SetWavDataLength(tbank,NewSize%)
  301.    DataStart = GetWavDataStartPos(tbank)
  302.    PokeInt(tbank,DataStart-4,NewSize)
  303. End Function
  304.  
  305.  
  306. Function SetWavNumberOfSamples(tbank,NewSize%)
  307.    DataStart = GetWavDataStartPos(tbank)
  308.    Blocksize = GetWavBlocksize(tbank)
  309.    PokeInt(tbank,DataStart-4,NewSize*Blocksize)
  310. End Function
  311.  
  312. ;--An example of how to alter sounds simply
  313. Function CreateEcho(TBank,echotime#,Decay#=.9,Channel=0)
  314. ;Channel=0 both
  315. ;Channel=1 left
  316. ;Channel=2 right
  317.  
  318.   If GetWavType(tbank) <> 1 Then
  319.     error=1
  320.     DebugLog "File is not PCM type.  Only uncompressed files can be used."
  321.     DebugLog "It is type "+  GetWavTypeName$(tbank)
  322.     Return error
  323.   End If
  324.  
  325.   DataStartPos   = GetWavDataStartPos(tbank)
  326.   BitsPerSample  = GetWavBitsPerSample(tbank)
  327.   Channels       = GetWavChannelCount(tbank)
  328.   blocksize      = GetWavBlocksize(tbank)
  329.   DataEndPos     = GetWavNumberOfSamples(tbank)
  330.   SampleRate     = GetWavSampleRate(tbank)
  331.   DelayTime#     = SampleRate*Float(echotime)/1000/blocksize
  332.   If BitsPerSample = 8 Then EightBit = EightBitMidpoint
  333.  
  334.   For counter = DelayTime To  DataEndPos-1
  335.  
  336.     If channel <> ALL_CHANNELS Then
  337.  
  338.       ;read sample info
  339.       DataIn = ReadWavBankData(TBank,counter,WavDataStartPos)
  340.       ;read second sample (the echo)
  341.       echoDat = ReadWavBankData(TBank,(counter-delaytime),Channel)*Decay#
  342.       ;write the two samples added together back into wav bank
  343.       WriteWavBankData(TBank,counter,( DataIn + EchoDat-EightBit),Channel)
  344.  
  345.     Else
  346.       ;this does the same for all channels
  347.       For channelcount = 1 To channels
  348.         DataIn = ReadWavBankData(TBank,counter)
  349.         echoData(channelcount) = ReadWavBankData(TBank,(counter-echotime),Channelcount)
  350.         WriteWavBankData(TBank,counter,( DataIn + EchoData(channelcount)-EightBit),Channelcount)
  351.       Next
  352.  
  353.     End If
  354.   Next
  355.  
  356. End Function
  357.  
  358.  
  359. Function AddWaveBanks(TBank1,Tbank2,Channel=0,LoopWave2=True)
  360. ;Channel=0 both
  361. ;Channel=1 left
  362. ;Channel=2 right
  363.  
  364.   If GetWavType(tbank1) <> 1 Then
  365.     error=1
  366.     DebugLog "File is not PCM type.  Only uncompressed files can be used."
  367.     DebugLog "It is type "+  GetWavTypeName$(tbank1)
  368.     Return error
  369.   End If
  370.  
  371.   If GetWavType(tbank2) <> 1 Then
  372.     error=1
  373.     DebugLog "Second File is not PCM type.  Only uncompressed files can be used."
  374.     DebugLog "It is type "+  GetWavTypeName$(tbank2)
  375.     Return error
  376.   End If
  377.  
  378. ;  DataStartPos1  = GetWavDataStartPos(tbank1)
  379.   BitsPerSample1 = GetWavBitsPerSample(tbank1)
  380.   BitsPerSample2 = GetWavBitsPerSample(tbank2)
  381.   Channels1      = GetWavChannelCount(tbank1)
  382.   Channels2      = GetWavChannelCount(tbank2)
  383. ;  blocksize1     = GetWavBlocksize(tbank1)
  384.   WavDataStartPos  = GetWavDataStartPos(tbank1)
  385.   WavDataStartPos2 = GetWavDataStartPos(tbank2)
  386.   DataEndPos1    = GetWavNumberOfSamples(tbank1) -1
  387.   DataEndPos2    = GetWavNumberOfSamples(tbank2) -1
  388.   If BitsPerSample1 = 8 Then
  389.     EightBit = EightBitMidpoint
  390.   Else
  391.     EightBit = 0
  392.   End If
  393.  
  394.   If BitsPerSample1 <> BitsPerSample2 Then
  395.     error=2
  396.     DebugLog "Samples must be same bits per sample size."
  397.     DebugLog "These are " +BitsPerSample1+"bit and "+BitsPerSample2+"bit."
  398.     Return error
  399.   End If
  400.  
  401.   If channel > Channels2 Then
  402.     error=3
  403.     DebugLog "You have selected a channel that does not exist."
  404.     DebugLog "You asked for channel " +Channel+" and sample has "+Channels1+" channels."
  405.     Return error
  406.   End If
  407.  
  408.   For counter = 0 To  DataEndPos1
  409.     counter2 = counter2 + 1
  410. ;    debuglog "counter2 "+counter2
  411.     If counter2 >= DataEndPos2 Then
  412.       If loopWave2 Then
  413.         counter2 = 0
  414.       Else
  415.         Return
  416.       End If
  417.     End If
  418.  
  419.     If channel <> ALL_CHANNELS Then
  420.  
  421.       ;read sample info
  422.       DataIn1 = ReadWavBankData(TBank1,counter,channel,WavDataStartPos)
  423.       ;read second sample
  424.     ;  DataIn2 = ReadWavBankData(TBank2,counter2,channel,WavDataStartPos2)
  425.       ;write the two samples added together back into wav bank
  426.       DataOut = DataIn1 + DataIn2 - EightBit
  427.       WriteWavBankData(TBank1,counter, DataOut ,Channel,WavDataStartPos)
  428.     Else
  429.       ;this does the same for all channels
  430.       For channelcount = 1 To channels1
  431.  
  432.         DataIn1 = ReadWavBankData(TBank1,counter,channelcount,WavDataStartPos)
  433.  
  434.         ;read second sample
  435.         If channelcount <= channels2 Then
  436.           channelcount2 = channelcount
  437.         Else
  438.           channelcount2 = channels2
  439.         End If
  440.  
  441.         DataIn2 = ReadWavBankData(TBank2,counter2,channelcount2,WavDataStartPos2)
  442.  
  443.         ;write the two samples added together back into wav bank
  444.         WriteWavBankData(TBank1,counter, DataIn1 + DataIn2 - EightBit ,channelcount,WavDataStartPos)
  445.       Next
  446.  
  447.     End If
  448.   Next
  449.  
  450. End Function
  451.  
  452.  
  453.  
  454. Function AddNoise(TBank,Amount#=100,Channel=0)
  455. ;Channel=0 both
  456. ;Channel=1 left
  457. ;Channel=2 right
  458.  
  459.   If GetWavType(tbank) <> 1 Then
  460.     error=1
  461.     DebugLog "File is not PCM type.  Only uncompressed files can be used."
  462.     DebugLog "It is type "+  GetWavTypeName$(tbank)
  463.     Return error
  464.   End If
  465.  
  466.   DataStartPos   = GetWavDataStartPos(tbank)
  467.   BitsPerSample  = GetWavBitsPerSample(tbank)
  468.   Channels       = GetWavChannelCount(tbank)
  469.   blocksize      = GetWavBlocksize(tbank)
  470.   DataEndPos     = GetWavNumberOfSamples(tbank)
  471.   amount = amount /2.0
  472.  
  473.   For counter = 0 To  DataEndPos-1
  474.  
  475.     If channel <> ALL_CHANNELS Then
  476.  
  477.       ;read sample info
  478.       DataIn = ReadWavBankData(TBank,counter) + Rnd(-amount,amount)
  479.  
  480.       ;write the new sample back into wav bank
  481.       WriteWavBankData(TBank,counter,DataIn,Channel)
  482.  
  483.     Else
  484.       ;this does the same for all channels
  485.       For channelcount = 1 To channels
  486.         DataIn = ReadWavBankData(TBank,counter) + Rnd(-amount,amount)
  487.         WriteWavBankData(TBank,counter,DataIn,Channelcount)
  488.       Next
  489.  
  490.     End If
  491.   Next
  492.  
  493. End Function
  494.  
  495.  
  496. ;--After you create a wav bank you can use this to create a sin wave
  497. Function CreateSinWav(tbank,Freq#=5000,Amp#,Channel=0)
  498. ;Channel=0 both
  499. ;Channel=1 left
  500. ;Channel=2 right
  501.  
  502. ;  DataStartPos   = GetWavDataStartPos(tbank)
  503.   BitsPerSample  = GetWavBitsPerSample(tbank)
  504.   Channels       = GetWavChannelCount(tbank)
  505.   blocksize      = Channels*BitsPerSample/8
  506.   Freq           = Freq /1000 ; millisec Hz
  507. ;  DataEndPos     = GetWavNumberOfSamples(tbank)-1
  508.   DataEndPos     = (BankSize(tbank)-44)/blocksize - 4
  509.   If BitsPerSample = 8 Then EightBit = EightBitMidpoint
  510.  
  511.   For counter=0 To  DataEndPos
  512.     oldval = val
  513.     val = (Sin(counter*Freq)*amp) + EightBit
  514.  
  515.     If (oldval < 0) And (val => 0) Then LastZeroPoint = counter
  516.  
  517.     If channel <> 0 Then
  518.       WriteWavBankData(tbank,counter,val,Channel)
  519.     Else
  520.  
  521.       For channelcount = 1 To channels
  522.         WriteWavBankData(tbank,counter,val,Channelcount)
  523.       Next
  524.  
  525.     End If
  526.   Next
  527.  
  528.   If LastZeroPoint > 0 Then SetWavNumberOfSamples(tbank,LastZeroPoint)
  529.  
  530. End Function
  531.  
  532. ;--After you create a wav bank you can use this to create a square wave
  533. Function CreateSqrWav(tbank,Freq#=5000,Amp#,Channel=1)
  534. ;Channel=0 both
  535. ;Channel=1 left
  536. ;Channel=2 right
  537.  
  538. ;  DataStartPos   = GetWavDataStartPos(tbank)
  539.   BitsPerSample  = GetWavBitsPerSample(tbank)
  540.   Channels       = GetWavChannelCount(tbank)
  541.   blocksize      = Channels*BitsPerSample/8
  542.   Freq           = Freq /1000 ; millisec Hz
  543.   DataEndPos     = GetWavNumberOfSamples(tbank)-1
  544.   If BitsPerSample = 8 Then EightBit = EightBitMidpoint
  545.  
  546.   For counter=0 To  DataEndPos
  547.     If channel <> 0 Then
  548.       WriteWavBankData(tbank,counter,(Sgn(Sin(counter)*Freq)*amp+ EightBit) ,Channel)
  549.     Else
  550.  
  551.       For channelcount = 1 To channels
  552.         WriteWavBankData(tbank,counter,(Sgn(Sin(counter)*Freq)*amp),Channelcount)
  553.       Next
  554.  
  555.     End If
  556.   Next
  557. End Function
  558.  
  559.  
  560. Function CreateSinSweep(tbank,StartFreq#=5000,EndFreq#=25000,Amp#,Channel=0)
  561. ;Channel=0 both
  562. ;Channel=1 left
  563. ;Channel=2 right
  564.  
  565. ;  DataStartPos   = GetWavDataStartPos(tbank)
  566.   BitsPerSample  = GetWavBitsPerSample(tbank)
  567.   Channels       = GetWavChannelCount(tbank)
  568.   blocksize      = Channels*BitsPerSample/8
  569.   DataEndPos     = GetWavNumberOfSamples(tbank)-1
  570.   Freq#           = StartFreq /1000 ; millisec Hz
  571.   Freqinc#       = ((EndFreq/1000)-freq)/Float(DataEndPos)/2
  572.   If BitsPerSample = 8 Then EightBit = EightBitMidpoint
  573.  
  574.   For counter=0 To  DataEndPos
  575.  
  576.     val=(Sin(counter*Freq)*amp) + EightBit
  577.     freq = freq + Freqinc
  578. ;    debuglog freq +" Freqinc# "+Freqinc#
  579.     If channel <> 0 Then
  580.       WriteWavBankData(tbank,counter,val,Channel)
  581.     Else
  582.  
  583.       For channelcount = 1 To channels
  584.         WriteWavBankData(tbank,counter,val,Channelcount)
  585.       Next
  586.  
  587.     End If
  588.   Next
  589. End Function
  590.  
  591.  
  592.  
  593.  
  594. ;-- Bank routines
  595.  
  596. Function PeekStr$(Tbank,Size=64,Offset=0)
  597.  
  598.   Local NewStr$ = ""
  599.   For count = offset To (offset+size-1)
  600.     newchr = PeekByte(Tbank,count)
  601.     If newchr = 0 Then Exit
  602.     newstr$ = newstr$ + Chr$(newchr)
  603.   Next
  604.   Return Newstr$
  605.  
  606. End Function
  607.  
  608.  
  609.  
  610. Function PokeStr$(Tbank,IN_Str$,Offset=0)
  611.  
  612.   size=Len(IN_Str$)
  613.   For count = offset To (offset+size-1)
  614.     PokeByte(Tbank,count,Asc(Mid$(IN_Str$,count-offset+1,1)))
  615.   Next
  616.  
  617. End Function
  618.  
  619.  
  620.  
  621. ; This saves a bank to a file
  622. Function BankToFile(InBank,FileName$)
  623.  
  624.   outfile=WriteFile(FileName$)
  625.  
  626.   If outfile = 0 Then
  627.      DebugLog("Can not use file. Maybe "+FileName$+" already inuse.")
  628.      Return 1
  629.   End If
  630.  
  631.   WriteBytes InBank,outfile,0,BankSize(InBank)
  632.  
  633.   CloseFile outfile
  634.  
  635. End Function
  636.  
  637.  
  638. ;-- This loads Any file into a bank if it is allowed to be opened.
  639. Function BankFromFile(FileName$)
  640.  
  641.   infile=ReadFile(FileName$)
  642.  
  643.   If infile = 0 Then
  644.      DebugLog("Can not use file Maybe "+FileName$+" already inuse.")
  645.      Return 1
  646.   End If
  647.  
  648.   filesiz = FileSize(FileName$)
  649.   OutBank = CreateBank(filesiz)
  650.   ReadBytes outBank,Infile,0,FileSiz
  651.  
  652.   CloseFile infile
  653.  
  654.   Return Outbank
  655.  
  656. End Function
  657.  
  658. .Wavtypedata
  659. Data  "Unknown",$0000,""
  660. Data  "PCM",$0001,"Microsoft Corporation"
  661. Data  "Adpcm",$0002,"Microsoft Corporation"
  662. Data  "ieee_Float",$0003,"Microsoft Corporation"
  663. Data  "Vselp",$0004,"Compaq Computer Corp."
  664. Data  "Ibm_Cvsd",$0005,"IBM Corporation"
  665. Data  "Alaw",$0006,"Microsoft Corporation"
  666. Data  "Mulaw",$0007,"Microsoft Corporation"
  667. Data  "Dts",$0008,"Microsoft Corporation"
  668. Data  "Oki_Adpcm",$0010,"OKI"
  669. Data  "Dvi_Adpcm",$0011,"Intel Corporation"
  670. Data  "Ima_Adpcm",$0012," Intel Corporation"
  671. Data  "Mediaspace_Adpcm",$0012,"Videologic"
  672. Data  "Sierra_Adpcm",$0013,"Sierra Semiconductor Corp"
  673. Data  "G723_Adpcm",$0014,"Antex Electronics Corporation"
  674. Data  "Digistd",$0015,"DSP Solutions, Inc."
  675. Data  "Digifix",$0016,"DSP Solutions, Inc."
  676. Data  "Dialogic_Oki_Adpcm",$0017,"Dialogic Corporation"
  677. Data  "Mediavision_Adpcm",$0018,"Media Vision, Inc."
  678. Data  "Cu_Codec",$0019,"Hewlett-Packard Company"
  679. Data  "Yamaha_Adpcm",$0020,"Yamaha Corporation of America"
  680. Data  "Sonarc",$0021,"Speech Compression"
  681. Data  "Dspgroup_Truespeech",$0022,"DSP Group, Inc"
  682. Data  "Echosc1",$0023,"Echo Speech Corporation"
  683. Data  "Audiofile_Af36",$0024,"Virtual Music, Inc."
  684. Data  "Aptx",$0025,"Audio Processing Technology"
  685. Data  "Audiofile_Af10",$0026,"Virtual Music, Inc."
  686. Data  "Prosody_1612",$0027,"Aculab plc"
  687. Data  "Lrc",$0028,"Merging Technologies S.A."
  688. Data  "Dolby_Ac2",$0030,"Dolby Laboratories"
  689. Data  "Gsm610",$0031,"Microsoft Corporation"
  690. Data  "Msnaudio",$0032,"Microsoft Corporation"
  691. Data  "Antex_Adpcme",$0033,"Antex Electronics Corporation"
  692. Data  "Control_Res_Vqlpc",$0034,"Control Resources Limited"
  693. Data  "Digireal",$0035,"DSP Solutions, Inc."
  694. Data  "Digiadpcm",$0036,"DSP Solutions, Inc."
  695. Data  "Control_Res_Cr10",$0037,"Control Resources Limited"
  696. Data  "Nms_Vbxadpcm",$0038,"Natural MicroSystems"
  697. Data  "Cs_Imaadpcm",$0039,"Crystal Semiconductor IMA ADPCM"
  698. Data  "Echosc3",$003A,"Echo Speech Corporation"
  699. Data  "Rockwell_Adpcm",$003B,"Rockwell International"
  700. Data  "Rockwell_Digitalk",$003C,"Rockwell International"
  701. Data  "Xebec",$003D,"Xebec Multimedia Solutions Limited"
  702. Data  "G721_Adpcm",$0040,"Antex Electronics Corporation"
  703. Data  "G728_Celp",$0041,"Antex Electronics Corporation"
  704. Data  "Msg723",$0042,"Microsoft Corporation"
  705. Data  "Mpeg",$0050,"Microsoft Corporation"
  706. Data  "Rt24",$0052,"InSoft, Inc."
  707. Data  "Pac",$0053,"InSoft, Inc."
  708. Data  "Mpeglayer3",$0055,"ISO/MPEG Layer3 Format Tag"
  709. Data  "Lucent_G723",$0059,"Lucent Technologies"
  710. Data  "Cirrus",$0060,"Cirrus Logic"
  711. Data  "Espcm",$0061,"ESS Technology"
  712. Data  "Voxware",$0062,"Voxware Inc"
  713. Data  "Canopus_Atrac",$0063,"Canopus, co., Ltd."
  714. Data  "G726_Adpcm",$0064,"APICOM"
  715. Data  "G722_Adpcm",$0065,"APICOM"
  716. Data  "Dsat_Display",$0067,"Microsoft Corporation"
  717. Data  "Voxware_Byte_Aligned",$0069,"Voxware Inc"
  718. Data  "Voxware_Ac8",$0070,"Voxware Inc"
  719. Data  "Voxware_Ac10",$0071,"Voxware Inc"
  720. Data  "Voxware_Ac16",$0072,"Voxware Inc"
  721. Data  "Voxware_Ac20",$0073,"Voxware Inc"
  722. Data  "Voxware_Rt24",$0074,"Voxware Inc"
  723. Data  "Voxware_Rt29",$0075,"Voxware Inc"
  724. Data  "Voxware_Rt29hw",$0076,"Voxware Inc"
  725. Data  "Voxware_Vr12",$0077,"Voxware Inc"
  726. Data  "Voxware_Vr18",$0078,"Voxware Inc"
  727. Data  "Voxware_Tq40",$0079,"Voxware Inc"
  728. Data  "Softsound",$0080,"Softsound, Ltd."
  729. Data  "Voxware_Tq60",$0081,"Voxware Inc"
  730. Data  "Msrt24",$0082,"Microsoft Corporation"
  731. Data  "G729a",$0083,"AT&T Labs, Inc."
  732. Data  "Mvi_Mvi2",$0084,"Motion Pixels"
  733. Data  "Df_G726",$0085,"DataFusion Systems (Pty) (Ltd)"
  734. Data  "Df_Gsm610",$0086,"DataFusion Systems (Pty) (Ltd)"
  735. Data  "Isiaudio",$0088,"Iterated Systems, Inc."
  736. Data  "Onlive",$0089,"OnLive! Technologies, Inc."
  737. Data  "Sbc24",$0091,"Siemens Business Communications Sys"
  738. Data  "Dolby_Ac3_Spdif",$0092,"Sonic Foundry"
  739. Data  "Mediasonic_G723",$0093,"MediaSonic"
  740. Data  "Prosody_8kbps",$0094,"Aculab plc"
  741. Data  "Zyxel_Adpcm",$0097,"ZyXEL Communications, Inc."
  742. Data  "Philips_Lpcbb",$0098,"Philips Speech Processing"
  743. Data  "Packed",$0099,"Studer Professional Audio AG"
  744. Data  "Malden_Phonytalk",$00A0,"Malden Electronics Ltd."
  745. Data  "Rhetorex_Adpcm",$0100,"Rhetorex Inc."
  746. Data  "Irat",$0101,"BeCubed Software Inc."
  747. Data  "Vivo_G723",$0111,"Vivo Software"
  748. Data  "Vivo_Siren",$0112,"Vivo Software"
  749. Data  "Digital_G723",$0123,"Digital Equipment Corporation"
  750. Data  "Sanyo_Ld_Adpcm",$0125,"Sanyo Electric Co., Ltd."
  751. Data  "Siprolab_Aceplnet",$0130,"Sipro Lab Telecom Inc."
  752. Data  "Siprolab_Acelp4800",$0131,"Sipro Lab Telecom Inc."
  753. Data  "Siprolab_Acelp8v3",$0132,"Sipro Lab Telecom Inc."
  754. Data  "Siprolab_G729",$0133,"Sipro Lab Telecom Inc."
  755. Data  "Siprolab_G729a",$0134,"Sipro Lab Telecom Inc."
  756. Data  "Siprolab_Kelvin",$0135,"Sipro Lab Telecom Inc."
  757. Data  "G726adpcm",$0140,"Dictaphone Corporation"
  758. Data  "Qualcomm_Purevoice",$0150,"Qualcomm, Inc."
  759. Data  "Qualcomm_Halfrate",$0151,"Qualcomm, Inc."
  760. Data  "Tubgsm",$0155,"Ring Zero Systems, Inc."
  761. Data  "Msaudio1",$0160,"Microsoft Corporation"
  762. Data  "Creative_Adpcm",$0200,"Creative Labs, Inc"
  763. Data  "Creative_Fastspeech8",$0202,"Creative Labs, Inc"
  764. Data  "Creative_Fastspeech10",$0203,"Creative Labs, Inc"
  765. Data  "Uher_Adpcm",$0210,"UHER informatic GmbH"
  766. Data  "Quarterdeck",$0220,"Quarterdeck Corporation"
  767. Data  "Ilink_Vc",$0230,"I-link Worldwide"
  768. Data  "Raw_Sport",$0240,"Aureal Semiconductor"
  769. Data  "Ipi_Hsx",$0250,"Interactive Products, Inc."
  770. Data  "Ipi_Rpelp",$0251,"Interactive Products, Inc."
  771. Data  "Cs2",$0260,"Consistent Software"
  772. Data  "Sony_Scx",$0270,"Sony Corp."
  773. Data  "Fm_Towns_Snd",$0300,"Fujitsu Corp."
  774. Data  "Btv_Digital",$0400,"Brooktree Corporation"
  775. Data  "Qdesign_Music",$0450,"QDesign Corporation"
  776. Data  "Vme_Vmpcm",$0680,"AT&T Labs, Inc."
  777. Data  "Tpc",$0681,"AT&T Labs, Inc."
  778. Data  "Oligsm",$1000,"Ing C. Olivetti & C., S.p.A."
  779. Data  "Oliadpcm",$1001,"Ing C. Olivetti & C., S.p.A."
  780. Data  "Olicelp",$1002,"Ing C. Olivetti & C., S.p.A."
  781. Data  "Olisbc",$1003,"Ing C. Olivetti & C., S.p.A."
  782. Data  "Oliopr",$1004,"Ing C. Olivetti & C., S.p.A."
  783. Data  "Lh_Codec",$1100,"Lernout & Hauspie"
  784. Data  "Norris",$1400,"Norris Communications, Inc."
  785. Data  "Soundspace_Musicompress",$1500,"AT&T Labs, Inc."
  786. Data  "Dvm",$2000,"FAST Multimedia AG"


Comments :


Blitz123(Posted 1+ years ago)

 This does not work : winmm_playsound does not exist...


tonyg(Posted 1+ years ago)

 <div class="quote"> ;--------------------------------------------------------------;  Add to winmm.decls (or create) in userlib directory;;.lib "winmm.dll";winmm_PlaySound%(lpszName*,hModule%,dwFlags%):"PlaySoundA";winmm_StopSound%(lpszName%,hModule%,dwFlags%):"PlaySoundA" </div>


rendomizer(Posted 1+ years ago)

 hi can you help me i can't run your midiintest.bb  without error message "fonction not found" etc                                thx amicalement rendomizerps i work on a music sequencer on Quickbasic but there are no midi input there...i will try blitz3d and i'll hope it will be better.


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal