' Subject-Was: Re: Golden section, Fibonacci series
' On 2013-03-21 3:57 AM, ***@yahoo.com wrote:
' >
' >> But the whole point is that it is an irrational number
' >> and therefore will not occur as a simple harmonic!
' >
' > What is a "harmonic" is contextual. For example, there are the
' > "spherical harmonics" too.
' While the golden mean iz irrational, and therefore not harmonic
' (about which the first author iz right), elements of the series, '
1,2,3,5,8,13,21,34 _are_ harmonies. 2:1 is an octave. 3:2 is a
' perfect fifth. 5:3 is a major sixth. 8:5 is a minor sixth. 21:13
' duz not hav a name, though I recently used it, while 34:21 is
' called a supraminor sixth.
' The series stops being musical at that point, according to this
' table:
' http://www.huygens-fokker.org/docs/intervals.html
' 34:21 is very close to the golden mean. Higher pairs of
' consecutive terms in the series are closer _rational_
' approximations of the golden mean.
' I used 3...89 az parallel harmonics in the background sound here:
' http://litwyn.comyr.com/img/
' The whole series forms a chord. I omitted two and one.
' It duz not sound like bells without reverb.
' This is for your perusal, and if you corrupt it enough, use.
' -CC- Released in a creative commons.
' -BY- http://litwyn.comyr.com/ BrewJay's Babble Bin
' -NC- Some commercial uses require permission
' -ND- Use in video or on web pages requires permission
OPTION BASE 1
DIM numharmonics, k AS INTEGER
numharmonics = 8
DIM harmonics(numharmonics) AS DOUBLE
DATA 3,8,21,55,89,34,13,5
' Lower harmonics panned outwards.
FOR k = 1 TO numharmonics
READ harmonics(k)
NEXT k
' Tweaked version of table in:
' http://litwyn.comyr.com/Sound/Just_Intonation.htm
' 3750 3920 4200 4536 4725 5040 5292 5600 6075 6300 6720 7056 7560
DATA 0,4,6300,6
' Perfect Fourth
DATA 4725,12,0,2
' Major Second
DATA 4200,12,0,2
' Middle Second
DATA 3750,6
' Quasi-equal Major Third
DATA 4725,8,0,4
' Minor Third
DATA 5670,12,0,8
' Minor Second
DATA 6300,4,0,2
' Perfect Fourth
DATA 4725,12,0,2
' Major Second
DATA 4200,12,0,2
' Acute Fourth
DATA 5670,6
' Minor Third
DATA 4725,12,0,8
' Perfect Fourth
DATA 6300,4,0,2
' Perfect Fourth
DATA 4725,12,0,2
' Major Second
DATA 4200,12,0,2
' Middle Second
DATA 3750,6
' Perfect Fifth
DATA 5625,8,0,4
' Perfect Fifth
DATA 3750,8,0,4
' Octave
DATA 7500,6
' Perfect Fourth
DATA 5625,12,0,8
' Middle Second
DATA 6300,4,0,2
' Perfect Fourth
DATA 4725,12,0,2
' Major Second
DATA 4200,12,0,2
' Middle Second
DATA 3750,6
' Quasi-equal Major Third
DATA 4725,12,0,8
' Perfect Fourth
DATA 6300,6
' Major Third
DATA 5040,12,0,2
' Middle Second
DATA 7000,12,0,4
' Major Third
DATA 5600,6
' Acute Fourth
DATA 7560,6
' Acute Fourth
DATA 5600,12,0,6
' Acute Fourth
DATA 7560,12,0,48
' The rest of this message iz public domain.
DIM chanamp(2, numharmonics) AS DOUBLE
DIM Velocity(numharmonics) AS DOUBLE
DIM Acceleration(numharmonics) AS DOUBLE
DIM Angle(numharmonics) AS DOUBLE
DIM Phase(numharmonics) AS DOUBLE
DIM TerminalAngle(numharmonics) AS DOUBLE
DIM DropAngle(numharmonics) AS DOUBLE
DIM PhaseDir(numharmonics) AS INTEGER
DIM BeatsPerSecond AS DOUBLE
DIM ampleft AS DOUBLE
DIM ampright AS DOUBLE
DIM temp AS DOUBLE
DIM TwoPi AS DOUBLE
DIM basis, note, length, glide AS SINGLE
DIM samplerate AS LONG
DIM amp AS LONG
DIM g, t, lastnote, samples AS INTEGER
DIM flop AS INTEGER
DIM test AS STRING
test = "0"
pi = 3.141592653589793#
TwoPi = pi * 2
samplerate = 44100
BeatsPerSecond = 20
lastnote = 0
' For this to work, fbc and waveedit must be in your path.
OPEN "\sox\tampink.raw" FOR OUTPUT AS #2
OPEN "tampink.bat" FOR OUTPUT AS #1
PRINT #1, "fbc -lang qb tampink.bas"
PRINT #1, "tampink.exe"
PRINT #1, "cd \sox"
PRINT #1, "sox -c 2 -r"; samplerate; " -sw tampink.raw tampink.wav stat"
PRINT #1, "WaveEdit.exe c:\sox\tampink.wav"
PRINT #1, "cd \basic"
CLOSE #1
' This pans sine waves evenly.
ampright = 1 / (numharmonics - 1)
ampleft = 0
FOR k = 1 TO numharmonics
chanamp(1, k) = ampleft
chanamp(2, k) = 1 - ampleft
ampleft = ampleft + ampright
NEXT k
' This makes amplitude inversely proportional to frequency.
flop = 1
FOR k = 1 TO numharmonics
IF flop = 1 THEN
chanamp(1, k) = 110000 / harmonics(k) * chanamp(1, k)
chanamp(2, k) = -60000 / harmonics(k) * chanamp(2, k)
ELSE
chanamp(1, k) = -110000 / harmonics(k) * chanamp(1, k)
chanamp(2, k) = 60000 / harmonics(k) * chanamp(2, k)
END IF
harmonics(k) = harmonics(k) / 81
flop = -flop
NEXT k
OPEN "con" FOR APPEND AS #1
glide = 32
100
FOR g = 1 TO 54
PRINT #1, USING "DATA ####-,"; note / 5;
PRINT #1, USING "##"; length
READ note, length
IF g > 0 THEN
' SOUND note * harmonics(1), length
END IF
IF test = "0" THEN
IF note = 0 AND lastnote = 0 THEN
samples = samplerate * length / BeatsPerSecond
GOSUB 300
GOTO 75
END IF
IF note = 0 AND lastnote <> 0 THEN
GOSUB 250
lastnote = note
samples = samplerate * length / BeatsPerSecond
GOSUB 300
GOTO 75
END IF
IF note <> 0 AND lastnote = 0 THEN
lastnote = note
samples = samplerate * length / BeatsPerSecond
GOSUB 275
GOTO 75
END IF
IF note <> 0 AND lastnote <> 0 THEN
IF glide > 0 THEN
samples = samplerate * length / BeatsPerSecond / glide
GOSUB 300
END IF
samples = samplerate * length / BeatsPerSecond
lastnote = note
GOSUB 300
GOTO 75
END IF
END IF
75 NEXT g
IF test = "1" THEN END
CLOSE #2
END
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) = 2
DropAngle(k) = pi * 2.5
ELSEIF Angle(k) > pi / 2 THEN
TerminalAngle(k) = pi * 2.5
PhaseDir(k) = 1
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 2
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
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 * harmonics(k) / samplerate
Acceleration(k) = (TwoPi * note * harmonics(k) / samplerate -
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
FOR k = 1 TO numharmonics
Velocity(k) = TwoPi * lastnote * harmonics(k) / samplerate
Acceleration(k) = (TwoPi * note * harmonics(k) / samplerate -
Velocity(k)) / samples
NEXT k
FOR t = 1 TO samples
FOR k = 1 TO numharmonics
Velocity(k) = Velocity(k) + Acceleration(k)
Angle(k) = Angle(k) + Velocity(k)
Phase(k) = SIN(Angle(k))
NEXT k
GOSUB 400
NEXT t
RETURN
400
ampleft = 0
FOR k = 1 TO numharmonics
ampleft = ampleft + Phase(k) * chanamp(1, k)
NEXT k
amp = CINT(ampleft)
PRINT #2, CHR$(amp AND 255);
PRINT #2, CHR$((amp AND 65280) / 256);
ampright = 0
FOR k = 1 TO numharmonics
ampright = ampright + Phase(k) * chanamp(2, k)
NEXT k
amp = CINT(ampright)
PRINT #2, CHR$(amp AND 255);
PRINT #2, CHR$((amp AND 65280) / 256);
RETURN