Звук скрипки программы Трио. Сценарий 43

  Звук скрипки, сделанный по сценарию Виола поющая, подробно описан тут - http://www.proza.ru/2019/03/14/1627

  Публикую текст сценария, алгоритм, по которому проводится вычисление амплитуды звука, а также текст функции, которая интерпретирует строку с мнемонической записью огибающей звука.
  Текст сценария взят из модуля MUZ3, поэтому цифра 3 в названиях глобальных переменных, таких, например, как W3W или ARE3 означают просто номер модуля.
  В модулях MUZ2 и MUZ1 сценарии аналогичны, с единственным исключением - там MU2 = 20.1 что создаёт в звуке лёгкое амплитудное вибрато.

  Вспомогательная программа, устанавливающая тембр, извлекает дробную часть числа и цифры, входящие в целую часть числа (деля их на десять), в отдельные ячейки массива, которые после этого считываются в сценарии.

СЦЕНАРИЙ

  Case 43 'viola поющая
    MU2 = 20.001: AU2 = 4: DU2 = 150.999: If UD3b > 0 Then DU2 = UD3b '30.99 для короткого звука
    B = 0.2: DK1 = 0.99: If By3 < 0 Then DU2 = 5.995: By3 = 0: AU2 = 6: B = 0.4 'b -лок.удар
    DU3 = 10.999: If UD3c > 0 Then DU3 = UD3c
    If ARE3 = 10 Then MU3 = 67.06: AU3 = 3: If Len(A3rr$) > 2 Then Arr$ = A3rr$
    NDc = -1: Call Swv(0, 600.25): Call Swv(1, UW3 + UV3): 'начальный ТЕМБР
        V = UX3: If By3 > 0 Then V = By3: By3 = 0 'огибающая звука: By имеет приоритет над UX
        NDcn% = 1: dND = 0.2: ADSR$ = "10=7-9-94": If V = 1 Then ADSR$ = A31r$ '\\\\\\ ADSR$ краткое
        If V = 2 Then ADSR$ = A32r$
        If V = 3 Then ADSR$ = A33r$
        If V > 0 Then 'в начале огибающей перед знаком $ может идти настройка тембра
        E1 = InStr(ADSR$, "$"): If E1 > 0 Then Call Swv(1, Val(ADSR$)): ADSR$ = Mid(ADSR$, E1 + 1)
        NDc = Val(ADSR$): DU2 = NDc + 0.99: End If
    mod2 = 30 + wv(3) * 10: Vi = wv(0): Vh = wv(1): Eo = wv(2) 'окончательная установка тембра
     If Rv3 > 0 Then B = Rv3 - Int(Rv3): If B > 0.6 Then B = 0.6 'rД.B B=0-.6 лок.регулировка эхо
     RR(0) = 0: If Rv3 >= 1 Then V = FNRR(0, 3300.2 + B): V = FNRR(0, 4500.2 + B) 'Д=1 +дальнее эхо
     V = FNRR(FS, 1209.3 + B): V = FNRR(FS, 926.2 + B): V = FNRR(FS, 540.1 + B): V = FNRR(20, -9)
 Case -43: Vo = Eo + 0.3 * FNTIM(3, T) + 0.2 * FNTIM(8, T): If FS < 440 Then Vo = Vo * FS / 440 '\\\\\
           E1 = 1: E1 = 1.2 + 0.2 * FNTIM(4, T): E2 = 1.1 + 0.3 * FNTIM(9, T)
           If NT = NDc Then 'обработка огибающей
     V = FNenv(ADSR$, NDcn%, FS): NDcn% = NDcn% + 1 + Len(comA$): 'следующий номер в ADSR$
     Do While Len(comA$) > 0: Select Case Left(comA$, 1)
      Case ".": If dND > 0.098 Then dND = dND - 0.05 'укорочение длительности фрагмента огибающей
      Case ">": Vi = Vi / 1.12: Case "<": Vi = Vi * 1.12
      Case "/": DT = DT * 1.0504631: Case "\": DT = DT / 1.0504631: Case "|": DT = DT0
      Case "Ы": DT0 = DT: W3W = 5.5: Case "ы": DT0 = DT: W3W = 5.25: Case "_": DT = DT0: W3W = 0 'вибрато
     End Select: comA$ = Mid(comA$, 2): Loop:
    If V >= 0 Then NDc = Int(NDc + dND * FS): If V > 0 Then DU2 = V
    dND = 0.2: End If
    If W3W > 1 And AW < 1 Then AW = AW + 0.05 'плавное вхождение в вибрато
    If W3W > 1 Then DT = DT0 * (1 + AW * (W3W - Int(W3W)) * 0.1 * FNTIM(Int(W3W), T)) 'вибрато
 
___________

АЛГОРИТМ вычисления амплитуды A2

    Case 36 ' viola 36 /\_A_/\_A_/\_A_
     B = 1 / Vi: B = B ^ 3: V = X - Vo: If V < 0 Then V = 2 + V
     If V > 2 Then V = V - 2
     V = V - 1: A2 = (V * V * V - V) / 0.3849 + 1: If A2 < 0 Then A2 = 0
     A2 = (A2 / 2) ^ B
       A2h = 0: V = X - 2 * Vo: If V < 0 Then V = 2 + V
       If V > 2 Then V = V - 2
       V = V - 1: A2h = (V * V * V - V) / 0.3849 + 1: If A2h < 0 Then A2h = 0
       A2h = (A2h / 2) ^ B
     A2 = A2 + A2h * Vh
     B = (1 / B) ^ 0.737: A2 = A2 - B / (1 + B)
    
    Case 37 ' viola 37 _/\_/\_ другой пичок
     V = X - Vo: If V < 0 Then V = 2 + V
     If V > 2 Then V = V - 2
     V = V - 1: B = E1: If V > 0 Then B = 2 - E1 'при E1=1 пичок симметричный
     A2 = V * B / Vi: A2 = (A2 * A2 + 0.9) ^ 8 + 1
     A2 = 1.428 / A2: A2 = (A2 + A2 ^ 4) / 2
       A2h = 0: V = X - 2 * Vo: If V < 0 Then V = 2 + V
       If V > 2 Then V = V - 2
       V = V - 1: B = E2: If V > 0 Then B = 2 - E2 'при E2=1 пичок симметричный
     A2h = V * B / Vi: A2h = (A2h * A2h + 0.9) ^ 8 + 1
     A2h = 1.428 / A2h: A2h = (A2h + A2h ^ 4) / 2
     A2 = A2 + A2h * Vh

____________

ФУНКЦИЯ FNenv, интерпретирующая строку ADSR$,
          вычисляет коэффициент ослабления для фрагмента огибающей,
          возвращает -1 если строка окончена, и 0 если фрагмент продолжается

Public Function FNenv(C$, N%, F As Double) As Double
Dim S$: Dim A$: Dim B$: Dim N1%: Dim L%: Dim AA As Single: Dim BB As Single
Dim I%: Dim dI%:
 comA$ = "": FNenv = -1: S$ = C$: I% = InStr(S$, "=")
 If I% > 0 Then S$ = Mid(S$, I% + 1): L% = Len(S$): N1% = N% Else Exit Function
Menv1:
 If N1% > L% Then Exit Function Else A$ = Mid(S$, N1%, 1)
 AA = Val(A$): If AA > 0 And I% > 0 Then I% = 0: dI% = 4: GoTo Menv2
 If A$ = "-" And I% > 0 Then N1% = N1% + 1: I% = 0: GoTo Menv1
 If A$ = "-" Then FNenv = 0: Exit Function
 If AA = 0 Then comA$ = comA$ + A$: N1% = N1% + 1: GoTo Menv1
 FNenv = 0: Exit Function
Menv2:
 N1% = N1% + 1: If N1% > L% Then FNenv = -1: Exit Function
 B$ = Mid(S$, N1%, 1): If B$ = "-" Then I% = I% + dI%: dI% = 4: GoTo Menv2
 BB = Val(B$): If B$ = "." And dI% > 1 Then dI% = dI% - 1
   If BB = 0 Then
       I% = 0 Then comA$ = comA$ + B$
       GoTo Menv2: End If
 I% = I% + dI%: AA = BB / AA: AA = Log(AA) / (I% * 0.05 * F)
 FNenv = Exp(AA)
End Function
_________

'===== Подпрограмма, устанавливающая тембр
' имеет два режима работы: 0 -установить, 1 -заменить.

Public Sub Swv(K%, A As Single) 'извлечение параметров тембра
Dim B As Single, B1 As Single, R As Single, I As Integer, M As Integer
M = K%: B = A: For I = 0 To 6
B1 = Int(B): R = B - B1: If M = 1 And R > 0 Then wv(I) = R
If M = 0 Then wv(I) = R: If R = 0 Then wv(I) = 1
B = B1 / 10
Next I
End Sub
_____________________