home *** CD-ROM | disk | FTP | other *** search
/ Chip 2005 November / CDVD1105.ISO / Software / Freeware / programare / bass / vb / DSPtest / modDSPtest.bas < prev    next >
Encoding:
BASIC Source File  |  2005-09-20  |  4.8 KB  |  145 lines
  1. Attribute VB_Name = "modDSPtest"
  2. '////////////////////////////////////////////////////////////////////////////////
  3. ' modDSPtest.bas - Copyright (c) 2003-2005 (: JOBnik! :) [Arthur Aminov, ISRAEL]
  4. '                                                        [http://www.jobnik.org]
  5. '                                                        [  jobnik@jobnik.org  ]
  6. ' Other source: frmDSPtest.frm
  7. '
  8. ' BASS simple DSP test
  9. ' Originally translated from - dsptest.c - Example of Ian Luck
  10. '////////////////////////////////////////////////////////////////////////////////
  11.  
  12. Option Explicit
  13.  
  14. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
  15.  
  16. Public floatable As Long   'floating-point channel support?
  17. Public chan As Long        'the channel... HMUSIC or HSTREAM
  18.  
  19. Public Const PI = 3.1415927
  20.  
  21. '**********************************************************************************************
  22. '       GLOBAL DSP Variables
  23. '**********************************************************************************************
  24.  
  25. '"rotate"
  26. Public rotdsp As Long       'DSP handle
  27. Public rotpos As Single     'cur.pos
  28.  
  29. '"echo"
  30. Public echdsp As Long                  'DSP handle
  31. Public Const ECHBUFLEN = 1200          'buffer length
  32. Public echbuf(ECHBUFLEN, 2) As Single  'buffer
  33. Public echpos As Long                  'cur.pos
  34.  
  35. '"flanger"
  36. Public fladsp As Long                    'DSP handle
  37. Public Const FLABUFLEN = 350             'buffer length
  38. Public flabuf(FLABUFLEN, 2) As Single    'buffer
  39. Public flapos As Long                    'cur.pos
  40. Public flas As Single, flasinc As Single 'sweep pos/increment
  41.  
  42. '"swapper"
  43. Public swpdsp As Long                    'DSP handle
  44.  
  45. Function fmod(ByVal a As Single, b As Single) As Single
  46.    fmod = a - Fix(a / b) * b
  47. End Function
  48.  
  49.  
  50. '**********************************************************************************************
  51. '       DSP Functions
  52. '**********************************************************************************************
  53.  
  54. '"rotate"
  55. Public Sub Rotate(ByVal handle As Long, ByVal channel As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long)
  56.     Dim d() As Single, a As Long
  57.     ReDim d(length / 4) As Single
  58.  
  59.     Call CopyMemory(d(0), ByVal buffer, length)
  60.  
  61.     For a = 0 To (length / 4) - 1 Step 2
  62.         d(a) = d(a) * CSng(Abs(Sin(rotpos)))
  63.         d(a + 1) = d(a + 1) * CSng(Abs(Cos(rotpos)))
  64.         rotpos = fmod(rotpos + 0.00003, PI)
  65.     Next a
  66.  
  67.     Call CopyMemory(ByVal buffer, d(0), length)
  68. End Sub
  69.  
  70. '"echo"
  71. Public Sub Echo(ByVal handle As Long, ByVal channel As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long)
  72.     Dim d() As Single, a As Long
  73.     ReDim d(length / 4) As Single
  74.  
  75.     Call CopyMemory(d(0), ByVal buffer, length)
  76.  
  77.     For a = 0 To (length / 4) - 1 Step 2
  78.         Dim l As Single, r As Single
  79.         l = d(a) + (echbuf(echpos, 1) / 2)
  80.         r = d(a + 1) + (echbuf(echpos, 0) / 2)
  81. #If 1 Then  '0=echo, 1=basic "bathroom" reverb
  82.         echbuf(echpos, 0) = l
  83.         d(a) = l
  84.         echbuf(echpos, 1) = r
  85.         d(a + 1) = r
  86. #Else
  87.         echbuf(echpos, 0) = d(a)
  88.         echbuf(echpos, 1) = d(a + 1)
  89.         d(a) = l
  90.         d(a + 1) = r
  91. #End If
  92.         echpos = echpos + 1
  93.         If (echpos = ECHBUFLEN) Then echpos = 0
  94.     Next a
  95.  
  96.     Call CopyMemory(ByVal buffer, d(0), length)
  97. End Sub
  98.  
  99. '"flanger"
  100. Public Sub Flange(ByVal handle As Long, ByVal channel As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long)
  101.     Dim d() As Single, a As Long
  102.     ReDim d(length / 4) As Single
  103.  
  104.     Call CopyMemory(d(0), ByVal buffer, length)
  105.  
  106.     For a = 0 To (length / 4) - 1 Step 2
  107.         Dim p1 As Long, p2 As Long
  108.         p1 = (flapos + Int(flas)) Mod FLABUFLEN
  109.         p2 = (p1 + 1) Mod FLABUFLEN
  110.         Dim f As Single, s As Single
  111.         f = fmod(flas, 1)
  112.  
  113.         s = d(a) + ((flabuf(p1, 0) * (1 - f)) + (flabuf(p2, 0) * f))
  114.         flabuf(flapos, 0) = d(a)
  115.         d(a) = s
  116.  
  117.         s = d(a + 1) + ((flabuf(p1, 1) * (1 - f)) + (flabuf(p2, 1) * f))
  118.         flabuf(flapos, 1) = d(a + 1)
  119.         d(a + 1) = s
  120.  
  121.         flapos = flapos + 1
  122.         If (flapos = FLABUFLEN) Then flapos = 0
  123.         flas = flas + flasinc
  124.         If ((flas < 0#) Or (flas > FLABUFLEN)) Then flasinc = -flasinc
  125.     Next a
  126.  
  127.     Call CopyMemory(ByVal buffer, d(0), length)
  128. End Sub
  129.  
  130. '"swap between channels"
  131. Public Sub Swapper(ByVal handle As Long, ByVal channel As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long)
  132.     Dim d() As Single, tmp As Single, a As Long
  133.     ReDim d(length / 4) As Single
  134.  
  135.     Call CopyMemory(d(0), ByVal buffer, length)
  136.  
  137.     For a = 0 To (length / 4) - 1 Step 2
  138.         tmp = d(a)
  139.         d(a) = d(a + 1)
  140.         d(a + 1) = tmp
  141.     Next a
  142.  
  143.     Call CopyMemory(ByVal buffer, d(0), length)
  144. End Sub
  145.