BeepSound Engine (aka QB-Playmusic)

[Kekskiller]

Brauchte heute einen schönen BeepSound Generator wie in QB, nur ohne DX-Sounds. Daher habe ich mir den Beep-Befehl zunutze gemacht und was ganz hübsches gezaubert. Naja, zwar nicht ganz wie in QB (keine Stringübergabe), aber dennoch ganz witzig.

Code: Alles auswählen

Structure BeepSound
  beeps.b
  beepmem.l
  playing.b
  playpos.l
EndStructure

Dim BeepSounds.BeepSound(255)

Procedure CreateBeepSound(sound.l, beeps.b) ; Creates a BeepSound
  BeepSounds(sound)\beeps = beeps
  BeepSounds(sound)\beepmem = AllocateMemory(4 * 2 * beeps)
EndProcedure

Procedure ModifyBeep(sound.l, beep.b, freq.l, duration.l) ; Modifies a Beep Sound
  If BeepSounds(sound)\beepmem
    pos = BeepSounds(sound)\beepmem + 4 * 2 * beep
    PokeL(pos, freq)
    PokeL(pos + 4, duration)
  EndIf
EndProcedure

Procedure FreeBeepSound(sound) ; Frees a Beep Sound
  If BeepSounds(sound)\beepmem
    FreeMemory(BeepSounds(z)\beepmem)
  EndIf
EndProcedure

Procedure BeepSoundCallBack() ; Thats the Beep Sound Updater - the CallBack
  For z = 0 To 255
    If BeepSounds(z)\playing
      freq = PeekL(BeepSounds(z)\beepmem + BeepSounds(z)\playpos)
      duration = PeekL(BeepSounds(z)\beepmem + BeepSounds(z)\playpos + 4)
      Beep_(freq, duration)
      BeepSounds(z)\playpos + 8
      If BeepSounds(z)\playpos => 4 * 2 * BeepSounds(z)\beeps
        BeepSounds(z)\playing = 0
        BeepSounds(z)\playpos = 0
      EndIf
    EndIf
  Next
EndProcedure

Procedure PlayBeepSound(sound, startbeep) ; Plays a Beep Sound
  BeepSounds(sound)\playing = 1
  BeepSounds(sound)\playpos = 4 * 2 * startbeep
EndProcedure

Procedure StopBeepSound(sound) ; Stops a played Beep Sound
  BeepSounds(sound)\playing = 0
EndProcedure

Procedure  ResumeBeepSound(sound) ; Resumes a stopped Beep Sound
  BeepSounds(sound)\playing = 1
EndProcedure

Procedure IsBeepSoundPlaying(sound) ; Checks if a Beep Sound is playing
  ProcedureReturn BeepSounds(sound)\playing
EndProcedure

Procedure CopyBeepSound(sound, copy) ; Copies a Beep Sound from sound to copy
  BeepSounds(copy)\beeps = BeepSounds(sound)\beeps
  BeepSounds(copy)\beepmem = CopyMemory(BeepSounds(sound)\beepmem, BeepSounds(copy)\beepmem, 4 * 2 * BeepSounds(sound)\beeps)
  BeepSounds(copy)\playing = BeepSounds(sound)\playing
  BeepSounds(copy)\playpos = BeepSounds(sound)\playpos
EndProcedure

Procedure IsAnySoundPlaying()
  Protected p.l
  For z = 0 To 255
    p + BeepSounds(copy)\playing
  Next
  If p = 0
    ProcedureReturn 0
  Else
    ProcedureReturn 1
  EndIf
EndProcedure

Code: Alles auswählen

reateBeepSound(sound.l, beeps.b) ; Creates a BeepSound
ModifyBeep(sound.l, beep.b, freq.l, duration.l) ; Modifies a Beep Sound
FreeBeepSound(sound) ; Frees a Beep Sound
BeepSoundCallBack() ; Thats the Beep Sound Updater - the CallBack
PlayBeepSound(sound, startbeep) ; Plays a Beep Sound
StopBeepSound(sound) ; Stops a played Beep Sound
ResumeBeepSound(sound) ; Resumes a stopped Beep Sound
IsBeepSoundPlaying(sound) ; Checks if a Beep Sound is playing
CopyBeepSound(sound, copy) ; Copies a Beep Sound from sound to copy
IsAnySoundPlaying() ; Checks playing Sounds

Man erstellt einen BeepSound mit bestimmt vielen Beeps drinne und kann jeden dieser Beeps einzeln verändern. Ganz praktisch, wenn mal was Retro-mäßiges machen will.

Das einzige, was man in die Heutpschleife machen muss, ist das BeepSoundCallBack(). Am besten in einem Thread starten, so ist unabhängig von der Hautpschleife nutzbar.

Leider hält Windows beim Beep-Abspiele das ganze Programm an, daher sind mehr als 3 Sounds auf einmal meist geschwindigkeitshemmend ; Zumindest stärkt das das Retrogefühl von alten Prozessoren

[hardfalcon]

Ne Techdemo für faule leuten wie mich wäre nicht schlecht...

[Kekskiller]

Wie du willst... glaube ich stelle das dann nochmal aus *g*
http://kekskiller.cybton.com/bigshot.zip
Alle Sounds wurden per BeepSpund generiert, das genügt glaube ich fürs erste.

Edit: Mit Rechtsklick beenden, mit Alt das Menu aufrufen und Sachen auswählen...