smurfy.bas

[Bohgosity BumaskiL]

' This is part of a new file at:
' http://ecn.ab.ca/~brewhaha/Sound/smurfy.mp3
' I am publishing this as dry signal, because when I
' post-process it, I hav a hard time perceiving a
' comment in this source az correct.

' _______________________________________________________

' Please note crossposting in replies,
' quote only issues you will address,
' and you are welcome to delete all
' of my text in your reply and ask something.

' -CC- Released in a Creative Commons
' -BY- BrewJay's Babble Bin
' -NC- Some commercial uses require permission.
' - - With a degree of development, this can be part of your
' work. If in doubt, ask me.

OPTION BASE 1
DIM numharmonics AS INTEGER
numharmonics = 2
DIM harmonics(numharmonics)

' This maps 30 to a 12-TET E.
harmonics(1) = 440 / 2 ^ (1 / 12) ^ 5 / 30
harmonics(2) = harmonics(1)

' Names come from:
' http://www.huygens-fokker.org/docs/intervals.html
' Left Channel, Right Channel, Length, Concert Ratio Name
' Names in square brackets are my synthesis.

DATA 0, 0, 1, "Jerminal Rest"
DATA 30, 30,10, "Unison"
DATA 0, 0, 2, "Rest"
DATA 27, 27, 6, "Unison"
DATA 24, 30, 4, "Major Third"
DATA 22, 35, 8, "[Undecimal Minor Sixth]"
' Whatever that is blends better than a major third in this context.
DATA 0, 0, 4, "Rest"
DATA 20, 33, 6, "[Undecimal Semi-Augmented Fifth]"
' 1.65 That blends better than a few documented harmonies.
DATA 22, 30, 4, "Undecimal Augmented Fourth"
DATA 24, 33, 8, "Undecimal Semi-Augmented Fourth"
DATA 0, 0, 4, "Rest"
DATA 22, 22, 6, "Unison"
DATA 18, 25, 4, "Classic Augmented Fourth"
DATA 30, 27, 8, "Minor Whole Tone"
DATA 0, 0, 4, "Rest"
DATA 15, 22, 8, "Undecimal Diminished Fifth"
DATA 0, 0, 4, "Rest"
DATA 24, 30, 8, "Major Third"
DATA 0, 0, 4, "Rest"
DATA 22, 27, 6, "Neutral Third"
DATA 18, 30, 4, "Major Sixth"
DATA 27, 35, 8, "Septimal Semi-Diminshed Fourth"
DATA 0, 0, 4, "Rest"
DATA 20, 40, 6, "Octave"
DATA 0, 0, 4, "Rest"
DATA 24, 33, 8, "Undecimal Semi-Augmented Fourth"
DATA 0, 0, 4, "Rest"
DATA 22, 22, 6, "Unison"
DATA 18, 25, 4, "Classic Augmented Fourth"
DATA 30, 27, 8, "Minor Whole Tone"
DATA 0, 0, 4, "Rest"
DATA 15, 22,12, "Undecimal Diminished Fifth"
DATA 22, 33,12, "Perfect Fifth"
DATA 0, 0,30, "Terminal Rest"

' The remainder of this message is public domain.

DIM TwoPi AS DOUBLE
DIM pi AS DOUBLE
DIM temp AS DOUBLE
DIM BeatsPerSecond AS DOUBLE
DIM Angle(numharmonics) AS DOUBLE
DIM Velocity(numharmonics) AS DOUBLE
DIM Acceleration(numharmonics) AS DOUBLE
DIM Phase(numharmonics) AS DOUBLE
DIM note(numharmonics) AS INTEGER
DIM LastNote(numharmonics) AS INTEGER
DIM length AS INTEGER
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 Sign(numharmonics) AS INTEGER
DIM glide AS INTEGER
DIM GlideTrim AS LONG
DIM test AS STRING
DIM TerminalAngle(numharmonics) AS DOUBLE
DIM DropAngle(numharmonics) AS DOUBLE
DIM PhaseDir(numharmonics) AS DOUBLE
DIM rationame AS STRING

PRINT
test = "0"
' I frequently flip that.
numharmonics = 2
BeatsPerSecond = 15#
pi = 3.141592653589793#
TwoPi = pi * 2
SampleRate = 44100

IF test = "0" THEN
OPEN "\sox\smurfy.raw" FOR OUTPUT AS #4
END IF

' This batch file will compile and view
' if nero waveedit and fbc are in your path.
OPEN "smurfy.bat" FOR OUTPUT AS #1
PRINT #1, "fbc -lang qb c:\basic\smurfy.bas"
PRINT #1, "smurfy.exe"
PRINT #1, "cd \sox"
PRINT #1, "sox -c 2 -r"; SampleRate; " -sw smurfy.raw smurfy.wav stat"
PRINT #1, "waveedit c:\sox\smurfy.wav"
CLOSE #1

OPEN "con" FOR APPEND AS #2

glide = 30
100
FOR g = 1 TO 34
READ note(1), note(2), length, rationame
PRINT #2, USING "DATA ###-,"; note(1);
PRINT #2, USING "###-,##"; note(2); length;
PRINT #2, ", "; rationame

' That is for feeding transpositions back into this code, although I
' am using a tuning that maps roughly to 12-TET, so I did not use it.
IF g > 0 THEN
SOUND note(1) * harmonics(1), 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
samples = samples / glide
GlideTrim = samples
GOSUB 300
samples = SampleRate * length / BeatsPerSecond
samples = samples - 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
Velocity(k) = TwoPi * LastNote(k) * harmonics(k) / SampleRate
Acceleration(k) = TwoPi * note(k) * harmonics(k) / SampleRate
Acceleration(k) = (Acceleration(k) - Velocity(k)) / samples
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(k) * harmonics(k) / SampleRate
Acceleration(k) = TwoPi * note(k) * harmonics(k) / SampleRate
Acceleration(k) = (Acceleration(k) - 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) * 32000)
PRINT #4, CHR$(amp AND 255);
PRINT #4, CHR$((amp AND 65280) / 256);

amp = CINT(Phase(2) * 32000)
PRINT #4, CHR$(amp AND 255);
PRINT #4, CHR$((amp AND 65280) / 256);
RETURN

' http://ecn.ab.ca/~brewhaha/Sound/

[Bohgosity BumaskiL]

' Simplified timing.
' My previous version of this duet
' featured an exact major third (of all things)
' that did not work, and two harmonies unlisted at:
' http://www.huygens-fokker.org/docs/intervals.html
' that did work. An intermediate version featured
' minor whole tones that did not work. I cut them
' out with a key change, something that does nothing
' when using equal (standard) temperament.
' I am using mostly a just intonation that I developed at:
' http://ecn.ab.ca/~brewhaha/Sound/Just_Intonation.htm
' The new file iz at:
' http://ecn.ab.ca/~brewhaha/Sound/smurfy.mp3
' The old file iz at:
' http://ecn.ab.ca/~brewhaha/Sound/smurfy1.mp3

' You might find this useful in understanding my names.
' http://www.basic-mathematics.com/reduce-fractions-calculator.html

' _______________________________________________________

' Please note crossposting in replies,
' quote only issues you will address,
' and you are welcome to delete all
' of my text in your reply and ask something.

' -CC- Released in a Creative Commons
' -BY- BrewJay's Babble Bin
' -SA- Please share any uses or changes you want with me.

OPTION BASE 1
DIM numharmonics AS INTEGER
numharmonics = 2
DIM harmonics(numharmonics)

' This maps 5670 to a 12-TET (standard) E.
harmonics(1) = 440 / 2 ^ (1 / 12) ^ 5 / 5670
harmonics(2) = harmonics(1)

' Names come from:
' http://www.huygens-fokker.org/docs/intervals.html
' Left Channel, Right Channel, Length, Concert Ratio Name

DATA 0, 0, 1, "Jerminal Rest"
DATA 5670, 5670, 2, "Unison"
DATA 0, 0, 1, "Rest"
DATA 5040, 5040, 2, "Unison"
DATA 4536, 5670, 1, "Major Third"
DATA 4200, 7560, 2, "Just Minor Seventh"
DATA 0, 0, 1, "Rest"
DATA 3780, 7056, 2, "Classic Major Seventh"
DATA 4200, 6300, 1, "Perfect Fifth"
DATA 4536, 7056, 2, "Septimal Minor Sixth"
DATA 0, 0, 1, "Rest"
DATA 4200, 4725, 2, "Major Second"
DATA 3780, 5292, 1, "Septimal Tritone"
DATA 5670, 6075, 2, "Major Semitone"
DATA 0, 0, 1, "Rest"
DATA 2835, 4725, 2, "Major Sixth"
DATA 0, 0, 1, "Rest"
DATA 4536, 6300, 2, "Classic Augmented Fourth"
DATA 0, 0, 1, "Rest"
DATA 4200, 5376, 2, "Classic Diminished Fourth"
DATA 3780, 6300, 1, "Major Sixth"
DATA 5040, 7560, 2, "Perfect Fifth"
DATA 0, 0, 1, "Rest"
DATA 3780, 8400, 2, "Small Niinth"
DATA 0, 0, 1, "Rest"
DATA 4536, 7056, 2, "Septimal Minor Sixth"
DATA 0, 0, 1, "Rest"
DATA 4200, 4725, 2, "Major Second"
DATA 3780, 5292, 1, "Septimal Tritone"
DATA 5670, 6075, 2, "Major Semitone"
DATA 0, 0, 1, "Rest"
DATA 2835, 4725, 2, "Major Sixth"
DATA 0, 0, 1, "Rest"
DATA 4200, 7000, 3, "Major Sixth"
DATA 0, 0, 8, "Terminal Rest"

' E F F# G G# A A# B C C# D D#
' 2520 2646 2800 3024 3150 3360 3600 3780 4032 4200 4536 4725
' 5040 5292 5600 6075 6300 6720 7056 7560 8064 8400 9072 9450
' 10080 11340

' The remainder of this message is public domain.

DIM TwoPi AS DOUBLE
DIM pi AS DOUBLE
DIM temp AS DOUBLE
DIM BeatsPerSecond AS DOUBLE
DIM Angle(numharmonics) AS DOUBLE
DIM Velocity(numharmonics) AS DOUBLE
DIM Acceleration(numharmonics) AS DOUBLE
DIM Phase(numharmonics) AS DOUBLE
DIM note(numharmonics) AS INTEGER
DIM LastNote(numharmonics) AS INTEGER
DIM length AS INTEGER
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 Sign(numharmonics) AS INTEGER
DIM glide AS INTEGER
DIM GlideTrim AS LONG
DIM test AS STRING
DIM TerminalAngle(numharmonics) AS DOUBLE
DIM DropAngle(numharmonics) AS DOUBLE
DIM PhaseDir(numharmonics) AS DOUBLE
DIM rationame AS STRING

PRINT
test = "0"
' I frequently flip that.
numharmonics = 2
BeatsPerSecond = 4#
pi = 3.141592653589793#
TwoPi = pi * 2
SampleRate = 8000

IF test = "0" THEN
OPEN "\sox\smurfy.raw" FOR OUTPUT AS #4
END IF

' This batch file will compile and view
' if nero waveedit and fbc are in your path.
OPEN "smurfy.bat" FOR OUTPUT AS #1
PRINT #1, "fbc -lang qb c:\basic\smurfy.bas"
PRINT #1, "smurfy.exe"
PRINT #1, "cd \sox"
PRINT #1, "sox -c 2 -r"; SampleRate; " -sw smurfy.raw smurfy.wav stat"
PRINT #1, "waveedit c:\sox\smurfy.wav"
CLOSE #1

OPEN "con" FOR APPEND AS #2

glide = 30
100
FOR G = 1 TO 35
READ note(1), note(2), length, rationame
PRINT #2, USING "DATA ####-,"; note(1);
PRINT #2, USING "####-,##"; note(2); length;
PRINT #2, ", "; rationame

' That is for feeding transpositions back into this code, although I
' am using a tuning that maps roughly to 12-TET, so I did not use it.
IF G > 0 THEN
' SOUND note(2) * harmonics(2), length * 4
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
samples = samples / glide
GlideTrim = samples
GOSUB 300
samples = SampleRate * length / BeatsPerSecond
samples = samples - 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
Velocity(k) = TwoPi * LastNote(k) * harmonics(k) / SampleRate
Acceleration(k) = TwoPi * note(k) * harmonics(k) / SampleRate
Acceleration(k) = (Acceleration(k) - Velocity(k)) / samples
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(k) * harmonics(k) / SampleRate
Acceleration(k) = TwoPi * note(k) * harmonics(k) / SampleRate
Acceleration(k) = (Acceleration(k) - 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) * 32000)
PRINT #4, CHR$(amp AND 255);
PRINT #4, CHR$((amp AND 65280) / 256);

amp = CINT(Phase(2) * 32000)
PRINT #4, CHR$(amp AND 255);
PRINT #4, CHR$((amp AND 65280) / 256);
RETURN

' http://ecn.ab.ca/~brewhaha/Sound/

[Bohgosity BumaskiL]

Just for the sake of reminding myself why I spent a few hours making
my zeros neat, I changed all of my rests to ones, which makes them
equal to the fundamental; .05813537158957142Hz (subsonic, but boy do
fundamentals ever let some kind of clamping noise through). BTW, I
also noticed that my harmonics are not dimensioned az double
precision, like they were before I moved them around.

Rezult: http://ecn.ab.ca/~brewhaha/Sound/smurfyd.mp3

Another reason I might want ones instead of zeros iz a graphic I hav
planned. Zeros are awkward az exponents, since they turn everything
into ones, while ones change nothing.
_______
http://ecn.ab.ca/~brewhaha/Sound/

[s***@tiscali.net]

oops,

you should read this source example
“I’d like to have the industry held
accountable for once,” said Jeff Locker, a hay and barley farmer who said
that his well water had gone bad around the mid-’90s and that the
contaminants had contributed to his wife’s neuropathy. “We’ve got scientific
proof. And they’re still turning their back on us. They expect us to pay
between $100 and $200 for something we didn’t cause. It gets under my skin.”

Renny MacKay, a spokesman for Mr. Mead, said the governor was committed to
figuring out a long-term fix for about 20 homes whose water was found to
contain contaminants while the source of the pollution is studied.
Renny
MacKay, a spokesman for Mr. Mead, said the governor was committed to figuring
out a long-term fix for about 20 homes whose water was found to contain
contaminants while the source of the pollution is studied.
But here on the
front lines of the battle over fracking, which has become an increasingly
popular technique to extract previously unobtainable reserves of oil and gas,
no conclusion is yet definitive.
Renny MacKay, a spokesman for Mr. Mead,
said the governor was committed to figuring out a long-term fix for about 20
homes whose water was found to contain contaminants while the source of the
pollution is studied.
Encana has maintained that water in the area is
naturally poor and that its operations did not cause the problems — fracking
had also occurred before the company purchased the gas field. Moreover, the
energy industry has steadfastly pointed out that there has never been any
conclusive link between fracking and water contamination.
“I’d like to have
the industry held accountable for once,” said Jeff Locker, a hay and barley
farmer who said that his well water had gone bad around the mid-’90s and that
the contaminants had contributed to his wife’s neuropathy. “We’ve got
scientific proof. And they’re still turning their back on us. They expect us
to pay between $100 and $200 for something we didn’t cause. It gets under my
skin.”

;-)