Aktuelle Zeit: 09.03.2021 11:58

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 1 Beitrag ] 
Autor Nachricht
 Betreff des Beitrags: SoundPad
BeitragVerfasst: 02.01.2021 16:20 
Offline
Benutzeravatar

Registriert: 03.08.2005 21:06
Wohnort: Germ-any
Frohes neues Jahr noch...

Da ich kurz vor Sylvester über BasicallyPure 's SoundEasy gestolpert bin, hab ich mal ein wenig herumrefactort und raus kam dieses:

Code:
; Demo of Mod_Sound
; Demonstrates the CreateSound() and other commands.
; Author: Langinagel
; Date:   30.12.2020

; credits to basicallypure for SoundEasy !

IncludeFile "Mod_Sound.pbi"

UseModule GenSound
DisableExplicit

Enumeration FormWindow
  #WindowSound
EndEnumeration

Enumeration FormGadget
  #ButtonSound
  #Button_Save
  #Combo_0
  #Checkbox_Fadein
  #TrackBarFrequenz
  #CheckboxFadeOut
  #TrackBarDuration
  #TextFreq
  #TextDuration
  #CheckboxSweep
  #CanvasWave
  #TrackBarSweep
EndEnumeration


Procedure OpenWindowSound(x = 0, y = 0, width = 820, height = 620)
  OpenWindow(#WindowSound, x, y, width, height, "Soundboard", #PB_Window_SystemMenu)
  ButtonGadget(#ButtonSound, 30, 290, 150, 50, "Listen Sound")
  ComboBoxGadget(#Combo_0, 300, 30, 220, 40)
  CheckBoxGadget(#Checkbox_Fadein, 20, 20, 180, 30, "Fadein")
  TrackBarGadget(#TrackBarFrequenz, 30, 140, 510, 40, 0, 1000)
  CheckBoxGadget(#CheckboxFadeOut, 20, 60, 180, 30, "FadeOut")
  TrackBarGadget(#TrackBarDuration, 30, 220, 510, 30, 0, 1000)
  TextGadget(#TextFreq, 30, 100, 110, 30, "Frequenz")
  TextGadget(#TextDuration, 30, 180, 110, 30, "Duration")
  CheckBoxGadget(#CheckboxSweep, 300, 80, 180, 30, "Sweep ON")
  ButtonGadget( #Button_Save, 600, 290, 150, 50, "Save Sound")
  CanvasGadget(#CanvasWave, 10, 360, 800, 250)
  ; TrackBarGadget(#TrackBarSweep, 580, 30, 40, 240, 0, 100, #PB_TrackBar_Ticks | #PB_TrackBar_Vertical)
 
  AddGadgetItem(#Combo_0,    #WF_SineWave, "Sinus")
  AddGadgetItem(#Combo_0, #WF_SawTooth, "Sawtooth")
  AddGadgetItem(#Combo_0, #WF_BuzzSaw, "BuzzSaw")
  AddGadgetItem(#Combo_0, #WF_SquareWave, "Squarewave") ; funzt
  AddGadgetItem(#Combo_0, #WF_Triangle , "Triangle")     ; geht nich
  AddGadgetItem(#Combo_0, #WF_Chunosta , "Chunosta")    ; funzt
  AddGadgetItem(#Combo_0, #WF_Organ    , "Organ")       ; gehtso
  AddGadgetItem(#Combo_0, #WF_Noise , "Noise")
  AddGadgetItem(#Combo_0, #WF_GuidedNoise, "GuidedNoise")
 
 
  SetGadgetState(#Combo_0,    #WF_SineWave)
  SetGadgetState(#TrackBarFrequenz, 300)
  SetGadgetState(#TrackBarDuration, 700)
EndProcedure


Procedure PlotBuffer(*buffer)
   *FirstSample = *Buffer + 44 ; memory location of first audio sample
   *LastSample = *FirstSample + PeekL(*Buffer + 40) - 1 ; location of last audio sample
   
;    scalex.l = Int (( *Lastsample - *FirstSample ) /800)
;    Debug "scalex" +Str(scalex)
   StartDrawing(CanvasOutput(#CanvasWave))
      w = OutputWidth()
      h = OutputHeight()
      mid = h / 2
      Box(#CanvasWave,0,w,h,$0B5117)
      scale.f = (h - 1) / (Pow(2,16) - 1)
      LineXY(#CanvasWave, mid, w, mid, $0BF417)
     
      lastY = mid + (scale * PeekW(*FirstSample))
     
     
      For n = *FirstSample To *LastSample Step 2
         sampleData.w = PeekW(n)
         y = mid + (sampleData * scale)
         LineXY(lastX, lastY, x, y, $FFFFFF)
         x + 1
         lastX = x
         lastY = y
         If x > w - 1 : Break : EndIf
      Next n
   StopDrawing()
EndProcedure


Procedure.l Tonerzeugung()
  Protected.w fadein = 0, fadeout = 0, wave, save = 0
  Static snd
  Protected.f freq, dur, sweep
 
  If IsSound(snd)
    FreeSound(snd)
  EndIf
  freq = Round(GenSound::#FrequenzMin + Int(((GenSound::#FrequenzMax/2) - GenSound::#FrequenzMin) * (GetGadgetState(#TrackBarFrequenz) / 1000)) ,#PB_Round_Down)
  Debug "Frequenz " +StrF(freq)
  dur =  GenSound::#MinDuration + Int((GenSound::#MaxDuration - GenSound::#MinDuration )* (GetGadgetState(#TrackBarDuration) / 1000) *10) /10
  Debug "Dauer [s] " +StrF(dur)

  If GetGadgetState( #CheckboxSweep) = #PB_Checkbox_Checked   
    sweep  = 1000
  Else
    fadein = 0
  EndIf
 
  If GetGadgetState( #Checkbox_Fadein) = #PB_Checkbox_Checked   
    fadein = 1
  Else
    fadein = 0
  EndIf
  If GetGadgetState( #CheckboxFadeOut) = #PB_Checkbox_Checked   
    fadeout = 1
  Else
    fadeout = 0
  EndIf
;     If GetGadgetState( #CheckboxSave) = #PB_Checkbox_Checked   
;     save = 1
;   Else
;     save = 0
;   EndIf
  wave = GetGadgetState(#Combo_0 )
  Debug "Waveform =" +Str(wave)
  snd = CreateSound(#PB_Any, freq, dur, 50, sweep ,wave , fadein, fadeout)
  Debug snd
         
  ProcedureReturn snd
EndProcedure

Procedure.w WindowSound_Events(event)
  Protected.w quit
  Protected.f freq
  Static.l snd
 
  event = WaitWindowEvent()
  Delay(1)
  Select event
    Case #PB_Event_CloseWindow
      quit = 12
     
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #ButtonSound
          snd = Tonerzeugung()
           If IsSound(snd)
           
            PlaySound(snd)
           
            Debug "spielt"
          EndIf
          PlotBuffer(InitAudiobuffer(-1))
        Case #Button_Save
          Debug snd
          If IsSound(snd)
            freq = Round(GenSound::#FrequenzMin + Int(((GenSound::#FrequenzMax/2) - GenSound::#FrequenzMin) * (GetGadgetState(#TrackBarFrequenz) / 1000)) ,#PB_Round_Down)
            Debug SaveSound(freq)
          Else
            Debug "kein Ton"
          EndIf
      EndSelect
  EndSelect
  ProcedureReturn quit
EndProcedure

If InitSound()

  OpenWindowSound()
 
  Repeat
   
    quit.w = WindowSound_Events(event)
   
  Until quit = 12
 
EndIf


Code:
; Title:   ModGenSound.pbi
; Author:  LangiNagel
; Date:    30.12.2020
; Version: 1.0
; PB ver.  5.73
;
; credits to BasicallyPure 's "SoundEasy.pbi"
;

EnableExplicit

DeclareModule GenSound
 
  ;{ waveform styles
  Enumeration
    #WF_SineWave
    #WF_SawTooth
    #WF_BuzzSaw
    #WF_SquareWave ; funzt
    #WF_Triangle   ; geht nich
    #WF_Chunosta   ; funzt
    #WF_Organ      ; gehtso
    #WF_Noise
    #WF_GuidedNoise
  EndEnumeration
  ;}
 
  Enumeration 1
    #FadeIn
    #FadeOut
    #ADSR
   
    #DS_Abbruch   ; vorzeitiges Verlassen
    #DS_Erfolg
    #DS_allgFault
   
  EndEnumeration
  #AbtastrateMax = 44100
  #FrequenzMax = #AbtastrateMax / 2
  #FrequenzMin = 180
  #MaxAmplitude = 100
  #MinAmplitude = 3
  #MaxDuration =  1.485
  #MinDuration =  0.1
 
  Declare.l SetSoundParameters(sampleRate.l = 44100, resolution = 2, channels = 2)
 
  Declare.f InitAudioBuffer(duration.f = 1.0)
 
  Declare.l SaveSound(freq.f)
 
  Declare.i CreateSound(soundNum, frequency.f = 440, duration.f = 1.0, amplitude = 100, sweepStop.f = 0, waveform = #WF_SineWave, FadeIn = 0, FadeOut = 0)
 
  ;  Declare.l SaveSound(sFileName.s, *soundNum)
 
 
  DataSection ; don't change anything here
    wavHeader:; placeholder Rvalues for header info.
              ; Master chunk (12 bytes) ;x xxxxx, offset
    Data.a 'R','I','F','F'    ;4 bytes, 0, chunk ID, "RIFF"
    Data.l $00000000          ;4 bytes, 4, (total file size - 8) = Cs
    Data.a 'W','A','V','E'    ;4 bytes, 8, wave ID, "WAVE"
   
    ; Format chunk (24 bytes)
    Data.a 'f','m','t',' '    ;4 bytes, 12, chunk ID "fmt "
    Data.l $00000010          ;4 bytes, 16, this chunk size = 16, (2+2+4+4+2+2)
    Data.w $0001              ;2 bytes, 20, Wave_Format_PCM andere Formate siehe https://de.wikipedia.org/wiki/RIFF_WAVE
    Data.w $0000              ;2 bytes, 22, number fo channels, Nc
    Data.l $00000000          ;4 bytes, 24, samples per second per channel, Fr
    Data.l $00000000          ;4 bytes, 28, avg bytes per second, Fr*By*Nc  Abtastrate / FrameGröße
    Data.w $0000              ;2 bytes, 32, block align, By*Nc  Frame-Größe = <Anzahl der Kanäle> · ((<Bits/Sample (eines Kanals)> + 7) / 8)   (Division ohne Rest)
    Data.w $0000              ;2 bytes, 34, bits per sample, 8*By Anzahl der Datenbits pro Samplewert je Kanal (z. B. 12)
   
    ; Begin data chunk (8 bytes)
    Data.a 'd','a','t','a'    ;4 bytes, 36, chunk ID, "data"
    Data.l $00000000          ;4 bytes, 40, number of audio bytes, By*Nc*Ns
  EndDataSection
 
 
 
 
EndDeclareModule

Module GenSound
 
  Procedure.s SaveFile(sFile.s)
    Protected out.s
    StandardFile$ = GetHomeDirectory()+sFile  ; anfänglichen Pfad + Dateiname festlegen
                                              ; Mit dem nächsten String werden die Pattern (mit "|" als Trennzeichen) für anzuzeigende
                                              ; Dateitypen festgelegt:
                                              ;  Erster:  "Text (*.txt)" als Name, ".txt" und ".bat" als erlaubte Dateiendungen
                                              ;  Zweiter: "PureBasic (*.pb)" als Name, ".pb" al erlaubte Dateiendung
                                              ;  Dritter: "Alle Dateien (*.*) als Name, "*.*" als erlaubte Dateiendung, gültig für alle Dateien
    Pattern$ = "WAVE (*.wav)|*.WAV;*.wav|sonstig (*.did)|*.did|Alle Dateien (*.*)|*.*"
    Pattern = 0    ; wir verwenden den ersten von drei möglichen Pattern als Standard
    File$ = SaveFileRequester("Bitte Datei zum Speichern auswählen", StandardFile$, Pattern$, Pattern)
    If File$
      out.s =   File$
    Else
      MessageRequester("Information", "Der save Requester wurde abgebrochen.", 0)
    EndIf
    ProcedureReturn out
  EndProcedure
 
 
 
  Procedure.f CHKFreqency(frequency.f)   
    If frequency >= #FrequenzMax ; maximum frequency is set by sample rate, minimum by human ear
      frequency = #FrequenzMax - 1
    ElseIf frequency < #FrequenzMin
      frequency = #FrequenzMin
    EndIf 
    ProcedureReturn frequency
  EndProcedure
 
  Procedure.w CHKAmplitude(amplitude.w)   
    If amplitude > #MaxAmplitude
      amplitude = #MaxAmplitude
    ElseIf amplitude < 0
      amplitude = #MinAmplitude
    EndIf
    ProcedureReturn amplitude
  EndProcedure     
 
  Procedure.w CHKFade(FadeIn.w)   
    If FadeIn  <> 0
      FadeIn  = 1
    EndIf
    ProcedureReturn FadeIn
  EndProcedure 
 
  Procedure.f CHKDuration(duration.f)   
    If duration < #MinDuration
      duration = #MinDuration
    EndIf
    If duration >#MaxDuration 
      duration = #MaxDuration
    EndIf
    ProcedureReturn duration
  EndProcedure
 
  Procedure.f CHKSweepstop(sweepstop.f)   
    If sweepStop >= Fr/2
      sweepStop = Fr/2 - 1
    ElseIf sweepStop < 20
      sweepStop = 20
    EndIf
    ProcedureReturn sweepStop
  EndProcedure
 
  Procedure.l SetSoundParameters(sampleRate.l = #AbtastrateMax, resolution = 2, channels = 2)
    ; use this procedure only if you need to change the default sound paramaters.
    ; sampleRate  { number of samples per second: 5512, 11025, 22050, 44100 only}
    ; resolution  { bytes per sample   (1 [8 bits] Or 2 [16 bits] only) }
    ; channels    { number of channels (1 [ mono ] Or 2 [ stereo] only) }
   
    Static sr = #AbtastrateMax, res = 2, ch = 1
   
    Protected Output.l = 0
   
    If sampleRate < 0
      Select sampleRate
        Case -1 ; return sampleRate
          Output = sr
        Case -2 ; return resolution
          Output =  res
        Case -3 ; return number of channels
          Output =  ch
        Default
          Output =  0
      EndSelect
    Else  ; kein Output???
      If     sampleRate <= 5512 
        sr = 5512
      ElseIf sampleRate <= 11025
        sr = 11025
      ElseIf sampleRate <= 22050
        sr = 22050
      Else
        sr = 44100         
      EndIf
     
      If resolution <= 1
        res = 1
      Else
        res = 2
      EndIf
     
      If channels   <= 1
        ch  = 1
      Else
        ch  = 2
      EndIf
    EndIf
   
    ProcedureReturn Output
  EndProcedure
 
  Procedure.f InitAudioBuffer(duration.f = 1.0)
   
    ; purpose: create an empty PCM Wave format audio buffer in memory
    ; duration {sound buffer length in seconds}
    ; procedure returns a pointer that is the beginning of the wave sound header.
    ; this procedure is not intended to be used outside of this include file.
   
    Static *audBuff, length.f = 10
    Protected.l Av
    Protected.w Ba
    Protected.w Bs
    Protected.l Ns
    Protected.l Nb
    Protected.l Cs
    Protected.l Fr
   
    Protected *waveHdr
    Protected *output
   
    If duration < 0
      Select duration
        Case -1 : *outbut = *audBuff
        Case -2 : *outbut = length
        Default : *outbut = 0
      EndSelect
    Else
      length = duration
   
   
    If length < 0.1
      length = 0.1
    EndIf
   
    Fr = SetSoundParameters(-1) ; get samples per second ; default 44100
    By = SetSoundParameters(-2) ; get resolution { 1 byte or 2 byte } default 2
    Nc = SetSoundParameters(-3) ; get number of channels default 1....erstmal
                                ;     Debug Fr
                                ;     Debug By
                                ;     Debug Nc
   
   
    ; calculations to complete the header info.
    Av = Fr * By * Nc      ; average bytes per second
    Ba = Nc *  By          ; block align
    Bs =  8 *  By          ; bits per sample
    Ns = Fr * length       ; total number of blocks
    Nb = Ns * By * Nc      ; total number of audio bytes
    Cs = 36 + By * Nc * Ns ; total chunk size (file size - 8)
   
    If Cs & 1              ; add pad byte if needed to make even number
      Cs + 1
    EndIf
   
    ; set a pointer to the first byte in the header DataSection
    *waveHdr = ?wavHeader
   
    ; modify the default wave header as specified by the calculated parameters above
    PokeL(*waveHdr + 04, Cs) ; total size
    PokeW(*waveHdr + 22, Nc) ; number of channels
    PokeL(*waveHdr + 24, Fr) ; samples per second
    PokeL(*waveHdr + 28, Av) ; average bytes per second
    PokeW(*waveHdr + 32, Ba) ; block align
    PokeW(*waveHdr + 34, Bs) ; bits per sample
    PokeL(*waveHdr + 40, Nb) ; number of audio bytes
   
    If *audBuff
      FreeMemory(*audBuff)
    EndIf
   
    ; create space in memory for the audio data
    *audBuff = AllocateMemory(Cs + 8)
   
    If By = 1 ; 1 byte (8 bit) samples are unsigned so offset to 1/2 of full scale
      FillMemory(*audBuff, MemorySize(*audBuff), $80, #PB_Byte)
    ElseIf By = 2 ; 2 byte (16 bit) samples are signed so no offset is needed
      FillMemory(*audBuff, MemorySize(*audBuff), $8000, #PB_Word)
    EndIf
   
    ; put header information at the begining of sound buffer
    CopyMemory(*waveHdr,*audBuff,44)
    *outbut = *audBuff
    EndIf
    ProcedureReturn *outbut  ; return a pointer to the first byte
  EndProcedure
 
  Procedure.l SaveSound(freq.f)
    Protected Output.l = 0
    Protected leng.l
    Protected index.l
    Protected     *soundNum
    Protected.s sFileName
   
    *soundNum = InitAudioBuffer(-1)
    leng = PeekL(*soundnum + 40)
    Debug leng
    If leng  < 4
      Debug "kein wert drin"
    Else 
      leng = leng + 45 ; Bytecount + 44 und ein Byte zum Abschlauß
     
      sFileName = SaveFile(FormatDate("%mm%dd%hh%ii",Date())+"*"+StrF(freq)+".wav")     
      If sFileName <> ""
        ;leng = *end - *soundNum
       
        If CreateFile(12, sFileName)
          For index = 0 To leng
           
            WriteByte(12, PeekB(*soundNum + index ) )
          Next
          CloseFile(12)
          Output = leng
        Else
          Debug "createFile Falsch"
        EndIf
       
      Else
       
        Debug "name Falsch " + sFileName
      EndIf
    EndIf
    ;    EndIf
    ProcedureReturn Output
  EndProcedure
 
 
  Procedure.i CreateSound(soundNum, frequency.f = 440, duration.f = 1.0, amplitude = 100, sweepStop.f = 0, waveform = #WF_SineWave, FadeIn = 0, FadeOut = 0 )
   
    ; Syntax:
    ; Result = CreateSound(#sound, [frequency.f], [duration.f], [amplitude], [sweepStop.f], [waveform], [fadeIn], [fadeOut])
    ;
    ; #sound    { The number to identify the new sound. #PB_Any can be used to auto-generate this number. }
    ; frequency { The frequency in hertz of the new sound.  Default = 440.  Range = 20 to sample rate / 2 - 1
    ; duration  { The length of the new sound in seconds.  Default = 1.0 seconds. Minimum = 0.1 seconds.
    ; amplitude { the peak waveform magnitude from 0 to 100 (full scale).  Default = 25 }
    ; sweepStop { Sets the final frequency of a frequency sweep. Default = 0 (sweep disabled). Range is same as frequency.
    ; waveform  { Selects 1 of 9 different waveforms. Default = #WF_Sinewave. }
    ;           { possible waveforms are #WF_Sinewave, #WF_SawTooth, #WF_BuzzSaw, #WF_SquareWave, #WF_Triangle, #WF_Chunosta, #WF_Organ, #WF_Noise, #WF_GuidedNoise }
    ; fadeIn    { turns the fadeIn  effect on/off.  Default (0) = off , (1) = on }
    ; fadeOut   { turns the fadeOut effect on/off.  Default (0) = off , (1) = on }
   
   
    Protected Kontrolle.w
    Protected Output.i = 0
    Protected *buffer
   
    Protected wNc.w
    Protected lFr.l
    Protected wBy.w
    Protected wBa.w
    Protected doSweep.w
   
    Protected fPIx2.f = #PI * 2
    Protected fHalfPI.f = #PI / 2
   
    Protected Fade.w
   
    Protected *audioStart
    Protected *n
    Protected audBuffSize.i
    Protected *audBuffEnd
   
    Protected byteCount.l
   
    Protected.w Rvalue, Lvalue ; waveform magnitude at any instant in time
    Protected.f angStp         ; angle step size in radians
    Protected.f ang , Lang     ; starting angle (radians)
    Protected.f phase          ; Phase zwischen rechten und linken Kanal
    Protected.i loops          ; number of loop iterations
    Protected.i loopCount      ; loop counter
    Protected.f lastVal, bias  ; used for guided noise
   
    Protected.f frequencyStep, frequencyThisInstant, frequencySpan, averageFrequency
    Protected sf.f
   
   
   
    doSweep = #False
    If sweepStop > 0.1
      doSweep = #True
    EndIf
   
   
    frequency = CHKFreqency(frequency)
    amplitude = CHKAmplitude(amplitude)
    duration  = CHKDuration(duration)
    FadeIn    = CHKFade(FadeIn)
    FadeOut   = CHKFade(FadeOut)
    sweepStop = CHKSweepstop(sweepStop)
   
    *buffer = InitAudioBuffer(duration)
    If *buffer = 0
      Kontrolle = #DS_Abbruch
      Debug "darf net sein"
     
    EndIf
   
   
    If *buffer <> 0
     
      wNc.w = PeekW(*buffer + 22)   ; Nc {is number of channels}
      lFr.l = PeekL(*buffer + 24)   ; Fr {is samples per second}
      wBy.w = PeekW(*buffer + 34)/8 ; By {is bytes per sample (1 = 8 bits, 2 = 16 bits)}; !!!!!!!!
     
      wBa = wNc * wBy               ; block align (bytes per block)
     
      If wBa = 0                    ;???
        wBa = 8
      EndIf 
     
      ; tweak frequency so waveform loops without glitches
      frequency = Round(frequency * duration,#PB_Round_Nearest)/duration
     
      Fade = FadeIn | FadeOut << 1  ; Fade = 1 Fadein , Fade = 2 FadeOut
     
      *audioStart = *buffer + 44 ; pointer to the first audio data byte
      *n = *audioStart
      audBuffSize = MemorySize(*buffer) ; number of bytes in sound buffer
      *audBuffEnd = *buffer + audBuffSize - 1 ; pointer to last byte in buffer
     
      ; calculate the number of audio bytes
     
      byteCount.l = lFr * wBy * wNc * duration
     
      If byteCount & 1
        byteCount + 1
      EndIf ; byteCount must be even number
     
      PokeL(*buffer + 40, byteCount)
      Debug "bytecount :"+Str(bytecount)
     
      angStp = frequency / lFr * fPIx2 ; angle step size in radians
      ang = 0                          ; starting angle (radians)
      loops = byteCount / wBa          ; number of loop iterations
      loopCount = 0                    ; loop counter
     
      If doSweep = #True
        ; linear sweep
        averageFrequency = (frequency + sweepStop) / 2
        averageFrequency = Round(averageFrequency * duration, #PB_Round_Nearest) / duration
        sweepStop = 2 * averageFrequency - frequency
       
        frequencySpan = sweepStop - frequency
        frequencyStep = frequencySpan / loops
      EndIf
     
     
      ; if waveform formulas produce Rvalues from -1 to +1 use this scale factor
     
      sf.f = (Pow(2,8 * wBy)/2 - 1) * (amplitude / 100)
     
     
     
      ; adjustments for other waveforms
      Select waveform
        Case #WF_Chunosta
          sf = sf * (1/(Sin(ACos(1/Sqr(3)))*Sin(2*ACos(1/Sqr(3)))))
          ang + (#PI/2)
        Case #WF_Organ
          sf = sf / 2.25
        Case #WF_GuidedNoise
          sf = sf / 2
        Case #WF_Triangle
          ang = ang + (#PI/2)
        Case #WF_SawTooth, #WF_BuzzSaw
          ang = ang + #PI
        Case #WF_SineWave
         
        Case  #WF_SquareWave ; funzt
         
        Case #WF_Noise
         
          ;         Default
          ;           Kontrolle = #DS_Abbruch; waveform was invalid
      EndSelect
     
      phase = 1.15
     
     
      If Kontrolle <> #DS_Abbruch   
       
        While loopCount < loops
          ; Rechts
          Select waveform
            Case #WF_SineWave
              Rvalue = Sin(ang) * sf
            Case #WF_SawTooth
              Rvalue = (ang-#PI) / #PI * sf
            Case #WF_BuzzSaw
              Rvalue = Pow(Abs((ang-#PI)/#PI), #PI) * Sign(ang-#PI) * sf
            Case #WF_SquareWave
              Rvalue = Sign(#PI-ang) * sf
            Case #WF_Triangle
              Rvalue = ((ang-#PI)/(#PI/2) * Sign(#PI-ang) + 1) * sf
            Case #WF_Chunosta
              Rvalue = Sin(ang) * Sin(2*ang) * sf
            Case #WF_Organ
              Rvalue = (Sin(ang) +  Sin(2*ang ) + Sin(4*ang )) * sf ;
            Case #WF_Noise
              Rvalue = sf * (((Random($7FFFFFFD)+1) / $40000000) - 1)
            Case #WF_GuidedNoise
              bias = (Sin(ang) - lastVal) * 0.5
              lastVal = lastVal + ((Random($7FFFFFFD) / $40000000) - 1) + bias
              Rvalue = lastVal * sf
             
          EndSelect
         
          ; links
          Lang = ang + phase
          Select waveform
            Case #WF_SineWave
              Lvalue = Sin(Lang) * sf
            Case #WF_SawTooth
              Lvalue = (Lang-#PI) / #PI * sf
            Case #WF_BuzzSaw
              Lvalue = Pow(Abs((Lang-#PI)/#PI), #PI) * Sign(Lang-#PI) * sf
            Case #WF_SquareWave
              Lvalue = Sign(#PI-Lang) * sf
            Case #WF_Triangle
              Lvalue = ((Lang-#PI)/(#PI/2) * Sign(#PI-Lang) + 1) * sf
            Case #WF_Chunosta
              Lvalue = Sin(Lang) * Sin(2*Lang) * sf
            Case #WF_Organ
              Lvalue = (Sin(ang) + 0.5 * Sin(2*ang ) + 0.25 * Sin(4*ang )) * sf ;
            Case #WF_Noise
              Lvalue = sf * (((Random($7FFFFFFD)+1) / $40000000) - 1)
            Case #WF_GuidedNoise
              bias = (Sin(Lang) - lastVal) * 0.5
              lastVal = lastVal + ((Random($7FFFFFFD) / $40000000) - 1) + bias
              Lvalue = lastVal * sf
             
          EndSelect
         
         
          Select Fade
            Case %01 ; fade in
              Rvalue = Rvalue * (0.0 + loopCount / loops)
            Case %10 ; fade out
              Rvalue = Rvalue * (1.0 - loopCount / loops)
            Case %11 ; fade in & fade out
              Rvalue = Rvalue << 2 * (1.0 - loopCount / loops) * (loopCount / loops)
          EndSelect
         
         
          Select wBy
            Case 1 ; 8 bits/sample
              PokeA(*n, Rvalue+$80) ; left/mono
              If wNc = 2            ; stereo
                PokeW(*n+1, Lvalue+$80) ; right
              EndIf
            Case 2 ; 16 bits/sample
              PokeW(*n, Rvalue) ; left/mono
              If wNc = 2        ; stereo
                PokeW(*n+2,Lvalue) ; right
              EndIf
            Default
              PokeW(*n, Rvalue+$80) ; left/mono
              If Nc = 2             ; stereo
                PokeW(*n+1, Lvalue+$80) ; right
              EndIf
          EndSelect 
         
          If doSweep
            frequencyThisInstant = loopCount * frequencyStep + frequency
            angStp = frequencyThisInstant / lFr * fPIx2
          EndIf
         
          ang = ang + angStp
          If ang > fPIx2
            ang = ang - fPIx2 
          EndIf
         
          *n = *n + wBa ; point to the next audio sample
         
          If *n > *audBuffEnd
            Break
          EndIf
         
          loopCount + 1
        Wend
        Output =  CatchSound(soundNum, *buffer)
        Debug "Memorysize " + Str(Av)
      Else
        Debug "Kontrolle schlägt zu"
       
      EndIf
    Else 
      Debug "Buffer funzt nicht"
    EndIf 
   
   
    ProcedureReturn Output ; Handle
   
  EndProcedure
 
EndModule


Vielleicht brauchbar..

Grüße
LN

_________________
https://www.doerpsoft.org

Boost. Work. Efficiency.

AMD-Krücke mit Lubuntu-18.04 / iCore7 mit Win10-64


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 1 Beitrag ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye