58 lines
2.1 KiB
QBasic
58 lines
2.1 KiB
QBasic
Attribute VB_Name = "modSynth"
|
|
'//////////////////////////////////////////////////////////////////////////////
|
|
' modSynth.bas - Copyright (c) 2006-2007 (: JOBnik! :) [Arthur Aminov, ISRAEL]
|
|
' [http://www.jobnik.org]
|
|
' [ jobnik@jobnik.org ]
|
|
'
|
|
' Other source: frmSynth.frm
|
|
'
|
|
' BASS Simple Synth
|
|
' Originally translated from - synth.c - Example of Ian Luck
|
|
'//////////////////////////////////////////////////////////////////////////////
|
|
|
|
Option Explicit
|
|
|
|
Public info As BASS_INFO
|
|
|
|
Public Const PI = 3.14159265358979
|
|
Public Const TABLESIZE = 2048
|
|
Public sinetable(TABLESIZE) As Long ' sine table
|
|
Public Const KEYS_ = 20
|
|
Public keys As Variant
|
|
Public Const MAXVOL = 4000 ' higher value = longer fadeout
|
|
|
|
Public vol(KEYS_) As Long, pos(KEYS_) As Long ' keys' volume & pos
|
|
|
|
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
|
|
|
|
' stream writer
|
|
Public Function WriteStream(ByVal handle As Long, ByVal buffer As Long, ByVal length As Long, ByVal user As Long) As Long
|
|
Dim n As Long, s As Long, c As Long
|
|
Dim f As Single
|
|
Dim buf() As Integer
|
|
ReDim buf(length) As Integer
|
|
|
|
For n = 0 To KEYS_ - 1
|
|
If (vol(n)) Then
|
|
f = (2 ^ ((n + 3) / 12#)) * TABLESIZE * 440# / info.freq
|
|
c = 0
|
|
Do While (c < length / 4 And vol(n))
|
|
s = sinetable((pos(n) * f) And (TABLESIZE - 1)) * vol(n) / MAXVOL
|
|
pos(n) = pos(n) + 1
|
|
s = s + buf(c * 2)
|
|
' clip
|
|
If (s > 32767) Then s = 32767
|
|
If (s < -32768) Then s = -32768
|
|
' left and right channels are the same
|
|
buf(c * 2) = s
|
|
buf(c * 2 + 1) = s
|
|
If (vol(n) < MAXVOL) Then vol(n) = vol(n) - 1
|
|
c = c + 1
|
|
Loop
|
|
End If
|
|
Next n
|
|
|
|
Call CopyMemory(ByVal buffer, buf(0), length)
|
|
|
|
WriteStream = length
|
|
End Function
|