Hogeschool Gent : School of Arts

In de vorige hoofdstukjes behandelden we de mogelijkheid en konstruktie van harmoniesystemen met een symmetrie rond een gegeven tonaal centrum.

Hier willen we een volkomen ander uitgangspunt behandelen: namelijk de mogelijkheid harmoniesystemen te ontwerpen waarbij uitsluitend wordt uitgegaan van de spektrale eigenschappen van een gegeven te harmonizeren noot tegenover een gegeven tonaal centrum.

Ook hiervoor schreven we een komputerprogramma:

' **************************************************************************

' * Spectral Counterpoint Nr.1 *

' * CLIMBING *

' * Up to 7 Voices *

' * author: Dr.Godfried-Willem RAES *

' * SOURCE FILE= KORSPEK3.BAS *

' **************************************************************************

' Rules:

' A scale consists of notes belonging to the rising spektral series. The program needs user input in order to build this scale: It calculates the minimum number of harmonics to take into consideration (1 to 27 : multiplier of the fundamental note Tc% All chords consist of NrVoices% different notes belonging to this scale.There are no doublings in the chords, regardless the number of voices generated.

' Chords are only possible on notes belonging to the scale Notes to be harmonized and not belonging to the scale will cause modulation, such that the note belongs to a new scale as close as possible to the original scale. All propulsive chords have to be solved.A note belonging to the fundamental scale shall never give rise to modulations.Remark: if scales are based on 27 harmonics or more, then we get a 12-tone scale in which there will be no modulation at all!!!At the other side, we need a minimum of 7-harmonics in order to guarantee 4-part harmony without doublings. Hence the limitations in the menus.There are -as yet- 6 different chords possible.

' The program uses either real-time input through midi, or, any *.BIN file in the Raes P() format. Against the voice or midichannel chosen from this input file the requested number of parts will be composed in counterpoint. These parts can be placed either above, around or below the given voice.Note-ranges for the voices should be given by the user.

REM $DYNAMIC

CONST Tit1$ = "Spectral Counterpoint"

CONST Tit2$ = "Real Time Parametric Multivariable Harmony Algorithm"

CONST Tit3$ = "Version V1.3"

CONST Ver$ = "Music Composition Software by Dr.Godfried-Willem RAES 1996 [V1.3]"

CONST Tit4$ = "Running in Real Time Mode: <ESC>-key to Quit program"

CONST La = 440! ' in our convention, variables without explicit

CONST False = 0 ' type, are always declared constants.

CONST True = NOT False ' (except for strings)

CONST KleurScherm = True

CONST Dp = &H330 ' Midi card port adress - IRQ not used

CONST Sp = Dp + 1

CONST MidiIrq = 11 ' needed for disabling it!

CONST Debug = False: ' change to 0 before compilation!

CONST MidiBuffer = &H1FF ' size for midi in fifo

' Shared variables:

COMMON SHARED RealTim% ' Logic (True or False)

COMMON SHARED Merging% ' Logic

COMMON SHARED RTSource% ' 0 = midi-input, 1 = egg-input, 2 = bom-input

COMMON SHARED Gronddo! ' frequency of midi note 0

COMMON SHARED Tc% ' tonal center

COMMON SHARED Rubberbanding% ' modulation style parameter

COMMON SHARED i& ' note-counter

COMMON SHARED NrHarms% ' number of harmonics to build scale from

COMMON SHARED NrNotes% ' number of different notes in the scale

COMMON SHARED NrVoices% ' number of voices for the piece

COMMON SHARED NrTrans% ' aantal mogelijke transposities van Tc%

COMMON SHARED HPointer% ' pointer to HarmSeries%()

COMMON SHARED SolveTo%

COMMON SHARED MidiInChannel% ' Channel 0-15 to take as input if real-time

COMMON SHARED FifoWritePtr% ' for midi RT-implementation

' FifoReadPtr% can be static in Getnote%

' Shared Arrays:

COMMON SHARED P%(): ' score array

COMMON SHARED Stem%() ' voice order array

' Stem%(0): given voice (= 1,3,5,7...)

' Stem%(1): added voice 1 (= odd and <> Stem%(0), <> Stem%(2) )

' Stem%(2): added voice 2 (= odd and <> Stem%(0), <> Stem%(1) )

' Stem%(3): added voice 3 (= odd and <> Stem%(0),<>Px%.<>Stem%(2))

' etc...

COMMON SHARED Vhigh%(), Vlow%()

' Vhigh%(1), Vlow%(1): ' range for added voice 1

' Vhigh%(2), Vlow%(2): ' range for added voice 2

' Vhigh%(3), Vlow%(3): ' range for added voice 3

' etc..

COMMON SHARED Ladder%() ' derived scale

COMMON SHARED HarmSeries%() ' scale in harmonic order

COMMON SHARED OldHarmSer%() ' temporary array for modulations

COMMON SHARED VorigeNoot%()

COMMON SHARED VorigeVelo%()

COMMON SHARED VolgendeNoot%()

COMMON SHARED NuNoot%() ' de te harmonizeren noot

COMMON SHARED NuVelo%()

COMMON SHARED LadMat%() ' transposition matrix

' dimension 1 = 0 to NrTranspositions

' dimension 2 = 1 to Nr of notes

' This array contains all possible harmonic scales.

COMMON SHARED Fifo%() ' Midi-input buffer for RT implementation

' Procedure declarations:

DECLARE SUB Kleur (k%) ' sets screen colors if constant is set

DECLARE SUB Logo () ' program header for screen

DECLARE SUB Blank1059 () ' wipes out display lines 10 to 59

DECLARE SUB Getparam1 () ' user parameter interface

DECLARE SUB GetToneSystem ()

DECLARE SUB GetMatrix () ' returns transposition matrix LadMat%()

DECLARE SUB GetVoicing ()

DECLARE SUB GradeBotChord () ' writes a chord on the lowest harmonics

DECLARE SUB GradeSubChord () ' writes a chord with harmonics below the

' given note harmonic grade

DECLARE SUB GradeCenChord () ' writes a chord spread arount the given

' note and closely connected to it.

DECLARE SUB GradeAbochord () ' writes a chord with harmonics above the

' given note harmonic grade

DECLARE SUB GradeTopChord () ' writes a chord using only the highest partials

DECLARE SUB Showsit ()

DECLARE SUB ShowMatrix () ' displays tonesystem & transpositionmatrix

DECLARE SUB Rbin ()

DECLARE SUB Uit (byte%)

DECLARE SUB Mpuuart ()

DECLARE SUB Mplay ()

DECLARE SUB Melodize ()

DECLARE SUB Binder ()

DECLARE SUB RTbinder ()

DECLARE SUB Writfil ()

DECLARE SUB Maakladder (k%)

DECLARE SUB TestChords ()

DECLARE SUB Midi (byte%)

' Function declarations:

DECLARE FUNCTION NoteFreq! (byte%) : ' converts midi-notes to frequency

DECLARE FUNCTION FreqNote% (frq!) : ' converts frequency to nearest note

DECLARE FUNCTION HaalWijzer% (k%) : ' returns pointer to harmseries()

DECLARE FUNCTION HarmSize% () : ' returns the minimum number of

' harmonics to build a scale from

DECLARE FUNCTION GetNote% () ' read a note from the midibuffer

' Sizing of arrays:

DIM SHARED P%(0 TO 100, 0 TO 15) ' provisory

DIM SHARED Stem%(0 TO 6): ' 7 voices is the maximum for P%() format

DIM SHARED Vhigh%(0 TO UBOUND(Stem%)) ' voorlopige dimensioneringen

DIM SHARED Vlow%(0 TO UBOUND(Stem%))

DIM SHARED Ladder%(1 TO 12)

DIM SHARED HarmSeries%(1 TO 12)

DIM SHARED OldHarmSer%(1 TO 12)

DIM SHARED VorigeNoot%(0 TO UBOUND(Stem%))

DIM SHARED VorigeVelo%(0 TO UBOUND(Stem%))

DIM SHARED VolgendeNoot%(0 TO UBOUND(Stem%)): ' we use only the 0-dimension

DIM SHARED NuNoot%(0 TO UBOUND(Stem%)): ' = P%(i&,Stem%(0))

DIM SHARED NuVelo%(0 TO UBOUND(Stem%))

DIM SHARED LadMat%(1 TO 12, 1 TO 12): ' provisory dimension

DIM SHARED Fifo%(0 TO MidiBuffer): ' for RT-mode with midi

' Arrays only used in the main-module:

DIM OldNoot%(0 TO 15)

DIM OldVelo%(0 TO 15) ' only needed for midi-out in RT-mode.

' ***************************** PROGRAM START *******************************

SCREEN 12: WIDTH 80, 60 ' VGA support only

Debuglevel% = 10 ' met deze variabele kunnen

' afzonderlijke procedures uitgetest worden.

' set to 10 for file-mode

SolveTo% = False

Merging% = False

RealTim% = False

Mpuuart

' eenmalige berekening van de frekwentie voor

' midi noot 0 (dit is de laagste do, ca. 8Hz)):

Gronddo! = (La * (2! ^ (3! / 12!))) / 64

CLS

Logo

Getparam1

IF Merging% = False THEN

IF RealTim% = False THEN

' in dit geval moeten we alle noten behalve

' die van de te harmonizeren stem, wissen!

FOR i& = 0 TO UBOUND(P%, 1)

FOR j% = 1 TO 13 STEP 2

IF j% <> Stem%(0) THEN

P%(i&, j%) = False: P%(i&, j% + 1) = False

END IF

NEXT j%

NEXT i&

END IF

END IF

GetVoicing

GetToneSystem

GetMatrix

Logo

Blank1059

ShowMatrix

' Main Loop for File-input condition: **************************************

i& = 0 ' reset loop counter

NuNoot%(0) = P%(i&, Stem%(0)): ' initialization

NuVelo%(0) = P%(i&, Stem%(0) + 1)

TcCount% = 0 ' reset modulation counter

FifoWritePtr% = 1 ' otherwize it never starts...

DO

' look for the note to be harmonized:

ChordRequest% = False

IF RealTim% = False THEN

' File-mode case:

IF (P%(i&, Stem%(0)) > 0) AND (P%(i&, Stem%(0) + 1) > 0) THEN

ChordRequest% = True

' look for the next note to be harmonized:This has no function in this type of

' harmony. Modulations will not be anticipated here. In a real-time application the next

' note belong to unknown future anyway...

NuNoot%(0) = P%(i&, Stem%(0))

NuVelo%(0) = P%(i&, Stem%(0) + 1)

ii& = i& + 1

DO

Nn% = P%(ii&, Stem%(0))

IF (Nn% > 0) AND P%(ii&, Stem%(0) + 1) = False THEN

Rest% = True

EXIT DO

ELSE

Rest% = False

END IF

ii& = ii& + 1

LOOP UNTIL (Nn% > 0) OR (ii& > UBOUND(P%, 1))

VolgendeNoot%(0) = Nn% MOD 12:

' tonale graad van de opvolger t.o.v. Tc% Komt zij voor in de ladder?

' Wanneer Rest% waar is, is de volgende noot een rust.

' In dit geval moet eigenlijk een of andere vorm van kadens of tonale bevestiging

' geschreven worden.We beperken ons hier tot het schrijven van een spektraal grondakkoord:

IF Rest% AND (SolveTo% = False) THEN

SELECT CASE Rubberbanding%

CASE 0

SolveTo% = 1: ' doesn'nt change Tc%

CASE 1

SolveTo% = 1: ' schrijf een grondakkoord bij ingang van

' de volgende noot en verschuif Tc%

' 1 stapje terug

IF TcCount% > 0 THEN TcCount% = TcCount% - 1

FOR ip% = 1 TO NrNotes%

HarmSeries%(ip%) = LadMat%(TcCount%, ip%)

NEXT ip%

Tc% = LadMat%(TcCount%, 1)

CASE 2

SolveTo% = 1: ' schrijf een grondakkoord bij ingang van

' de volgende noot en reset ook Tc%

TcCount% = 0

FOR ip% = 1 TO NrNotes%

HarmSeries%(ip%) = LadMat%(TcCount%, ip%)

NEXT ip%

Tc% = LadMat%(0, 1)

END SELECT

END IF

ELSE

ChordRequest% = False

END IF

ELSE

' Real-Time mode case:

' ********************

IF RTSource% = 0 THEN Midi -1

' dummy call the midibuffer-procedure this reads input and handles output at

' the same time! We send out a dummy byte! (this reads midi)

' voorziening voor Real-Time kontrapunt: Te te schrijven procedure moet in de

' midififobuffer kijken en de volgende noot ophalen. (ook wanneer het een note-off is!)

IF GetNote% THEN

' GetNote% is een funktie die wanneer er een volledige note-message binnenliep, True

' retourneert. In dat geval zijn automatisch de variabelen NuNoot%(0) en NuVelo%(0) bepaald.

' Wanneer RTSource% niet False is, retourneert GetNote% nootinformatie vanuit de

' alternatieve device-input.

IF NuNoot%(0) AND NuVelo%(0) > 0 THEN

ChordRequest% = True

Midi 144: Midi NuNoot%(0): Midi NuVelo%(0)

OldNoot%(0) = NuNoot%(0)

OldVelo%(0) = NuVelo%(0)

END IF

IF NuNoot%(0) AND NuVelo%(0) = 0 THEN

' rust:

IF OldNoot%(0) = NuNoot%(0) THEN

Midi 144: Midi NuNoot%(0): Midi 0

OldNoot%(0) = NuNoot%(0)

OldVelo%(0) = False

FOR icn% = 1 TO NrVoices%

IF OldNoot%(icn%) AND OldVelo%(icn%) THEN

Midi 144 + icn%: Midi OldNoot%(icn%): Midi 0

OldNoot%(icn%) = OldNoot%(icn%)

OldVelo%(icn%) = False

END IF

NEXT icn%

ChordRequest% = False :SolveTo% = 1

END IF

ChordRequest% = False

END IF

ELSE

ChordRequest% = False

NuNoot%(0) = False :NuVelo%(0) = False

END IF

END IF

IF ChordRequest% = True THEN

' ga na welk rangnummer de nu te harmonizeren

' noot heeft in de spektraalreeks Harmseries% (1 TO UBOUND(Ladder%))

HPointer% = HaalWijzer%(NuNoot%(0)) ' de parameter is die voor Stem%(0)

' indien nu HPointer% nog False is, dan behoort deze noot niet tot de tot

' nu toe geldende spektraalladder.In dit geval moeten we de grondtoon Tc%

' volgens de stappen van Harmseries% opschuiven tot de noot overeenkomt met noot

' in een nieuwe spektraalladder: SolveTo% will be set + aanpassing ladder% ,

' harmseries% en Tc%. De nieuwe toonladder staat reeds in LadMat%()

IF HPointer% = False THEN

' no matching note found in the scale... bekijk de tweede (enz...) noot van de huidige

' spektraalladder en ga na of de te harmoniseren noot behoort tot haar spektrum:

' Aangezien in Getparam1 werd nagegaan dat modulatie binnen het gegeven systeem in

' elk geval mogelijk is, hoeven we geen endless loops meer te vrezen.

SELECT CASE Rubberbanding%

CASE 0

TcCount% = (TcCount% + 1) MOD (NrTrans% + 1)

' de modulaties doorlopen nu ringvormig alle berekende mogelijkheden.

NewTc% = LadMat%(TcCount%, 1)

FOR ip% = 1 TO NrNotes%

HarmSeries%(ip%) = LadMat%(TcCount%, ip%)

NEXT ip%

HPointer% = HaalWijzer%(NuNoot%(0))

LOOP UNTIL HPointer%

CASE 1

Flag% = False

DO

' tel van NrTrans% tot 0, stapje per stapje:

IF TcCount% = 0 THEN Flag% = True

IF (TcCount% > 0) AND (Flag% = False) THEN

TcCount% = (TcCount% - 1) MOD (NrTrans% + 1)

IF TcCount% = 0 THEN Flag% = True

ELSE

TcCount% = (TcCount% + 1) MOD (NrTrans% + 1)

END IF

' de modulaties lopen nu stap per stap terug richting originele Tc%

NewTc% = LadMat%(TcCount%, 1)

FOR ip% = 1 TO NrNotes%

HarmSeries%(ip%) = LadMat%(TcCount%, ip%)

NEXT ip%

HPointer% = HaalWijzer%(NuNoot%(0))

LOOP UNTIL HPointer%

CASE 2

DO

TcCount% = (TcCount% + 1) MOD (NrTrans% + 1)

NewTc% = LadMat%(TcCount%, 1)

FOR ip% = 1 TO NrNotes%

HarmSeries%(ip%) = LadMat%(TcCount%, ip%)

NEXT ip%

HPointer% = HaalWijzer%(NuNoot%(0))

LOOP UNTIL HPointer%

END SELECT

' verplicht het programma tot het schrijven van een akkoord bestaande uit

' de hoogste spektraalkomponenten van de nieuwste spektraalladder.

' de modulatie verloopt dus via een onvoorbereidde dissonant.

SolveTo% = NrNotes%

END IF ' endif voor HPointer%= False !

' Hier MOET HPointer% > 0 !!!!!!

IF SolveTo% THEN

' de variabele SolveTo% geeft de graad van het akkoord dat diende geschreven te worden op

' grond van het vorige akkoord, of op grond van de uitgevoerde modulatie.

IF Rest% THEN

GradeBotChord

SolveTo% = False

END IF

SELECT CASE SolveTo%

CASE 1

GradeBotChord

SolveTo% = False

CASE UBOUND(HarmSeries%)

GradeTopChord

SolveTo% = 1

CASE ELSE

' schrijft helemaal geen akkoord!

SolveTo% = False

END SELECT

ELSE

' geval waarin we de vrijheid hebben tot akkoordvorming:

' hierbij laten we het te vormen akkoord afhangen van de plaats van

' de nieuwe noot in de harmonische ladder. deze plaats vinden we terug in HPointer%

' In dit harmonisch systeem wordt geen rekening gehouden met de opvolger

' van de noot. Daardoor is het algoritme ook goed bruikbaar voor real-time toepassingen.

SELECT CASE HPointer%

CASE 0

STOP: ' dit mag niet voorkomen!

GradeSubChord

CASE IS = UBOUND(HarmSeries%) / 2

GradeCenChord

CASE IS > UBOUND(HarmSeries%) - NrVoices%

GradeTopChord

CASE IS < NrVoices%

GradeBotChord

CASE IS >= UBOUND(HarmSeries%) / 2

GradeAbochord

CASE IS <= UBOUND(HarmSeries%) / 2

GradeSubChord

CASE ELSE

GradeCenChord

END SELECT

SolveTo% = False ' reset de schrijfverplichtingspointer

END IF

' afwerking : ******************* file mode ****************************

IF RealTim% = False THEN

P%(i&, 0) = Tc%: ' save grondnootpointer

' leg nu de toegevoegde noten in de juiste tessituur:

' en schrijf meteen ook de dinamiek naar de betreffende stemmen

FOR icnt% = 1 TO NrVoices%

' write the notes to the P%() array:

P%(i&, Stem%(icnt%)) = NuNoot%(icnt%)

' dynamiek zoals in de opgegeven stem:

P%(i&, Stem%(icnt%) + 1) = NuVelo%(0)

DO

P%(i&, Stem%(icnt%)) = P%(i&, Stem%(icnt%)) + 12

LOOP UNTIL P%(i&, Stem%(icnt%)) >= Vlow%(icnt%)

' hierbij kunnen we de intervallen tegenover de vorige noot nog zo omdraaien dat de

' melodische intervallen nooit groter zijn dan een tritonus.

' cfr. de routines in Melodize In het realtime geval, gebeurt dit in de

' procedure RTBinder onthoudt de vorige noten:

VorigeNoot%(icnt%) = NuNoot%(icnt%)

NEXT icnt%

END IF

' ***************************************************************************

' ******************************* Debug section *****************************

IF Debug THEN

IF Debuglevel% = 10 THEN

TestChords

Kleur 14

IF RealTim% = False THEN

LOCATE 10, 5: PRINT "Count:",

PRINT USING "######"; i&;

ELSE

LOCATE 10, 5: PRINT "Time:",

PRINT TIME$;

END IF

FOR icnt% = 0 TO NrVoices%

LOCATE 11 + icnt%, 10:

PRINT USING "##"; Stem%(icnt%);

PRINT " ",

PRINT USING "###"; VorigeNoot%(icnt%);

PRINT " ",

PRINT USING "###"; NuNoot%(icnt%);

PRINT " ",

IF RealTim% = False THEN

PRINT USING "###"; VolgendeNoot%(icnt%);

END IF

NEXT icnt%

END IF

END IF

' ***************************************************************************

IF RealTim% THEN

' in realtime verzorgt de RTbinder procedure het geheugen en de melodische clean-up.

RTbinder

' procedure voor midiuit:

FOR icnt% = 1 TO NrVoices%

' onthoudt de vorige noten:

VorigeNoot%(icnt%) = NuNoot%(icnt%)

IF NuNoot%(icnt%) THEN

IF OldVelo%(icnt%) AND OldNoot%(icnt%) THEN

Midi 144 + icnt%: Midi OldNoot%(icnt%): Midi 0

OldVelo%(icnt%) = False:OldNoot%(icnt%) = False

END IF

Midi 144 + icnt%: Midi NuNoot%(icnt%): Midi NuVelo%(icnt%)

OldNoot%(icnt%) = NuNoot%(icnt%):OldVelo%(icnt%) = NuVelo%(icnt%)

END IF

NEXT icnt%

END IF

END IF ' endif voor te harmonizeren noot

' IF ChordRequest% ...

IF RealTim% = False THEN

i& = i& + 1 ' main loop counter for P()-array

IF i& > UBOUND(P%, 1) THEN EXIT DO

ELSE

i& = (i& + 1) AND &H7FFF

k$ = INKEY$: IF k$ = CHR$(27) THEN EXIT DO

LOCATE 50, 10: PRINT i&; " ";

'IF NuNoot%(0) THEN LOCATE 20, 10: PRINT NuNoot%(0); NuVelo%(0); " ";

END IF

LOOP

' clean up for files and playback of results:

IF RealTim% = False THEN

IF Merging = False THEN Melodize: ' gaat niet in het merge-geval!

Binder

Mplay

Writfil

END IF

CLS

END

SUB Binder

' Deze Binder werkt slechts op afgewerkte P() arrays! Hij kan niet in real-time worden gebruikt. Hij is daarvoor echter wel

' aan te passen... -> procedure RTbinder wanneer een noot gelijk is aan haar voorganger, sla ze dan niet

' opnieuw aan, maar bind ze met de vorige noot. merk op dat we (nog) geen rekening houden met de metriek!)

' Deze procedure werd reeds veralgemeend tot n-stemmen...

DIM NootBind%(0 TO NrVoices%): ' local logic array

FOR j% = 1 TO NrVoices%

i& = 0

DO

VorigeNoot%(j%) = P%(i&, Stem%(j%)):i& = i& + 1

LOOP UNTIL VorigeNoot%(j%) > 0

NEXT j%

i& = 0

DO

IF P%(i&, Stem%(0)) > 0 AND P%(i&, Stem%(0) + 1) > 0 THEN

FOR j% = 1 TO NrVoices%

NootBind%(j%) = False:

IF P%(i&, Stem%(j%)) MOD 12 = VorigeNoot%(j%) MOD 12 AND (i& > 0) THEN

P%(i&, Stem%(j%)) = False: P%(i&, Stem%(j%) + 1) = False

NootBind%(j%) = True:

END IF

IF NootBind%(j%) = False THEN VorigeNoot%(j%) = P%(i&, Stem%(j%))

NEXT j%

END IF

i& = i& + 1

LOOP UNTIL i& > UBOUND(P%, 1)

' aangezien het nu echter kan voorvallen dat note-offs gebonden werden moeten we alle note offs weer terug plaatsen zoals ze stonden:

i& = 0

DO

IF (P%(i&, Stem%(0)) > 0) AND (P%(i&, Stem%(0) + 1) = False) THEN

FOR j% = 1 TO NrVoices%

IF P%(i&, Stem%(j%)) = False THEN

ii& = i&

DO

VorigeNoot%(j%) = P%(ii&, Stem%(j%)): ii& = ii& - 1

LOOP UNTIL (VorigeNoot%(j%) > 0) OR (ii& = 0)

P%(i&, Stem%(j%)) = VorigeNoot%(j%): P%(i&, Stem%(j%) + 1) = False

END IF

NEXT j%

END IF

i& = i& + 1

LOOP UNTIL i& > UBOUND(P%, 1)

END SUB

SUB Blank1059

FOR iloc% = 10 TO 59: LOCATE iloc%, 1: PRINT SPACE$(79);: NEXT iloc%

Logo

END SUB

FUNCTION FreqNote% (F!)

' deze funktie retourneert de midi-noot die het dichtst een overgedragen frekwentie benaderd.

FreqNote% = 12 * (LOG(F!) - LOG(Gronddo!)) / (LOG(2))

END FUNCTION

SUB GetMatrix

' needs on input: NrHarms%, NrNotes%, NrTrans% Returns: LadMat%(),resizes: NrTrans%, composes a transpositionmatrix based on NrHarms%, NrNotes% NrTrans%

OldNrTrans% = NrTrans%

REDIM LadMat%(NrNotes% * (NrTrans% + 1), 1 TO NrNotes%)

REDIM OldHarmSer%(0 TO NrHarms%): ' ? to NrNotes% ???

' Save original scale

Maakladder Tc% ' first rebuild it (with shared NrHarms%)

FOR i% = 1 TO NrNotes%:OldHarmSer%(i%) = HarmSeries%(i%):NEXT i%

' stap 1:Vul LadMat met alle mogelijke transposities

MetaPt% = 1: NrTrans% = 0

FOR i% = 0 TO OldNrTrans%

FOR j% = 1 TO NrNotes%

Toon% = OldHarmSer%(j%): Maakladder Toon%

FOR Hptr% = 1 TO NrNotes%: LadMat%(NrTrans%, Hptr%) = HarmSeries%(Hptr%):NEXT Hptr%

NrTrans% = NrTrans% + 1

NEXT j%

IF i% + 2 <= UBOUND(OldHarmSer%) THEN

Maakladder OldHarmSer%(i% + 2): ' may overflow!!!!

ELSE

MetaPt% = MetaPt% + 1

IF MetaPt% > NrNotes% THEN MetaPt% = 2

Maakladder LadMat%(NrTrans% - 1, MetaPt%)

END IF

FOR im% = 1 TO NrNotes%: OldHarmSer%(im%) = HarmSeries%(im%): NEXT im%

NEXT i%

NrTrans% = NrTrans% - 1

' nu hebben we een rechthoekige matrix.Alleen wanneer OldNrTrans%=0 is de matrix vierkant Deze gaan we verder uitdunnen.

' stap 2: onderzoek nu LadMat%() en zie of alle mogelijke noten erin voorkomen. Zoniet kunnen we immers niet vrij moduleren! We definieren een tijdelijk array, waarin we voor elke van de 12 noten aanduiden of ze al dan niet in de matrix staan. We initializeren het zo dat alle noten bij het begin afwezig zijn.

DIM noot%(0 TO 11)

FOR im% = 0 TO 11

noot%(im%) = False

NEXT im%

' we lopen de hele matrix af, tot we alle noten hebben teruggevonden. Vanzodra dat het geval is

NrTrans% = 0

DO

FOR jm% = 1 TO NrNotes%

FOR jim% = 0 TO 11

IF LadMat%(NrTrans%, jm%) = jim% THEN

noot%(jim%) = 1

END IF

NEXT jim%

NEXT jm%

' test nu voor de huidige stand van NrTrans% of we reeds alle noten hebben gehad:

tel% = 0

FOR jim% = 0 TO 11

tel% = tel% + noot%(jim%)

NEXT jim%

IF tel% = 12 THEN

EXIT DO

ELSE

NrTrans% = NrTrans% + 1

END IF

LOOP UNTIL tel% = 12

' De dimensionering van LadMat% is nu te groot.Om geheugen te sparen (vrij te maken) voeren we

' een kopieerroutine uit waarna de maten van LadMat% opnieuw optimaal zullen zijn

DIM Tmp%(0 TO NrTrans%, 1 TO NrNotes%)

FOR i% = 0 TO NrTrans%

FOR j% = 1 TO NrNotes%

SWAP Tmp%(i%, j%), LadMat%(i%, j%)

NEXT j%

NEXT i%

REDIM LadMat%(0 TO NrTrans%, 1 TO NrNotes%)

FOR i% = 0 TO NrTrans%

FOR j% = 1 TO NrNotes%

SWAP Tmp%(i%, j%), LadMat%(i%, j%)

NEXT j%

NEXT i%

ERASE Tmp%

' LadMat%(0 TO NrTrans%, 1 TO NrNotes%) is nu onze matrix die we volledig tonen aan de gebruiker:

ShowMatrix

END SUB

FUNCTION GetNote%

STATIC noot%, nt%, status%, velo%, vl%, FifoReadPtr%

SELECT CASE RTSource%

CASE False

' this function should return a note from the midibuffer Fifo% (the most recent note

' played, since it is monophonic) taking into regard only notes flowing in on

' the channel indicated (MidiInChannel%)

IF FifoReadPtr% = FifoWritePtr% THEN GetNote% = False: EXIT FUNCTION

DO UNTIL FifoReadPtr% = FifoWritePtr%

SELECT CASE Fifo%(FifoReadPtr%)

CASE IS >= 240

GOTO IncPtr

CASE IS > 144 + MidiInChannel%

' throw away... but reset variables...

nt% = 0: vl% = 0: status% = 0

GOTO IncPtr

CASE (144 + MidiInChannel%), (128 + MidiInChannel%)

status% = Fifo%(FifoReadPtr%)

nt% = False: ' reset note en velo logic

vl% = False

GOTO IncPtr

CASE IS < 128

IF status% = 144 + MidiInChannel% THEN

noot% = Fifo%(FifoReadPtr%)

nt% = True: vl% = False: status% = False

GOTO IncPtr

END IF

IF (status% = False) AND (nt% = True) THEN

velo% = Fifo%(FifoReadPtr%)

nt% = False: vl% = True: status% = True

GOTO IncPtr

END IF

IF status% = True THEN

' support for running status...

noot% = Fifo%(FifoReadPtr%)

nt% = True: vl% = False: status% = False

GOTO IncPtr

END IF

END SELECT

IncPtr:

FifoReadPtr% = (FifoReadPtr% + 1) AND MidiBuffer

LOOP

IF vl% = True THEN

NuNoot%(0) = noot%: ' these are shared!

NuVelo%(0) = velo%

GetNote% = True

ELSE

NuNoot%(0) = False

NuVelo%(0) = False

GetNote% = False

END IF

CASE 1

' egg input

' NuNoot%(0)= ADC%(...)

' NuVelo%(0) = ....

' GetNote%= True ... of ... False

GetNote% = False

CASE 2

' BOM input

GetNote% = False

CASE 3

' DIANA input

GetNote% = False

END SELECT

END FUNCTION

SUB Getparam1

' returns the real-time variable RealTim% as True or False. returns a value for the real-time input device in RTSource%

' returns the number of voices to be added in counterpoint: NrVoices% returns a number for Stem%(0), Stem%(1), Stem%(2), Stem%(3) ...

' Stem%(0) is always the voice number to be harmonized

ScrLine% = 10

RealTim% = False

Merging% = False

RTSource% = -1

Blank1059

Kleur 2 :LOCATE ScrLine%, 10: ScrLine% = ScrLine% + 1

PRINT "This program has two modes of operation:";

LOCATE ScrLine%, 15: ScrLine% = ScrLine% + 1

PRINT "1- It can work on an existing P%(i,j) input file";

LOCATE ScrLine%, 15: ScrLine% = ScrLine% + 1

PRINT "2- It can work on real-time device input";

LOCATE ScrLine%, 10: ScrLine% = ScrLine% + 1

PRINT "Choose an operational mode (1-2) [Default=1]";

Kleur 13 :RealTim% = -1

DO

k$ = INKEY$

IF k$ <> "" THEN RealTim% = VAL(k$)

LOOP UNTIL k$ <> "" AND (RealTim% > -1 AND RealTim% < 3)

IF RealTim% = 0 THEN RealTim% = False

IF RealTim% = 1 THEN RealTim% = False

IF RealTim% = 2 THEN RealTim% = True

IF RealTim% THEN

LOCATE ScrLine%, 10: Kleur 14: ScrLine% = ScrLine% + 1

PRINT "Choose input device:";

LOCATE ScrLine%, 15: ScrLine% = ScrLine% + 1

PRINT "0- Midi input";

LOCATE ScrLine%, 15: ScrLine% = ScrLine% + 1

PRINT "1- <EGG> device ";

LOCATE ScrLine%, 15: ScrLine% = ScrLine% + 1

PRINT "2- <Anacomp> device ";

LOCATE ScrLine%, 15: ScrLine% = ScrLine% + 1

PRINT "3- <Diana> device ";

LOCATE ScrLine%, 20: ScrLine% = ScrLine% + 1: Kleur 13

PRINT "Choice ?";

DO :k$ = INKEY$: LOOP UNTIL k$ <> ""

PRINT k$;

IF VAL(k$) > 0 AND VAL(k$) < 4 THEN

RTSource% = VAL(k$)

ELSE

RTSource% = 0: ' default= midi-input

END IF

END IF

SELECT CASE RealTim%

CASE IS = False

Rbin

DO

Blank1059: LOCATE 10, 5: Kleur 14

PRINT "Give number of the voice to be harmonized ?";

LOCATE 11, 5: Kleur 6: PRINT "(Select 1 to 7)";

LOCATE 11, 30: Kleur 13 : PRINT "Choice ?";

DO

k$ = INKEY$

LOOP UNTIL VAL(k$) > 0 AND VAL(k$) < 8

Pv% = VAL(k$)

IF Pv% = 0 THEN Pv% = 1: ' sets default

Pv% = (Pv% * 2) - 1: ' mapping on 1,3,5,7,9,11,13

LOOP UNTIL (Pv% MOD 2 = 1) AND (Pv% > 0) AND (Pv% < 14)

LOCATE 12, 5: Kleur 14

PRINT "Merge new chords with existing notes? (Y/N)";

DO

k$ = UCASE$(INKEY$)

LOOP UNTIL k$ <> ""

IF k$ = "Y" THEN Merging% = True ELSE Merging% = False

CASE IS = True

SELECT CASE RTSource%

CASE 0

' geval midi-input

Blank1059: LOCATE 10, 5: Kleur 14

PRINT "Give midi-channel to use as voice to be harmonized ?";

LOCATE 11, 5: Kleur 6: PRINT "(Select 0 to F [Hex])";

LOCATE 11, 30: Kleur 13: PRINT "Choice ?";

MidiInChannel% = -1

DO

k$ = UCASE$(INKEY$)

IF k$ <> "" THEN

k$ = "&H" + k$ ' nice programmers trick

MidiInChannel% = VAL(k$)

END IF

LOOP UNTIL MidiInChannel% >= 0 AND MidiInChannel% < 16

Pv% = 1: ' sets dummy

PRINT MidiInChannel%;

CASE 1

' geval <EGG> controller with contec-board

' to be implemented. Needs appropriate hardware...

Pv% = 1

CASE 2

' geval anacomp with Arcom board

Pv% = 1

CASE 3

' geval diana with contec board

Pv% = 1

END SELECT

END SELECT

LOCATE 13, 5: Kleur 14

PRINT "How many voices do you want to add (1-6)";

Kleur 13: PRINT "[3]?";

NrVoices% = -1

DO

k$ = INKEY$

IF k$ <> "" THEN NrVoices% = VAL(k$)

LOOP UNTIL NrVoices% > -1 AND NrVoices% < 7

IF NrVoices% = 0 THEN NrVoices% = 3 ' default= 4 voices

PRINT NrVoices%; "Voices chosen";

' Redimension arrays:

REDIM Stem%(0 TO NrVoices%)

REDIM VorigeNoot%(0 TO NrVoices%)

REDIM VorigeVelo%(0 TO NrVoices%)

REDIM NuNoot%(0 TO NrVoices%)

REDIM NuVelo%(0 TO NrVoices%)

REDIM VolgendeNoot%(0 TO NrVoices%)

REDIM Vlow%(0 TO NrVoices%)

REDIM Vhigh%(0 TO NrVoices%)

' Set voice to be harmonized to Pv%

Stem%(0) = Pv%

Valid% = False

DO

pl% = 15 ' schermregelcounter

FOR j% = 1 TO NrVoices%

LOCATE pl%, 5: pl% = pl% + 1: Kleur 14

PRINT "Give array-voice pointer of voice"; j%; " to be added...";

LOCATE pl%, 5: pl% = pl% + 1: Kleur 6

PRINT "(Select 1,2,3,4,5,6,7 but not ";

Kleur 9

IF j% > 1 THEN

FOR jj% = j% - 1 TO 0 STEP -1:PRINT (Stem%(jj%) \ 2) + 1; :NEXT jj%

Kleur 6: PRINT ")";

ELSE

PRINT (Stem%(0) \ 2) + 1;:Kleur 6: PRINT ")";

END IF

LOCATE pl%, 5: pl% = pl% + 1: Kleur 13

INPUT "Choice?"; kk%

Stem%(j%) = (kk% * 2) - 1

IF Stem%(j%) <= False THEN Stem%(j%) = (j% * 2) + 1:

' sets default 1,3,5,7,9...

LOCATE pl% - 1, 40

Kleur 12: PRINT "ptr="; (Stem%(j%) \ 2) + 1;

LOCATE pl%, 10: PRINT " "; : pl% = pl% + 1

NEXT j%

' fail-safe test op validiteit:

FOR jj% = 0 TO NrVoices%

FOR jjj% = jj% + 1 TO NrVoices%

IF Stem%(jj%) = Stem%(jjj%) THEN Valid% = True

NEXT jjj%

IF Stem%(jj%) MOD 2 = False THEN Valid% = True

NEXT jj%

LOOP UNTIL Valid% = False

END SUB

SUB GetToneSystem

' returns tonal center Tc% at start return a value for the Rubberbanding% variable, which determines the way modulations are handled.

' returns number of harmonics to build scale from checks working conditions: minimal number of notes in scale must be larger than NrVoices%

Blank1059:Tc% = -1:pl% = 10

LOCATE pl%, 10: Kleur 14: pl% = pl% + 1

PRINT "Give tonal center to start from? (0-127) ";

LOCATE pl%, 10: Kleur 13

DO

INPUT "Choice? "; Tc%

Tc% = Tc% MOD 12

LOOP UNTIL Tc% > -1 AND Tc% < 12

pl% = pl% + 2: ' get modulation style options:

LOCATE pl%, 10: Kleur 14: pl% = pl% + 1

PRINT "0- No Rubberbanding : Free modulation from "; Tc%;

LOCATE pl%, 10: Kleur 14: pl% = pl% + 1

PRINT "1- Gentle Rubberbanding: try to get back to tonal center";

LOCATE pl%, 10: Kleur 14: pl% = pl% + 1

PRINT "2- Severe Rubberbanding: always harmonize close to tonal center";

LOCATE pl%, 20: Kleur 13

PRINT "Choice ?";

DO: k$ = INKEY$: LOOP UNTIL k$ <> ""

PRINT k$;

pl% = pl% + 1

SELECT CASE VAL(k$)

Rubberbanding% = False

CASE 1

Rubberbanding% = 1

CASE 2

Rubberbanding% = 2

CASE ELSE

Rubberbanding% = False

END SELECT

' calculate minimum number of harmonics condition gebruik makend van de betreffende funktie

pl% = pl% + 1

MinNrHarms% = HarmSize%

' let the user adapt the number of harmonics if he thinks the minimum value is too small

LOCATE pl%, 10: Kleur 14: pl% = pl% + 1

PRINT "The minimum number of harmonics is ="; MinNrHarms%;

LOCATE pl%, 10: Kleur 14: pl% = pl% + 1

PRINT "Is this enough?";

Kleur 13: PRINT "(Y/N)? ";

DO: k$ = UCASE$(INKEY$): LOOP UNTIL k$ <> ""

PRINT k$;

IF k$ = "N" THEN

DO

LOCATE pl%, 10: Kleur 14

PRINT "How many harmonics do you want to use ?";

Kleur 13: INPUT k%

pl% = pl% + 1

LOOP UNTIL (k% > MinNrHarms%) AND (k% < 28)

NrHarms% = k%

ELSE

NrHarms% = MinNrHarms%

END IF

Maakladder Tc% ' Tc% moet gebleven zijn zoals opgegeven.

END SUB

SUB GetVoicing

Blank1059: pl% = 10

FOR i% = 1 TO NrVoices%

DO

LOCATE pl%, 5: pl% = pl% + 1: Kleur 14

LOCATE pl%, 5: pl% = pl% + 1: Kleur 13

INPUT "Choice? "; Vlow%(i%)

' default setting code:

IF Vlow%(i%) = 0 THEN

SELECT CASE Stem%(i%)

CASE 1

SELECT CASE NrVoices%

CASE 1

Vlow%(i%) = 62

CASE 2

Vlow%(i%) = 64

CASE 3

Vlow%(i%) = 66

CASE 4

Vlow%(i%) = 68

CASE 5

Vlow%(i%) = 70

CASE 6

Vlow%(i%) = 74

CASE ELSE

STOP

END SELECT

CASE 3

SELECT CASE NrVoices%

CASE 1

Vlow%(i%) = 48

CASE 2

Vlow%(i%) = 52

CASE 3

Vlow%(i%) = 55

CASE 4

Vlow%(i%) = 58

CASE 5

Vlow%(i%) = 63

CASE 6

Vlow%(i%) = 67

CASE ELSE

STOP

END SELECT

CASE 5

SELECT CASE NrVoices%

CASE 1

Vlow%(i%) = 48

CASE 2

Vlow%(i%) = 52

CASE 3

Vlow%(i%) = 54

CASE 4

Vlow%(i%) = 55

CASE 5

Vlow%(i%) = 56

CASE 6

Vlow%(i%) = 57

CASE ELSE

STOP

END SELECT

CASE 7

SELECT CASE NrVoices%

CASE 1

Vlow%(i%) = 48

CASE 2

Vlow%(i%) = 47

CASE 3

Vlow%(i%) = 40

CASE 4

Vlow%(i%) = 42

CASE 5

Vlow%(i%) = 43

CASE 6

Vlow%(i%) = 46

CASE ELSE

STOP

END SELECT

CASE 9

SELECT CASE NrVoices%

CASE 1

Vlow%(i%) = 48

CASE 2

Vlow%(i%) = 47

CASE 3

Vlow%(i%) = 46

CASE 4

Vlow%(i%) = 44

CASE 5

Vlow%(i%) = 42

CASE 6

Vlow%(i%) = 46

CASE ELSE

STOP

END SELECT

CASE 11

SELECT CASE NrVoices%

CASE 1

Vlow%(i%) = 48

CASE 2

Vlow%(i%) = 46

CASE 3

Vlow%(i%) = 44

CASE 4

Vlow%(i%) = 42

CASE 5

Vlow%(i%) = 40

CASE 6

Vlow%(i%) = 38

CASE ELSE

STOP

END SELECT

CASE 13

SELECT CASE NrVoices%

CASE 1

Vlow%(i%) = 46

CASE 2

Vlow%(i%) = 44

CASE 3

Vlow%(i%) = 42

CASE 4

Vlow%(i%) = 40

CASE 5

Vlow%(i%) = 38

CASE 6

Vlow%(i%) = 36

CASE ELSE

STOP

END SELECT

CASE ELSE

STOP: ' kan niet!

END SELECT

END IF

LOOP UNTIL Vlow%(i%) > 23 AND Vlow%(i%) < 73

LOCATE pl% - 1, 40:

Kleur 10: PRINT " low= "; Vlow%(i%);

DO

LOCATE pl%, 5: pl% = pl% + 1: Kleur 14

PRINT "Give highest midi-note for voice "; i%; "="; Stem%(i%); " ("; Vlow%(i%) + 12; "-110)";

LOCATE pl%, 5: pl% = pl% + 1: Kleur 13

INPUT "Choice? "; Vhigh%(i%)

IF Vhigh%(i%) = 0 THEN Vhigh%(i%) = Vlow%(i%) + 17: ' default

LOCATE pl% - 1, 40

Kleur 10: PRINT " high="; Vhigh%(i%);

LOCATE pl%, 10: PRINT " "; : pl% = pl% + 1

LOOP UNTIL Vhigh%(i%) > Vlow%(i%) + 11 AND Vhigh%(i%) < 111

NEXT i%

END SUB

SUB GradeAbochord

' schrijf een akkoord gelegen vlak boven de gegeven spektraalnoot

iloc% = 1 ' stemmenteller

cnt% = 1

DO

NuNoot%(iloc%) = HarmSeries%(HPointer% + cnt%)

IF iloc% = NrVoices% THEN EXIT DO

cnt% = cnt% + 1 : iloc% = iloc% + 1

LOOP UNTIL HPointer% + cnt% > UBOUND(HarmSeries%)

IF iloc% >= NrVoices% THEN EXIT SUB

' wanneer nog niet alle stemmen gevuld zijn nu, gaan we verder naar omlaag in de reeks

cnt% = 1

DO

NuNoot%(iloc%) = HarmSeries%(HPointer% - cnt%)

cnt% = cnt% - 1

IF iloc% = NrVoices% THEN EXIT DO

iloc% = iloc% + 1

LOOP UNTIL HPointer% - cnt% < 1

END SUB

SUB GradeBotChord

' This procedure writes a chord on the first NrVoices% notes of the harmonic series (1-2-3-4-> NrVoices%)

' memo: P%(i&, Stem%(0))= Harmseries%(HPointer%) of: NuNoot%(0)= HarmSeries%(HPointer%).generalized to accomodate n-part counterpoint.

iloc% = 1:cnt% = 1

DO

IF cnt% <> HPointer% THEN

NuNoot%(iloc%) = HarmSeries%(cnt%): iloc% = iloc% + 1

END IF

cnt% = cnt% + 1

LOOP UNTIL iloc% > NrVoices%

END SUB

SUB GradeCenChord

' writes the chord containing all harmonics as close as possible below and above, but adjacent to the given note

IF HPointer% < (NrVoices% / 2) THEN

GradeBotChord

EXIT SUB

END IF

IF HPointer% > (UBOUND(HarmSeries%) - (NrVoices% / 2)) THEN GradeTopChord:EXIT SUB

' Slechts in de nu nog overblijvende gevallen is het mogelijk het akkoord rond de gegeven

' noot op te bouwen.

loccnt% = 0

FOR iloc% = (NrVoices% / 2) TO 1 STEP -1

IF HPointer% - iloc% >= LBOUND(HarmSeries%) THEN

NuNoot%(iloc%) = HarmSeries%(HPointer% - iloc%):loccnt% = loccnt% + 1

END IF

NEXT iloc%

lnc% = 0

FOR iloc% = (NrVoices% / 2) TO NrVoices%

lnc% = lnc% + 1

IF HPointer% + lnc% <= UBOUND(HarmSeries%) THEN

NuNoot%(iloc%) = HarmSeries%(HPointer% + lnc%):loccnt% = loccnt% + 1

END IF

NEXT iloc%

' ingeval NrVoices% oneven is kan het voorvallen dat we door het resultaat

' van de integer-deling, een stem tekort hebben in het akkoord.Vandaar volgende korrektie:

IF loccnt% < NrVoices% THEN NuNoot%(NrVoices%) = HarmSeries%(HPointer% + iloc%)

END SUB

SUB GradeSubChord

' writes the chord containing all harmonics below and adjacent to the given note

SELECT CASE HPointer%

CASE IS > NrVoices%

FOR iloc% = NrVoices% TO 1 STEP -1

NuNoot%(iloc%) = HarmSeries%(HPointer% - iloc%)

NEXT iloc%

CASE ELSE

' in this case the chord can not be written!thus we correct and write a fundamental chord instead:

GradeBotChord

END SELECT

END SUB

SUB GradeTopChord

' This procedure writes a chord composed of the highest spectral notes

' belonging to the series in consideration

SELECT CASE HPointer%

CASE IS = UBOUND(HarmSeries%)

FOR iloc% = 1 TO NrVoices%

NuNoot%(iloc%) = HarmSeries%(HPointer% - iloc%)

NEXT iloc%

CASE ELSE

iloc% = NrVoices% :cnt% = 0

DO

NuNoot%(iloc%) = HarmSeries%(UBOUND(HarmSeries%) - cnt%)

IF iloc% = 1 THEN EXIT DO

cnt% = cnt% + 1 : iloc% = iloc% - 1

LOOP UNTIL UBOUND(HarmSeries%) - cnt% = HPointer%

IF iloc% < 1 THEN EXIT SUB

' schrikkel de gegeven noot over

cnt% = cnt% + 1

DO

IF UBOUND(HarmSeries%) - cnt% >= 1 THEN

NuNoot%(iloc%) = HarmSeries%(UBOUND(HarmSeries%) - cnt%)

cnt% = cnt% + 1

IF iloc% = 1 THEN EXIT DO

iloc% = iloc% - 1

ELSE

EXIT DO

END IF

LOOP UNTIL iloc% < 1

END SELECT

END SUB

FUNCTION HaalWijzer% (k%)

' deze funktie retourneert de plaats van de opgegeven stem in de harmonische reeks

' HarmSeries%() Wanneer deze funktie 0 retourneert, dan werd de opgegeven noot niet gevonden

' in de harmonische reeks en is ze als laddervreemd te beschouwen.

' k% moet de overgedragen noot zijn!

hp% = False: n% = 1

DO

IF k% MOD 12 = HarmSeries%(n%) THEN

hp% = n%

EXIT DO

ELSE

n% = n% + 1

END IF

IF n% > NrNotes% THEN EXIT DO

LOOP UNTIL hp%

HaalWijzer% = hp%

END FUNCTION

FUNCTION HarmSize% STATIC

' this function should return the minimum amount of harmonics a scale should be calculated on, in order

' to make all 12 imaginable modulations possible.nodige input variabelen: Tc%, NrVoices% (must be SHARED)

' save oldTc on init:

DIM GoodNotes%(1 TO 12) ' local!

OldTc% = Tc%

NrHarms% = (NrVoices% * 2): ' value to try on init.

ig% = 0

DO

NrTrans% = 0

DO

FOR i% = 1 TO 12: GoodNotes%(i%) = True: NEXT i%

Maakladder Tc%

REDIM OldHarmSer%(1 TO NrNotes%)

FOR i% = 1 TO NrNotes%: OldHarmSer%(i%) = HarmSeries%(i%): NEXT i%

FOR Ton% = OldHarmSer%(1) TO OldHarmSer%(NrNotes%)

NrTrans% = NrTrans% + 1

Maakladder Ton%

FOR testnoot% = 0 TO 11

' ga na of testnoot% voorkomt in de nu geldende toonladder:

HPointer% = HaalWijzer%(testnoot%)

IF HPointer% > 0 THEN

IF ig% > 0 THEN

nt% = True

FOR j% = 1 TO ig%

IF testnoot% = GoodNotes%(j%) THEN nt% = False

NEXT j%

IF nt% = True THEN

ig% = ig% + 1: GoodNotes%(ig%) = testnoot%

END IF

ELSE

ig% = ig% + 1: GoodNotes%(ig%) = testnoot%

END IF

END IF

NEXT testnoot%

NEXT Ton%

IF ig% = 12 THEN

GOTO Uitgang1

'EXIT DO

ELSE

ig% = 0: NrTrans% = 0 :NrHarms% = NrHarms% + 1

END IF

LOOP

Uitgang1:

IF NrNotes% > NrVoices% + 1 THEN

IF ig% = 12 THEN EXIT DO

ELSE

ig% = 0

NrTrans% = 0 : NrHarms% = NrHarms% + 1

END IF

LOOP

IF ig% < 12 THEN STOP

ERASE GoodNotes% ' clear memory on exit.

HarmSize% = NrHarms% :Tc% = OldTc%

Maakladder Tc%

END FUNCTION

SUB Kleur (k%)

IF KleurScherm THEN COLOR k%

END SUB

SUB Logo

' teken kader:

Kleur 1

t$ = CHR$(176)

LOCATE 1, 1: PRINT STRING$(80, t$);

LOCATE 5, 1: PRINT STRING$(80, t$);

LOCATE 2, 1: PRINT t$;

LOCATE 3, 1: PRINT t$;

LOCATE 4, 1: PRINT t$;

LOCATE 2, 80: PRINT t$;

LOCATE 3, 80: PRINT t$;

LOCATE 4, 80: PRINT t$;

' schrijf de tekst gecentreerd:

Kleur 13

ln% = LEN(Tit1$): Plaats% = (80 - ln%) / 2: Kleur 9

LOCATE 2, Plaats%: PRINT Tit1$;

ln% = LEN(Tit2$): Plaats% = (80 - ln%) / 2: Kleur 9

LOCATE 3, Plaats%: PRINT Tit2$;

ln% = LEN(Tit3$): Plaats% = (80 - ln%) / 2: Kleur 9

LOCATE 4, Plaats%: PRINT Tit3$;

IF RealTim% THEN

ln% = LEN(Tit4$): Plaats% = (80 - ln%) / 2: Kleur 14

LOCATE 59, Plaats%: PRINT Tit4$;

END IF

Kleur 2

ln% = LEN(Ver$): Plaats% = (80 - ln%) / 2: Kleur 9

LOCATE 60, Plaats%: PRINT Ver$;

Kleur 7

END SUB

SUB Maakladder (GrondToon%)

' returns notescales based on a given Tc% dimensions HarmSeries%() and Ladder%()

' returns NrNotes% : number of notes in scale

REDIM HarmSeries%(1 TO NrHarms%)

F0! = NoteFreq!(GrondToon%):

n% = 0

FOR i% = 1 TO NrHarms%

noot% = FreqNote%(F0! * i%) MOD 12 :skip% = False

IF i% > 1 THEN

' vergelijk dan of we die noot niet reeds hadden...

FOR j% = n% TO 1 STEP -1

IF noot% = HarmSeries%(j%) THEN skip% = True

NEXT j%

END IF

IF skip% = False THEN

n% = n% + 1: HarmSeries%(n%) = noot%

END IF

NEXT i%

NrNotes% = n%

' nu hebben we een harmonischen reeks in harmoniekvolgorde bestaande uit n% verschillende noten.

REDIM Ladder%(1 TO NrNotes%)

' kopieer nu deze reeks naar het ladderarray:

FOR i% = 1 TO NrNotes%: Ladder%(i%) = HarmSeries%(i%):NEXT i%

' pas nu opnieuw de maten van Harmseries%() aan:

REDIM HarmSeries%(1 TO NrNotes%)

' en kopieer de reeks opnieuw:

FOR i% = 1 TO NrNotes%:HarmSeries%(i%) = Ladder%(i%): NEXT i%

' sorteer nu ladder%() in opklimmende volgorde:

FOR i% = 1 TO NrNotes%

FOR j% = i% + 1 TO NrNotes%

IF Ladder%(j%) < Ladder%(i%) THEN SWAP Ladder%(i%), Ladder%(j%)

NEXT j%

NEXT i%

END SUB

SUB Melodize

' Deze procedure werkt op een integraal en afgwerkt P%() array

' bereken de centrale noot van de tessituur voor elke toe te voegen stem:

DIM Cnote%(0 TO NrVoices%) ' We use a local static array

DIM Melo%(0 TO NrVoices%)

FOR i% = 1 TO NrVoices%

Cnote%(i%) = (Vlow%(i%) + Vhigh%(i%)) / 2

NEXT i%

' Zoek de eerste noot in de partituur

i& = 0

DO

NextNote% = P%(i&, Stem%(0))

i& = i& + 1

IF i& > UBOUND(P%, 1) THEN EXIT DO

LOOP UNTIL NextNote% > 0

FOR j% = 1 TO NrVoices%:VorigeNoot%(j%) = P%(i& - 1, Stem%(j%)):NEXT j%

' leg nu de melodielijnen zo dat alle sprongen rond Cnote%(1) resp. Cnote%(2) ,Cnote%(3) draaien

i& = 0

DO

IF P%(i&, Stem%(0)) THEN

FOR j% = 1 TO UBOUND(P%, 2) STEP 2

FOR iml% = 1 TO NrVoices%

IF j% = Stem%(iml%) THEN

IF P%(i&, Stem%(iml%)) - Cnote%(iml%) > 6 THEN

DO

P%(i&, Stem%(iml%)) = P%(i&, Stem%(iml%)) - 12

LOOP UNTIL P%(i&, Stem%(iml%)) - Cnote%(iml%) <= 6

END IF

IF P%(i&, Stem%(iml%)) - Cnote%(iml%) < -6 THEN

DO

P%(i&, Stem%(iml%)) = P%(i&, Stem%(iml%)) + 12

LOOP UNTIL P%(i&, Stem%(iml%)) - Cnote%(iml%) >= -6

END IF

END IF

NEXT iml%

NEXT j%

' **************************************************************************

' Als een noot gelijk is aan haar voorganger binnen dezelfde stem, leg ze in hetzelfde oktaaf en set

' de logische variabele: aan deze stem mag niet meer geraakt worden in verdere melodizeringsprocedures.

' **************************************************************************

FOR iml% = 1 TO NrVoices%

IF VorigeNoot%(iml%) MOD 12 = P%(i&, Stem%(iml%)) MOD 12 THEN

IF VorigeNoot%(iml%) THEN P%(i&, Stem%(iml%)) = VorigeNoot%(iml%)

Melo%(iml%) = True

ELSE

Melo%(iml%) = False

END IF

NEXT iml%

' **************************************************************************

' Wanneer een noot gelijk is aan een noot die voorkomt in een andere stem, wissel dan de noten om, zodat we

' een noot in die stem kunnen laten liggen.

' **************************************************************************

FOR iml% = 1 TO NrVoices% - 1

FOR jml% = iml% + 1 TO NrVoices%

IF Melo%(iml%) + Melo%(jml%) = 0 THEN

IF VorigeNoot%(iml%) MOD 12 = P%(i&, Stem%(jml%)) MOD 12 THEN

SWAP P%(i&, Stem%(iml%)), P%(i&, Stem%(jml%))

P%(i&, Stem%(iml%)) = VorigeNoot%(iml%)

P%(i&, Stem%(jml%)) = ((VorigeNoot%(jml%) \ 12) * 12) + (P%(i&, Stem%(jml%)) MOD 12)

Melo%(iml%) = True

END IF

END IF

IF Melo%(iml%) + Melo%(jml%) = 0 THEN

IF VorigeNoot%(jml%) MOD 12 = P%(i&, Stem%(iml%)) MOD 12 THEN

SWAP P%(i&, Stem%(jml%)), P%(i&, Stem%(iml%))

P%(i&, Stem%(jml%)) = VorigeNoot%(jml%)

P%(i&, Stem%(iml%)) = ((VorigeNoot%(iml%) \ 12) * 12) + (P%(i&, Stem%(iml%)) MOD 12)

Melo%(jml%) = True

END IF

END IF

NEXT jml%

NEXT iml%

' ************************************************************************

' ga nu na of door omwisseling van noten tussen de stemmen, de intervallen niet kunnen worden geminimaliseerd

' We onderzoeken eerst sekonden, en verder grotere intervallen om zodoende een meer melodische stemvoering te verkrijgen.

' ************************************************************************

FOR Interval% = 2 TO 12

FOR iml% = 1 TO NrVoices - 1

FOR jml% = iml% + 1 TO NrVoices%

IF Melo%(iml%) = 0 THEN

IF Melo%(jml%) = 0 THEN

IF ABS((VorigeNoot%(iml%) MOD 12) - (P%(i&, Stem%(jml%)) MOD 12)) < Interval% THEN

SWAP P%(i&, Stem%(iml%)), P%(i&, Stem%(jml%))

P%(i&, Stem%(iml%)) = ((VorigeNoot%(iml%) \ 12) * 12) + (P%(i&, Stem%(iml%)) MOD 12)

P%(i&, Stem%(jml%)) = ((VorigeNoot%(jml%) \ 12) * 12) + (P%(i&, Stem%(jml%)) MOD 12)

Melo%(iml%) = -1

END IF

END IF

END IF

NEXT jml%

NEXT iml%

NEXT Interval%

' ***************************************************************************

FOR iml% = 1 TO NrVoices%:VorigeNoot%(iml%) = P%(i&, Stem%(iml%)):NEXT iml%

END IF

i& = i& + 1

LOOP UNTIL i& > UBOUND(P%, 1)

ERASE Melo% ' clean up memory for reuse.

ERASE Cnote%

END SUB

SUB Midi (byte%)

' midi I/O routine. ' de counter FifoWritePtr% (SHARED!)wordt hier vooruitgeschoven.

' Deze counter is dus steeds >= FifoReadPtr% in de funktieprocedure GetNote%.

' Voor het uitsturen van midi-info wordt geen buffer gebruikt.

IF INP(Sp) < 128 THEN

DO

dummy% = INP(Dp)

IF dummy% < 240 THEN

Fifo%(FifoWritePtr%) = dummy%

FifoWritePtr% = (FifoWritePtr% + 1) AND MidiBuffer

END IF

LOOP UNTIL INP(Sp) AND 128

END IF

IF byte% > True THEN WAIT Sp, 64, 64: OUT Dp, byte%

END SUB

SUB Mplay

DIM no%(16):DIM nv%(16):Blank1059:Logo

DO: k$ = INKEY$: LOOP UNTIL k$ = ""

LOCATE 10, 10: Kleur 14

PRINT "Do you want to hear this spectral counterpoint? (Y/N) ";

DO :k$ = UCASE$(INKEY$):LOOP UNTIL k$ <> ""

IF k$ = "Y" THEN

LOCATE 12, 10: Kleur 14:PRINT "Tempo (MM Metronome number) ?:";

Kleur 13: INPUT MM

Tmp# = 60 / (MM * 8): ' de tweeendertigste noot is de eenheid in het array

FOR i& = 0 TO UBOUND(P%, 1)

T0# = TIMER

FOR ij% = 1 TO NrVoices%: 'UBOUND(P%, 2) STEP 2

j% = (ij% * 2) - 1

IF P%(i&, j%) > 0 THEN

IF no%(j%) AND (nv%(j%) > 0) THEN

Uit (143 + ij%):Uit no%(j%):Uit (0):no%(j%) = False:nv%(j%) = False

END IF

Uit (143 + ij%):Uit (P%(i&, j%)):Uit (P%(i&, j% + 1))

no%(j%) = P%(i&, j%): nv%(j%) = P%(i&, j% + 1)

END IF

NEXT ij%

DO UNTIL TIMER - T0# >= Tmp#: LOOP

NEXT i&

END IF

SLEEP 1

DO: LOOP UNTIL INKEY$ = ""

LOCATE 24, 10: Kleur 14:PRINT " Push any key to continue ... ";

DO: LOOP UNTIL INKEY$ <> ""

Blank1059

' schakel alle noten uit:

FOR j% = 1 TO NrVoices%:Uit (143 + j%): Uit (no%((j% * 2) - 1)): Uit 0:NEXT j%

END SUB

SUB Mpuuart

INITUART:

IF INP(&H331) AND 128 THEN

WAIT &H331, 64, 64:OUT &H331, &H3F: ' = 0011 1111 (63) =UART-command

ELSE

WHILE INP(&H331) < 128: dummy = INP(&H330):WEND: GOTO INITUART

END IF

END SUB

FUNCTION NoteFreq! (byte%)

NoteFreq! = Gronddo! * (2 ^ (byte% / 12))

END FUNCTION

SUB Rbin

Blank1059:LOCATE 10, 10: Kleur 14

PRINT "Give input *.BIN file + path to harmonize";

LOCATE 12, 10: Kleur 13:INPUT "Choice? "; Infile$

Infile$ = UCASE$(Infile$):Infile$ = LTRIM$(RTRIM$(Infile$))

IF RIGHT$(Infile$, 4) <> ".BIN" THEN Infile$ = Infile$ + ".BIN"

i& = 0: j% = 0

OPEN Infile$ FOR BINARY AS #1

REDIM P%(0 TO LOF(1) \ 16, 0 TO 15)

LOCATE 15, 10: Kleur 10

PRINT "Reading "; Infile$; ". Lenght= "; LOF(1); " Wait please...";

k& = 1

WHILE NOT EOF(1)

GET #1, k&, x&

IF x& <> 0 THEN

P%(i&, j%) = x& MOD &H100: x& = (x& - P%(i&, j%)) \ 256

P%(i&, j% + 1) = x& MOD &H100: x& = (x& - P%(i&, j% + 1)) \ 256

P%(i&, j% + 2) = x& MOD &H100: x& = (x& - P%(i&, j% + 2)) \ 256

P%(i&, j% + 3) = x& MOD &H100

ELSE

P%(i&, j%) = 0:P%(i&, j% + 1) = 0

P%(i&, j% + 2) = 0: P(i&,j% + 3) = 0

END IF

k& = k& + 4: ' var is telkens 8 bytes lang

j% = j% + 4: IF j% = 16 THEN i& = i& + 1

j% = j% MOD 16

WEND

CLOSE #1

Kleur 7

END SUB

SUB RTbinder

' Deze Binder werkt in real-time. Nodige input: NuNoot%(0 TO NrVoices%), VorigeNoot%(0 TO NrVoices%)

' De variabele VorigeNoot% wordt aangepast on exit. Hij dient te worden ingezet, voor de noten (NuNoot%()) via midi worden geschreven.

' wanneer een noot gelijk is aan haar voorganger, sla ze dan niet opnieuw aan, maar bind ze met de vorige noot.

' Deze procedure werd reeds veralgemeend tot n-stemmen.Er zit ook kode in voor een minimale melodizering...

FOR ib% = 1 TO NrVoices%

DO

NuNoot%(ib%) = NuNoot%(ib%) + 12

LOOP UNTIL NuNoot%(ib%) >= Vlow%(ib%)

' leg de nu te spelen noten in het midden van de opgegeven tessituur ' (dit kan verbeterd worden: ipv de kwint als konstante kunnen we vergelijken met Htes%(ib%) - Ltes%(ib%) /2 ipv het vaste interval, kan ook gekeken worden naar het interval tussen vorige en huidige noot.

IF NuNoot%(ib%) AND NuVelo%(ib%) THEN

Ctes% = (Vlow%(ib%) + Vhigh%(ib%)) / 2

SELECT CASE NuNoot%(ib%) - Ctes%

CASE IS > 7

DO

NuNoot%(ib%) = NuNoot%(ib%) - 12

LOOP UNTIL NuNoot%(ib%) - Ctes% <= 7

CASE IS < -7

DO

NuNoot%(ib%) = NuNoot%(ib%) + 12

LOOP UNTIL NuNoot%(ib%) - Ctes >= -7

END SELECT

END IF

' bind nu noten die gelijk zijn aan hun voorganger:

IF VorigeNoot%(ib%) THEN

IF VorigeVelo%(ib%) THEN

IF VorigeNoot%(ib%) = NuNoot%(ib%) THEN

NuNoot%(ib%) = 0: NuVelo%(ib%) = 0

ELSE

VorigeNoot%(ib%) = NuNoot%(ib%):VorigeVelo%(ib%) = NuVelo%(ib%)

END IF

ELSE

VorigeNoot%(ib%) = NuNoot%(ib%):VorigeVelo%(ib%) = NuVelo%(ib%)

END IF

ELSE

VorigeNoot%(ib%) = NuNoot%(ib%):VorigeVelo%(ib%) = NuVelo%(ib%)

END IF

NEXT ib%

END SUB

Blank1059: Kleur 13: vertipos% = 10 :horipos% = 80 - (NrNotes% * 4)

LOCATE vertipos%, horipos%:PRINT "MODULATIEMATRIX:"

FOR il% = 0 TO NrTrans%

FOR ij% = 1 TO NrNotes%

LOCATE vertipos% + il% + 1, horipos% + ((ij% - 1) * 4):PRINT LadMat%(il%, ij%);

NEXT ij%

NEXT il%

END SUB

SUB TestChords

' deze procedure test het voorkomen van nootverdubbelingen in de akkoorden.Dit mag in dit harmonieontwerp immers niet voorkomen.De procedure wordt alleen gebruikt voor het debuggen

LOCATE 40, 10: Kleur 13: PRINT "Teller =";: PRINT USING "########"; i&

LOCATE 41, 10: Kleur 13: PRINT DebugMsg$; " ";:LOCATE 42, 10: Kleur 13: PRINT "Next note = ";

PRINT USING "###"; VolgendeNoot%(0);:LOCATE 43, 10: Kleur 13: PRINT "Tonal Center= ";

PRINT USING "###"; Tc%;

IF NuNoot%(0) > 0 AND NuVelo%(0) > 0 THEN

FOR idb% = 1 TO NrVoices%

IF NuNoot%(idb%) THEN

FOR jdb% = idb% + 1 TO NrVoices%

IF NuNoot%(jdb%) THEN

IF NuNoot%(idb%) MOD 12 = NuNoot%(jdb%) MOD 12 THEN BEEP: GOSUB Druksituatie

END IF

NEXT jdb%

END IF

NEXT idb%

END IF

EXIT SUB

Druksituatie:

Kleur 12: LOCATE 50, 10: PRINT "Tema";:PRINT USING "##"; Stem%(0); : PRINT " =";

PRINT USING "##"; NuNoot%(0) MOD 12;: PRINT " Vel=";:PRINT USING "###"; NuVelo%(0);:

FOR itmp% = 1 TO NrVoices%

LOCATE 50 + itmp%, 10:PRINT "Harm";: PRINT USING "##"; Stem%(itmp%);

PRINT " =";: PRINT USING "##"; NuNoot%(itmp%) MOD 12;

PRINT " Vel=";: PRINT USING "###"; NuVelo%(itmp%);

NEXT itmp%

SLEEP

RETURN

END SUB

SUB Uit (byte%)

WHILE INP(Sp) < 128: dummy% = INP(Dp): WEND

WAIT Sp, 64, 64: OUT Dp, byte%: EXIT SUB

END SUB

SUB Writfil

Blank1059:Logo:\LOCATE 10, 10: Kleur 14:PRINT "Save this choral as a *.bin file? (Y/N)";

DO: k$ = INKEY$: LOOP UNTIL k$ <> ""

IF UCASE$(k$) = "Y" THEN

LOCATE 12, 10: Kleur 14

PRINT "Filename for writing this choral? (no extension)";:Kleur 13: INPUT Uitfile$

LOCATE 14, 10: Kleur 12 :PRINT " Writing bin-file "; Uitfile$; " to disk...";

Lastvoice% = 0

FOR itmp% = 0 TO NrVoices%

IF Lastvoice% < Stem%(itmp%) THEN Lastvoice% = Stem%(itmp%)

NEXT itmp%: ' de stem met het hoogste cijfer staat nu in Lastvoice%

Nul% = 0:k& = 1: ' k& geeft aantal bytes in de file...

OPEN Uitfile$ FOR BINARY AS #1

FOR i& = 0 TO UBOUND(P%, 1)

FOR j% = 0 TO UBOUND(P%, 2)

IF j% < Lastvoice% + 2 THEN

PUT #1, k&, P%(i&, j%): k& = k& + 1

ELSE

PUT #1, k&, Nul%: k& = k& + 1

END IF

NEXT j%

NEXT i&

CLOSE #1

END IF

END SUB

Filedate: 940921