If it sounds too good to be true, then don't be a sucker.
Bohgosity BumaskiL
synth lead-in.
' -CC- Released in a creative commons.
' -BY- BrewJay's Babble Bin
' -NC- Copies on optical disk without my permission must be gifts.
' I understand some commercial uses implied by internet service.
' I can extend that permission, and I will probably do that
without fee.
' -ND- Recordings are mine; Performance is not.
' left part, basis frequency, right part, fundamental frequency.
DATA 1,15,2,15
' Data: Part One, Part Two, Length...
' (Ignoring zeros after first one)
' Name of Jump on Left Channel, Right Channel, Concert Ratio...
' Most names come from http://www.huygens-fokker.org/docs/intervals.html
DATA 0, 0, 2
DATA 6, 12, 6
' Octave
DATA 9, 10, 6
' Perfect Fifth, Minor Third, Minor Second
DATA 12, 6, 12
' Perfect Fourth, Major Sixth, Octave
DATA 11, 9, 12
' Undecimal Neutral Second, Perfect Fifth, Undecimal Neutral Third
DATA 8, 15, 6
' Undecimal Semi-augmented Fourth, Major Sixth, Classic Major Seventh
DATA 9, 13, 6
' Major Second, Tridecimal 5/4-tone, Tridecimal Diminished Fifth
DATA 12, 8, 12
' Perfect Fourth, Tridecimal Neutral Sixth, Perfect Fifth
DATA 8, 9, 12
DATA 0, 0, 6
DATA 6, 8, 6
' Perfect Fourth, Major Second, Perfect Fourth
DATA 12, 15, 9
' Octave, Classic Major Seventh, Major Third
DATA 11, 13, 6
' Undecimal Neutral Second, Tridecimal 5/4-tone,
' Tridecimal Minor Third
DATA 8, 10, 6
' Undecimal Semi-Augmented Fourth, Tridecimal Semi-diminished Fourth,
' Major Third
DATA 12, 8, 6
' Perfect Fifth, Major Third, Perfect Fifth
DATA 6, 12, 12
' Octave, Perfect Fifth, Octave
DATA 0, 0, 30
OPTION BASE 1
DIM TwoPi AS DOUBLE
DIM pi AS DOUBLE
DIM Temp AS DOUBLE
DIM BeatsPerSecond AS DOUBLE
DIM Angle(4) AS DOUBLE
DIM Velocity(4) AS DOUBLE
DIM Acceleration(4) AS DOUBLE
DIM Phase(4) AS DOUBLE
DIM note(4) AS INTEGER
DIM LastNote(4) AS INTEGER
DIM length AS INTEGER
DIM Harmonics(4) AS SINGLE
DIM Samples AS LONG
DIM t AS LONG
DIM SampleRate AS LONG
DIM k AS INTEGER
DIM g AS INTEGER
DIM amp AS INTEGER
DIM basis AS INTEGER
DIM NumHarmonics AS INTEGER
DIM part(4) AS INTEGER
DIM Sign(4) AS INTEGER
DIM glide AS INTEGER
DIM GlideTrim AS LONG
DIM test AS STRING
DIM TerminalAngle(4) AS DOUBLE
DIM DropAngle(4) AS DOUBLE
DIM PhaseDir(4) AS DOUBLE
PRINT
test = "0"
' I frequently flip that.
NumHarmonics = 2
BeatsPerSecond = 18
pi = 3.141592653589793#
TwoPi = pi * 2
SampleRate = 44100
IF test = "0" THEN
OPEN "sucker.bat" FOR OUTPUT AS #1
OPEN "\sox\sucker.raw" FOR OUTPUT AS #4
PRINT #1, "e:\progra~1\freebasic\fbc -lang qb d:\basic\sucker.bas"
PRINT #1, "sucker.exe"
PRINT #1, "cd \sox"
PRINT #1, "sox -c 2 -r"; SampleRate; " -sw sucker.raw sucker.wav
stat"
CLOSE #1, #2
END IF
FOR k = 1 TO NumHarmonics
READ part(k), Harmonics(k)
note(k) = 0
LastNote(k) = 0
NEXT k
' OPEN "sucker.bas" FOR APPEND AS #2
glide = 30
100
FOR g = 1 TO 17
READ note(1), note(2), length
' PRINT #2, USING "DATA ##-,##-,##"; CINT(note(1) * 9 / 8);
CINT(note(2) * 9 / 8); length
IF g > 0 THEN
' SOUND note(2) * 15, length
END IF
IF test = "0" THEN
IF note(1) = 0 AND LastNote(1) = 0 THEN
Samples = SampleRate * length / BeatsPerSecond
GOSUB 300
GOTO 75
END IF
IF note(1) = 0 AND LastNote(1) <> 0 THEN
GOSUB 250
FOR k = 1 TO NumHarmonics
LastNote(k) = note(k)
NEXT k
Samples = SampleRate * length / BeatsPerSecond
GOSUB 300
GOTO 75
END IF
IF LastNote(1) = 0 AND note(1) <> 0 THEN
FOR k = 1 TO NumHarmonics
LastNote(k) = note(k)
NEXT k
Samples = SampleRate * length / BeatsPerSecond
GOSUB 275
GOTO 75
END IF
IF note(1) <> 0 AND LastNote(1) <> 0 THEN
Samples = SampleRate * length / BeatsPerSecond /
glide
GlideTrim = Samples
GOSUB 300
Samples = SampleRate * length / BeatsPerSecond -
GlideTrim
FOR k = 1 TO NumHarmonics
LastNote(k) = note(k)
NEXT k
GOSUB 300
GOTO 75
END IF
END IF
75 NEXT g
CLOSE #4
END
' *Neat* Silencer -- finishes a wave like 275 starts one.
' When it reaches a peak or a trough, then it cuts amplitude in half
' and biases it by half.
250
FOR k = 1 TO NumHarmonics
Temp = Angle(k) / TwoPi
Angle(k) = (Temp - FIX(Temp)) * TwoPi
IF Angle(k) > pi * 3 / 2 THEN
TerminalAngle(k) = pi * 3.5
PhaseDir(k) = 1
DropAngle(k) = pi * 2.5
ELSEIF Angle(k) > pi / 2 THEN
TerminalAngle(k) = pi * 2.5
PhaseDir(k) = 0
DropAngle(k) = pi * 3 / 2
ELSE
TerminalAngle(k) = pi * 3 / 2
PhaseDir(k) = -1
DropAngle(k) = pi / 2
END IF
NEXT k
260
FOR k = 1 TO NumHarmonics
Phase(k) = SIN(Angle(k))
SELECT CASE PhaseDir(k)
CASE 1
IF Angle(k) >= DropAngle(k) THEN
Phase(k) = Phase(k) / 2 + .5
END IF
CASE 0
IF Angle(k) >= DropAngle(k) THEN
Phase(k) = Phase(k) / 2 - .5
END IF
CASE -1
IF Angle(k) >= DropAngle(k) THEN
Phase(k) = Phase(k) / 2 + .5
END IF
END SELECT
IF Angle(k) < TerminalAngle(k) THEN
Angle(k) = Angle(k) + Velocity(k)
ELSE
Angle(k) = TerminalAngle(k)
END IF
NEXT k
GOSUB 400
FOR k = 1 TO NumHarmonics
IF Angle(k) < TerminalAngle(k) THEN GOTO 260
NEXT k
FOR k = 1 TO NumHarmonics
Angle(k) = Angle(k) - Angle(k)
NEXT k
RETURN
275
' This starts a wave from zero, using half the amplitude, a start
' from where sin(angle) = -1, and a bias of half. This cuts
' a leading click that I can hear on some equipment with some tunes.
FOR k = 1 TO NumHarmonics
IF part(k) <> 0 THEN
Velocity(k) = TwoPi * LastNote(part(k)) * Harmonics(part(k))
/ SampleRate
Acceleration(k) = (TwoPi * note(part(k)) *
Harmonics(part(k)) / SampleRate -
Velocity(k)) / Samples
ELSE
Velocity(k) = TwoPi * note(k) * Harmonics(k) / SampleRate
Acceleration(k) = 0
END IF
PhaseDir(k) = 1
Angle(k) = 3 / 2 * pi
NEXT k
280
FOR k = 1 TO NumHarmonics
IF PhaseDir(k) = 1 THEN
Phase(k) = SIN(Angle(k)) / 2 + .5
ELSE
Phase(k) = SIN(Angle(k))
END IF
Angle(k) = Angle(k) + Velocity(k)
Velocity(k) = Velocity(k) + Acceleration(k)
NEXT k
Samples = Samples - 1
GOSUB 400
FOR k = 1 TO NumHarmonics
IF PhaseDir(k) = 1 THEN
Phase(k) = (Phase(k) - .5) * 2
END IF
IF Phase(k) > SIN(Angle(k)) THEN
PhaseDir(k) = -1
END IF
NEXT k
FOR k = 1 TO NumHarmonics
IF PhaseDir(k) = 1 GOTO 280
NEXT k
300
' Calculate constants of change for write loop.
FOR k = 1 TO NumHarmonics
Velocity(k) = TwoPi * LastNote(part(k)) * Harmonics(k) / SampleRate
Acceleration(k) = (TwoPi * note(part(k)) * Harmonics(k) /
SampleRate - Velocity(k)) /
Samples
NEXT k
' Main write loop. Static Phases problem solved at 250.
FOR t = 1 TO Samples
FOR k = 1 TO NumHarmonics
Phase(k) = SIN(Angle(k))
NEXT k
GOSUB 400
FOR k = 1 TO NumHarmonics
Angle(k) = Angle(k) + Velocity(k)
Velocity(k) = Velocity(k) + Acceleration(k)
NEXT k
NEXT t
RETURN
400
' Write a sample.
amp = CINT(Phase(1) * 31700)
PRINT #4, CHR$(amp AND 255);
PRINT #4, CHR$((amp AND 65280) / 256);
amp = CINT(Phase(2) * 31700)
PRINT #4, CHR$(amp AND 255);
PRINT #4, CHR$((amp AND 65280) / 256);
RETURN
Bohgosity BumaskiL
' http://ecn.ab.ca/~brewhaha/Sound/Sucker.mp3
' -CC- Released in a creative commons.
' -BY- BrewJay's Babble Bin
' -NC- Copies on optical disk without my permission must be gifts.
' I will probably do that for no fee.
' -ND- Recordings are mine: Performance is not.
' left part, basis frequency, right part, fundamental frequency.
DATA 1,9,2,9
' Ignoring zeros (pauses) after first one, on three lines the comments go:
' Name of Jump on Left Channel
' Name of jump on Right Channel
' Concert Ratio...
' Most names come from http://www.huygens-fokker.org/docs/intervals.html
' The Seventh harmonic is 7:1, though.
' Data: Part One, Part Two, Length...
DATA 0, 0, 2
DATA 9, 22, 9
' Obscure. Undecimal neutral eleventh?
DATA 11, 16, 6
' Undecimal neutral third
' Undecimal semi-augmented fourth
' Undecimal semi-diminished fifth
DATA 14, 11, 12
' Undecimal diminished fourth
' undecimal semi-diminished fifth
' undecimal diminished fourth
DATA 12, 16, 6
' Septimal minor third
' Undecimal semi-diminished fifth
' Perfect fourth.
DATA 11, 28, 6
' Undecimal neutral second
' Septimal seventh
' Obscure.
DATA 0, 0, 3
' Rest.
DATA 9, 22, 6
' Undecimal neutral third
' Undecimal diminished fourth
' Undecimal neutral eleventh? See 11:9.
DATA 7, 14, 12
' Septimal minor third
' Undecimal augmented fifth
' Octave
DATA 9, 18, 12
' Septimal minor third
' Septimal minor third
' Octave
DATA 0, 0, 3
DATA 10, 20, 6
' Minor whole tone
' Minor whole tone
' Octave
DATA 14, 22, 9
' Septimal tritone
' Ptolemy's second
' Undecimal augmented fifth
DATA 10, 15, 9
' Septimal tritone
' Undecimal diminished fifth
' Perfect fifth
DATA 11, 18, 3
' Ptolemy's second
' Minor third
' Undecimal neutral sixth
DATA 14, 22, 6
' Undecimal diminished fourth
' Undecimal neutral third
' Undecimal augmented fifth
DATA 11, 11, 12
' Undecimal diminished fourth
' Octave
' Unison
DATA 0, 0, 30
' The remainder of this message is public domain.
' In many places a line break due to limits on
' USENET will break BASIC syntax.
BeatsPerSecond = 17
pi = 3.141592653589793#
TwoPi = pi * 2
SampleRate = 8000
' This is where I assume where you hav sound exchange installed.
' It makes a batch file that makes testing the harmony easier.
IF test = "0" THEN
OPEN "sucker.bat" FOR OUTPUT AS #1
OPEN "\sox\sucker.raw" FOR OUTPUT AS #4
PRINT #1, "e:\progra~1\freebasic\fbc -lang qb d:\basic\sucker.bas"
PRINT #1, "sucker.exe"
PRINT #1, "cd \sox"
PRINT #1, "sox -c 2 -r"; SampleRate; " -sw sucker.raw sucker.wav
stat"
CLOSE #1, #2
END IF
FOR k = 1 TO NumHarmonics
READ part(k), Harmonics(k)
note(k) = 0
LastNote(k) = 0
NEXT k
' OPEN "sucker.bas" FOR APPEND AS #2
' That is for re-writing data that has been scaled (transposed).
glide = 30
100
FOR g = 1 TO 18
READ note(1), note(2), length
' PRINT #2, USING "DATA ##-,##-,##"; CINT(note(1) * 9 / 8);
CINT(note(2) * 9 / 8); length
' This is also for re-writing scaled data (transposition).
IF g > 0 THEN
' SOUND note(1) * 9, length
' If you hav M$ basic or FirstBasic (shareware),
' then you can comment that in for real-time testing.
END
' This is another part of a silencer that
' avoids a heavyside-function thud.
Samples
NEXT k
' Main write loop.
FOR t = 1 TO Samples
FOR k = 1 TO NumHarmonics
Phase(k) = SIN(Angle(k))
NEXT k
GOSUB 400
FOR k = 1 TO NumHarmonics
Angle(k) = Angle(k) + Velocity(k)
Velocity(k) = Velocity(k) + Acceleration(k)
NEXT k
NEXT t
RETURN
400
' Write a sample.
amp = CINT(Phase(1) * 32700)
PRINT #4, CHR$(amp AND 255);
PRINT #4, CHR$((amp AND 65280) / 256);
amp = CINT(Phase(2) * 32700)
PRINT #4, CHR$(amp AND 255);
PRINT #4, CHR$((amp AND 65280) / 256);
RETURN
' It was a lot more work than I thot it was going
' to be to write a synthesizer with neater output
' than sound exchange. The neat part of it is
' only that it entirely fits in a 10k USENET post,
' unless it's a symphony (50k is a more common limit).