the-maze/play.bas
File Type: text/x-c
' QB-style PLAY (MML) via SDL2 — non-blocking square-wave tones.
' Subset aimed at the original maze strings: L, O, A–G (plus T/P/>/< for completeness).
' Each Play() clears any still-queued audio (monophonic / PC-speaker style) and
' returns immediately while SDL drains the new phrase in the background.
#lang "fb"
#include once "SDL2/SDL.bi"
Const PLAY_SAMPLE_RATE As Integer = 22050
Const PLAY_DEFAULT_TEMPO As Integer = 120
' QB default when a string omits O (QBasic help: default octave is 4).
Const PLAY_DEFAULT_OCTAVE As Integer = 4
Const PLAY_DEFAULT_LENGTH As Integer = 4
' S16 peak amplitude (keep modest; square waves are harsh at full scale).
Const PLAY_AMPLITUDE As Integer = 9000
' Classic MN articulation: tone for 7/8 of the note, silence for 1/8.
Const PLAY_TONE_NUM As Integer = 7
Const PLAY_TONE_DEN As Integer = 8
' QB PLAY: "Octave 3 starts with middle C." We map that to MIDI 60 / A4=440.
' PLAY_OCTAVE_SHIFT is added to every MML octave (and the default): +1 raises
' all pitches one octave, -1 lowers. Tweak here if the PC-speaker character
' still feels off on modern output.
Const PLAY_OCTAVE_SHIFT As Integer = 0
Dim Shared As SDL_AudioDeviceID playDevice = 0
Dim Shared As Integer playSampleRate = PLAY_SAMPLE_RATE
Dim Shared As Boolean playReady = False
' Runtime override of PLAY_OCTAVE_SHIFT (InitAudio resets to the const).
Dim Shared As Integer playOctaveShift = PLAY_OCTAVE_SHIFT
Declare Sub InitAudio ()
Declare Sub ShutdownAudio ()
Declare Sub Play (ByVal cmd As String)
Declare Sub SetPlayOctaveShift (ByVal shift As Integer)
Declare Function GetPlayOctaveShift () As Integer
Declare Function PlayReadNumber (ByRef cmd As String, ByRef i As Integer) As Integer
Declare Function PlayNoteHz (ByVal octave As Integer, ByVal semisFromC As Integer) As Double
Declare Sub PlayTone (ByVal hz As Double, ByVal durationSec As Double)
Declare Sub PlaySilence (ByVal durationSec As Double)
Declare Sub PlayQueueSamples (ByVal samples As Short Ptr, ByVal count As Integer)
Sub InitAudio ()
playReady = False
playDevice = 0
playOctaveShift = PLAY_OCTAVE_SHIFT
If SDL_Init(SDL_INIT_AUDIO) <> 0 Then
Exit Sub
End If
Dim As SDL_AudioSpec want, have
SDL_zero(want)
SDL_zero(have)
want.freq = PLAY_SAMPLE_RATE
want.format = AUDIO_S16SYS
want.channels = 1
want.samples = 512
want.callback = 0
want.userdata = 0
playDevice = SDL_OpenAudioDevice(0, 0, @want, @have, 0)
If playDevice = 0 Then
SDL_QuitSubSystem(SDL_INIT_AUDIO)
Exit Sub
End If
playSampleRate = have.freq
If playSampleRate <= 0 Then playSampleRate = PLAY_SAMPLE_RATE
SDL_PauseAudioDevice(playDevice, 0)
playReady = True
End Sub
Sub ShutdownAudio ()
If playDevice <> 0 Then
SDL_ClearQueuedAudio(playDevice)
SDL_PauseAudioDevice(playDevice, 1)
SDL_CloseAudioDevice(playDevice)
playDevice = 0
End If
If playReady Or SDL_WasInit(SDL_INIT_AUDIO) <> 0 Then
SDL_QuitSubSystem(SDL_INIT_AUDIO)
End If
playReady = False
End Sub
' Raise (+) or lower (-) all MML pitches by whole octaves. 0 = QB mapping.
Sub SetPlayOctaveShift (ByVal shift As Integer)
playOctaveShift = shift
End Sub
Function GetPlayOctaveShift () As Integer
GetPlayOctaveShift = playOctaveShift
End Function
' Parse and queue a QB PLAY string. Returns immediately; audio plays in the
' background. A new Play cuts off any previous phrase still in the queue.
' No-op if audio is unavailable or cmd is empty.
Sub Play (ByVal cmd As String)
If Not playReady OrElse Len(cmd) = 0 Then Exit Sub
' Monophonic: drop whatever was still playing so SFX don't stack up.
SDL_ClearQueuedAudio(playDevice)
Dim As Integer tempo = PLAY_DEFAULT_TEMPO
Dim As Integer octave = PLAY_DEFAULT_OCTAVE
Dim As Integer noteLen = PLAY_DEFAULT_LENGTH
Dim As Integer i = 1
Dim As Integer n, dots, semis
Dim As Double beats, durationSec, hz
Dim As String ch
Do While i <= Len(cmd)
ch = UCase(Mid(cmd, i, 1))
i += 1
Select Case ch
Case " ", Chr(9)
' ignore whitespace
Case "T"
n = PlayReadNumber(cmd, i)
If n > 0 Then tempo = n
Case "L"
n = PlayReadNumber(cmd, i)
If n > 0 Then noteLen = n
Case "O"
n = PlayReadNumber(cmd, i)
If n >= 0 Then octave = n
Case ">"
octave += 1
Case "<"
octave -= 1
Case "P"
n = PlayReadNumber(cmd, i)
If n <= 0 Then n = noteLen
dots = 0
Do While i <= Len(cmd) AndAlso Mid(cmd, i, 1) = "."
dots += 1
i += 1
Loop
beats = 4.0 / n
Do While dots > 0
beats *= 1.5
dots -= 1
Loop
durationSec = (60.0 / tempo) * beats
PlaySilence durationSec
Case "A" To "G"
Select Case ch
Case "C": semis = 0
Case "D": semis = 2
Case "E": semis = 4
Case "F": semis = 5
Case "G": semis = 7
Case "A": semis = 9
Case "B": semis = 11
End Select
' Optional sharp/flat
If i <= Len(cmd) Then
Select Case Mid(cmd, i, 1)
Case "#", "+"
semis += 1
i += 1
Case "-"
semis -= 1
i += 1
End Select
End If
n = PlayReadNumber(cmd, i)
If n <= 0 Then n = noteLen
dots = 0
Do While i <= Len(cmd) AndAlso Mid(cmd, i, 1) = "."
dots += 1
i += 1
Loop
beats = 4.0 / n
Do While dots > 0
beats *= 1.5
dots -= 1
Loop
durationSec = (60.0 / tempo) * beats
hz = PlayNoteHz(octave, semis)
PlayTone hz, durationSec
Case Else
' Skip unknown commands (M*, N, etc.) rather than aborting the phrase.
End Select
Loop
' Return without waiting — SDL plays the queued samples asynchronously.
End Sub
Function PlayReadNumber (ByRef cmd As String, ByRef i As Integer) As Integer
Dim As Integer n = 0
Dim As Boolean anyDigit = False
Dim As String ch
Do While i <= Len(cmd)
ch = Mid(cmd, i, 1)
If ch < "0" Or ch > "9" Then Exit Do
n = n * 10 + (Asc(ch) - Asc("0"))
anyDigit = True
i += 1
Loop
If anyDigit Then
PlayReadNumber = n
Else
PlayReadNumber = -1
End If
End Function
' Equal temperament, QB octave numbering + playOctaveShift.
' O3 C → MIDI 60 (middle C) when shift is 0; O3 A → 440 Hz.
Function PlayNoteHz (ByVal octave As Integer, ByVal semisFromC As Integer) As Double
Dim As Integer effectiveOctave = octave + playOctaveShift
' (octave + 2)*12 + semis: O3 C = 60, O3 A = 69
Dim As Integer midi = (effectiveOctave + 2) * 12 + semisFromC
PlayNoteHz = 440.0 * (2.0 ^ ((midi - 69) / 12.0))
End Function
Sub PlayQueueSamples (ByVal samples As Short Ptr, ByVal count As Integer)
If count <= 0 Or samples = 0 Then Exit Sub
SDL_QueueAudio(playDevice, samples, cast(Uint32, count * SizeOf(Short)))
End Sub
Sub PlaySilence (ByVal durationSec As Double)
If durationSec <= 0 Then Exit Sub
Dim As Integer count = CInt(durationSec * playSampleRate)
If count <= 0 Then Exit Sub
Dim As Short Ptr buf = Allocate(count * SizeOf(Short))
If buf = 0 Then Exit Sub
Dim As Integer i
For i = 0 To count - 1
buf[i] = 0
Next i
PlayQueueSamples buf, count
Deallocate buf
End Sub
' Square-wave tone with MN-style gap and tiny edge fades to soften clicks.
Sub PlayTone (ByVal hz As Double, ByVal durationSec As Double)
If durationSec <= 0 Then Exit Sub
Dim As Integer total = CInt(durationSec * playSampleRate)
If total <= 0 Then Exit Sub
Dim As Integer toneCount = (total * PLAY_TONE_NUM) \ PLAY_TONE_DEN
If toneCount < 1 AndAlso hz > 0 Then toneCount = total
Dim As Short Ptr buf = Allocate(total * SizeOf(Short))
If buf = 0 Then Exit Sub
Dim As Integer i, fade
Dim As Double phase = 0.0
Dim As Double phaseStep = 0.0
Dim As Short amp
If hz > 0 AndAlso playSampleRate > 0 Then
phaseStep = hz / playSampleRate
End If
fade = playSampleRate \ 500 ' ~2 ms
If fade < 1 Then fade = 1
If fade * 2 > toneCount Then fade = toneCount \ 4
If fade < 1 Then fade = 1
For i = 0 To toneCount - 1
If hz <= 0 Or phaseStep <= 0 Then
amp = 0
Else
' Square: high for first half-cycle
If phase < 0.5 Then
amp = PLAY_AMPLITUDE
Else
amp = -PLAY_AMPLITUDE
End If
phase += phaseStep
If phase >= 1.0 Then phase -= 1.0
End If
' Linear fade in/out
If i < fade Then
amp = CShort((CInt(amp) * (i + 1)) \ fade)
ElseIf i >= toneCount - fade Then
amp = CShort((CInt(amp) * (toneCount - i)) \ fade)
End If
buf[i] = amp
Next i
For i = toneCount To total - 1
buf[i] = 0
Next i
PlayQueueSamples buf, total
Deallocate buf
End Sub