Hogeschool Gent - Departement Muziek en Drama

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

' S H I F T S

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

'Original: 1987

'$DYNAMIC

COMMON SHARED DP AS INTEGER, byte AS INTEGER

COMMON SHARED /Arrays/ Nte() AS INTEGER, Hy() AS INTEGER

COMMON SHARED /midi/ midi() AS INTEGER, mid() AS INTEGER

COMMON SHARED Cent() AS INTEGER

COMMON SHARED /Binarray/ P1() AS INTEGER, P2() AS INTEGER

COMMON SHARED Nottot AS INTEGER

COMMON SHARED PK AS INTEGER

COMMON SHARED Maxtim AS INTEGER

COMMON SHARED Broken AS INTEGER

COMMON SHARED Arpeg AS INTEGER

COMMON SHARED Mipar AS INTEGER

COMMON SHARED t AS INTEGER

COMMON SHARED Ins() AS INTEGER, Bank() AS INTEGER

COMMON SHARED Synth$, FB01$, version$

COMMON SHARED Scherm() AS STRING

DEFINT A-Y

DECLARE SUB Binarray ()

DECLARE SUB Uit (byte AS INTEGER)

DECLARE SUB Menu0 ()

DECLARE SUB Display ()DECLARE SUB Menu2 ()

DECLARE SUB Tempo ()

DECLARE SUB Logo ()

DECLARE SUB Lfopan ()

DECLARE SUB Volume ()

DECLARE SUB FB01Bendon ()

DECLARE SUB PROTBendon ()

DECLARE SUB PROFBendon ()

DECLARE SUB VoicesFB01 ()

DECLARE SUB Allesuit ()

' declarations of dimensioned variables:

DIM Scherm(25) AS STRING

DIM Nt(16) AS INTEGER

DIM Hx(16) AS INTEGER

' declare transposition array

DIM Trans(20) AS INTEGER

DIM Nte(7) AS INTEGER: ' hierin worden de noten AT tot HT overgeschreven

' declare array with midi notes for midi simulator

' routine ( 2 copy's)

DIM midi(7, 15) AS INTEGER

DIM mid(7, 15) AS INTEGER: ' mid is source - midi is for transposition

' declare array with cents-corrections for just intonation

' version. This is only needed for FB01 and generic synths.

' Both TX81Z and Proteus can be switched to just intonation on the flash

DIM Cent(7, 15) AS INTEGER

' declare array with default instrumentation

DIM Oldnot(7) AS INTEGER: ' for implementation of note-off codes

DIM Ins(7) AS INTEGER

DIM Bank(7) AS INTEGER: ' for FB01 only

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

' get parameters Mipar, Synth$, FB01$, Version$

Menu0

' Lees de SHIFTS.CFG file:

OPEN "SHIFTS.CFG" FOR INPUT AS #1

DO UNTIL EOF(1)

INPUT #1, dummy$

SELECT CASE dummy$

CASE "MIDI_adress"

INPUT #1, DP

IF DP = &H330 THEN PK = 7

CASE "MIDI_IRQ"

INPUT #1, Mirq: ' not used

CASE "ROOTNUMBERS"

INPUT #1, RA: INPUT #1, RB: INPUT #1, RC: INPUT #1, RD

INPUT #1, RE: INPUT #1, RF: INPUT #1, RG: INPUT #1, RH

CASE "TRANSPOSITIONS"

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = version$

FOR i = 0 TO 15: INPUT #1, Trans(i): NEXT i

CASE "VOICE_NOTES"

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = version$

ii = 0

DO

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = "VOICE"

INPUT #1, i: INPUT #1, dummy$

IF dummy$ <> "NOTES" THEN STOP

FOR j = 0 TO 15

INPUT #1, mid(i, j)

ii = ii + 1

NEXT j

LOOP UNTIL ii = 16 * 8

IF version$ = "JUST" THEN

ii = 0

DO

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = "VOICE"

INPUT #1, i

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = "CENTS"

FOR j = 0 TO 15

INPUT #1, Cent(i, j)

ii = ii + 1

NEXT j

LOOP UNTIL ii = 16 * 8

END IF

CASE "SYNTHESIZER"

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = Synth$

IF Synth$ = "FB01" THEN

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = FB01$

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = "INSTRUMENTS"

FOR i = 0 TO 7: INPUT #1, Ins(i): NEXT i

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = "BANK"

FOR i = 0 TO 7: INPUT #1, Bank(i): NEXT i

ELSE

DO: INPUT #1, dummy$: LOOP UNTIL dummy$ = "INSTRUMENTS"

FOR i = 0 TO 7: INPUT #1, Ins(i): NEXT i

END IF

CASE "LOGOSCREEN"

FOR i = 1 TO 5

LINE INPUT #1, Scherm$(i)

NEXT i

CASE "HOTKEYSCREEN"

FOR i = 6 TO 13

LINE INPUT #1, Scherm$(i)

NEXT i

END SELECT

LOOP

CLOSE #1

IF Mipar AND (DP = 0) THEN Menu2

IF DP = &H330 THEN SHELL "MPUUART.EXE"

Display

Nottot = (RA ^ RB) * (RB ^ RA) * RD * RF

' dimensionering van dynamische arrays:

DIM Hy(Nottot + 80, 7) AS INTEGER

DIM P1(Nottot + 80, 8) AS INTEGER: ' stemmen 1 tot 4

DIM P2(Nottot + 80, 8) AS INTEGER: ' stemmen 5 tot 8

LOCATE 24, 20: PRINT "Totaal aantal tellen= "; Nottot;

Transpose = 0

FOR i = 0 TO 7: FOR j = 0 TO 15: midi(i, j) = mid(i, j): NEXT j: NEXT i

'************* M I D I - I N I T I A L I S A T I E **************

MIDINIT:

Maxtim = 1

SELECT CASE Synth$

CASE "FB01" FB01Bendon

SELECT CASE FB01$

CASE "FB01_PIANO"

Uit (192): Uit (5):

Uit (&HF0): Uit (&H43):

Uit (16): Uit (&H15): Uit (0): Uit (8): Uit (&HF7)

' sets instrument to piano, sets 8 notes polyphony on channel 0 (FB01)

CASE ELSE

VoicesFB01

Lfopan

END SELECT

Volume

CASE "PROFORMANCE"

PROFBendon

Uit (192): Uit (0)

CASE "PROTEUS3"

PROTBendon

FOR i = 0 TO 7: Uit (&HC0 + i): Uit (Ins(i)): NEXT i

Lfopan

Volume

CASE "PROTEUS2"

PROTBendon

FOR i = 0 TO 7: Uit (&HC0 + i): Uit (Ins(i)): NEXT i

Lfopan

Volume

CASE "DEFAULT"

Lfopan

Volume

CASE "PLAYER"

Uit (192): Uit (0)

END SELECT

' einde midi-installatieverwijzingssubroutine

Tempo

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

SCORE:

t = 0

AC = -1: BC = -1: CC = -1: DC = -1: EC = -1: FC = -1: GC = -1: HC = -1

Logo

IF DP THEN

FOR i = 6 TO 13

LOCATE i, 1: PRINT Scherm(i);

NEXT i

END IF

LOCATE 15, 10: PRINT "Parameters:";

LOCATE 16, 25: PRINT "Pulse-time: "; Maxtim; " ";

LOCATE 17, 25: PRINT "Sustain : "; Noteoff;

' begin van het eigenlijke komponeeralgoritme

DO

Brk$ = INKEY$

IF Brk$ <> "" THEN

' new ... for keyboard interaction:

IF Brk$ = "*" THEN EXIT DO

IF Brk$ = "-" THEN Maxtim = Maxtim + 1

IF Brk$ = "+" THEN Maxtim = Maxtim - 1

IF Brk$ = "x" THEN Maxtim = Maxtim / 2

IF Brk$ = "/" THEN Maxtim = Maxtim * 2

IF Brk$ = "n" THEN Noteoff = 0

IF Brk$ = "y" THEN Noteoff = 1

IF Maxtim < 0 THEN Maxtim = 0

LOCATE 16, 25: PRINT "Pulse-time: "; Maxtim; " ";

LOCATE 17, 25: PRINT "Sustain : "; Noteoff;

END IF

' A-partij uitsluitend voor slagwerk/piano - ad libitum

A = t MOD RA

AIF:

IF A = 0 THEN

AC = AC + 1: ACHK = RH * RG * RF

ABEGINIF:

IF t < ACHK THEN

IF HT < 1 THEN AT = 0

IF HT > 0 THEN AT = AC MOD ((HT \ 2) + 1)

ELSE

IF t > ACHK - 1 THEN AT = AC MOD (BT + 1)

IF t > (Nottot \ (RH * RA)) THEN AT = AC MOD 7

IF t > (Nottot \ RH) THEN AT = RND(1) * (AC MOD 6)

IF t > (Nottot \ RG) THEN AT = 7 - (RND(1) * (AC MOD 7))

IF t > (Nottot \ RE) THEN AT = 2 + (7 - (RND(1) * (AC MOD 5)))

IF t > (Nottot \ RB) THEN AT = 3 + (6 - (RND(1) * (AC MOD 4)))

IF t > (Nottot \ RA) THEN AT = 4 + (5 - (RND(1) * (AC MOD 3)))

IF t > ((Nottot \ RB) * RA) THEN AT = 8 - Som

END IF

D0 = 1

ELSE

D0 = 0

END IF

' B-partij deelfaktor 3

B = t MOD RB

BIF:

IF B = 0 THEN

BC = BC + 1

BCHK = Nottot \ RE

BBEGINIF:

IF t < BCHK THEN

IF HT < 1 THEN BT = 0 ELSE IF HT > 0 THEN BT = (BC MOD HT)

GOTO BKLAR:

ELSE

IF t = BCHK THEN IF HT > 0 THEN BT = BC MOD HT

IF t > BCHK THEN BT = BC MOD RF

IF t > Nottot \ RD THEN BT = 1 + (BC MOD RE)

IF t > Nottot \ RB THEN BT = 2 + (BC MOD RD)

IF t > (Nottot \ RF) * RB THEN BT = 3 + (BC MOD RC)

IF t > Nottot \ RA THEN BT = (RND(1) * 4) + (BC MOD RB)

IF t > (Nottot \ RD) * RB THEN BT = (RND(1) * 5) + (BC MOD RA)

IF t > (Nottot \ RF) * RD THEN BT = 2 + (RND(1) * 3) + (BC MOD RA)

IF t > (Nottot \ RF) * RG THEN BT = 4 + (RND(1) * 2) + (BC MOD RA)

IF Som > 6 AND t > (RH * RH) THEN BT = 9 - Som

BKLAR:

END IF

D1 = 1

ELSE

D1 = 0 END IF

' C-partij deelfaktor 4

C = t MOD RC

CIF:

IF C = 0 THEN

CC = CC + 1

CBEGINIF:

IF t < Nottot \ RD THEN

IF HT = 0 OR HT < 0 THEN CT = 0

IF ((HT > 0) AND (HT < 10)) THEN CT = (CC MOD (HT + 1))

IF HT > 9 THEN CT = CC MOD (HT - 7)

ELSE

IF CC MOD RC = 0 AND CT > 0 AND CT < 13 AND t < (Nottot * 4) \ 5 THEN

CT = CT + (RND(1) * 2) - 1: GOTO CKLAR

ENDIF

IF t > Nottot \ RD THEN CT = CC MOD 9

IF t > (Nottot \ RD) * RA THEN CT = 10 - (CC MOD RH) + ((RND(1) * 2) - 1)

IF t > (Nottot \ RD) * RB THEN CT = 10 - (CC MOD RF)

IF t > (Nottot \ RD) * RC THEN CT = 1 + (2 * RND(1)) + (7 - (CC MOD RE))

IF t > ((Nottot \ RH) * RE) + RH THEN CT = 14 - (CC MOD 13)

IF Som > 4 THEN CT = (CC MOD Som) + 1

CKLAR:

END IF

D2 = 1

ELSE

D2 = 0

END IF

' D-partij deelfaktor 5

D = t MOD RD

DIF:

IF D = 0 THEN

DC = DC + 1

DBEGINIF:

IF t < RG * RF * RE * RA THEN

IF HT < 1 THEN DT = 0 ELSE DT = DC MOD HT

ELSE

IF (DC MOD RD) = 0 AND DT > 0 AND DT < 12 THEN DT = DT + (RND(1) * 2) - 1: GOTO DKLAR

IF HT < 1 THEN i = 3 ELSE i = HT

IF HC > 15 THEN DT = DC MOD i

IF HT < 2 THEN i = RD ELSE i = HT

IF HC > 25 THEN DT = 1 + (DC MOD (i - 1))

IF HT < 3 THEN i = RD ELSE i = HT

IF HC > 50 THEN DT = 2 + (DC MOD (i - 2))

IF HT < 4 THEN i = RD ELSE i = HT

IF HC > 75 THEN DT = 3 + (DC MOD (i - 3))

IF HT < 5 THEN i = RD ELSE i = HT

IF HC > 100 THEN DT = 4 + (DC MOD (i - 4))

IF HC > 125 THEN DT = (RND(1) * 5) + (DC MOD 11)

IF HC > 150 THEN DT = (RND(1) * 6) + (DC MOD 10)

IF HC > 175 THEN DT = (RND(1) * 7) + (DC MOD 9)

IF HC > 200 THEN DT = 4 + (RND(1) * 4) + (DC MOD 8)

IF HC > 225 THEN DT = 5 + (RND(1) * 3) + (DC MOD 7)

IF HC > 250 THEN DT = 10 + (RND(1) * 2) + (DC MOD 3)

IF t > (Nottot \ RG) * RF THEN DT = 15 - (DC MOD 14)

IF Som > 5 AND t > (RH * RH) THEN DT = DC MOD (2 * Som)

DKLAR:

END IF

IF DT > 13 THEN DT = 13

D3 = 1

ELSE

D3 = 0

END IF

' E-partij deelfaktor 6

E = t MOD RE

EIF:

IF E = 0 THEN

EC = EC + 1

ECHK = RE * RD * RC * RB * RA

EBEGINIF:

IF t < ECHK THEN

IF HT < 1 THEN ET = 0 ELSE ET = EC MOD HT

IF t > ECHK \ 2 THEN ET = (EC MOD HT) + ((RND(1) * 2) - 2)

IF t < ECHK THEN GOTO EKLAR

ELSE

IF (EC MOD RE) = 0 AND ET > 0 AND ET < 14 THEN ET = ET + (RND(1) * 2) - 1: GOTO EKLAR

IF t > ((Nottot \ (RH * RA)) - 1) THEN ET = EC MOD 15

IF t > (Nottot \ (RE * RA)) THEN ET = 1 + (RND(1) * (EC MOD 14))

IF t > Nottot \ RF THEN ET = 15 - (RND(1) * (EC MOD 14))

IF t > Nottot \ RB THEN ET = 2 + (13 - (RND(1) * (EC MOD 12)))

IF t > Nottot \ RA THEN ET = 4 + (11 - (RND(1) * (EC MOD 10)))

IF t > (Nottot \ RD) * RB THEN ET = 6 + (9 - (RND(1) * (EC MOD 8)))

IF t > (Nottot \ RD) * RC THEN ET = 8 + (7 - (RND(1) * (EC MOD 6)))

IF t > (Nottot \ RF) * RE THEN ET = 15 - (EC MOD 15)

IF Som > 4 AND t > (RH * RG * RF) THEN ET = 7 + (EC MOD Som)

EKLAR:

IF Som = 8 AND t > 1 THEN ET = RE

END IF

IF ET < 0 THEN ET = 0

IF ET > 15 THEN ET = 15

D4 = 1

ELSE

D4 = 0

END IF

' F-partij deelfaktor 7

F = t MOD RF

FIF:

IF F = 0 THEN

FC = FC + 1

FCHK = Nottot \ RB

FBEGIN:

IF t < FCHK THEN

IF HT < 2 THEN FT = 0 ELSE

IF (HT > 1) THEN IF (HC < 36) THEN FT = FC MOD HT ELSE

IF (FT > 12) THEN FT = FT - 6 ELSE

IF (HC > 35) THEN FT = FC MOD 12 ELSE

IF (HC > 70) THEN FT = 3 + (FC MOD RH) ELSE

IF (HC > 105) THEN FT = (RND(1) * 5) + (FC MOD 6)

IF t < FCHK THEN GOTO FKLAR

ELSE

IF t > (Nottot \ RB) THEN FT = 12 - (FC MOD 9)

IF t > (Nottot \ RD) * RC THEN FT = 8 + (RND(1) * (FC MOD 4))

IF t > (Nottot \ RF) * RE THEN FT = 12 - (RF * (RND(1)))

IF t > (Nottot \ RH) * RG THEN FT = 12 - (FC MOD 10)

IF Som > 4 THEN FT = 6 + (FC MOD Som)

IF Som = 8 AND t > 1 THEN FT = RF

FKLAR:

END IF

IF FT > 15 THEN FT = 15

D5 = 1

ELSE

D5 = 0

END IF

' G-partij deelfaktor 8

G = t MOD RG

GIF:

IF G = 0 THEN

GC = GC + 1

GCHK = Nottot \ RB

GIFBEGIN:

IF t < GCHK THEN

IF HT < 3 THEN GT = 0 ELSE

IF (HT > 2) THEN IF (HC < 48) THEN GT = GC MOD HT ELSE

IF GT > 14 THEN GT = GT - 8 ELSE

IF HC > 47 THEN GT = GC MOD 14 ELSE

IF HC > 71 THEN GT = 7 + (GC MOD (Som + 1))

IF t < GCHK THEN GOTO GKLAR

ELSE

IF t > (Nottot \ RB) THEN GT = 2 + (GC MOD 13)

IF t > (Nottot \ RB) * RA THEN GT = Som + (GC MOD 15)

IF t > (Nottot \ RF) * RD THEN GT = Som + 7 - (GC MOD 7)

IF t > (Nottot \ RH) * RG THEN GT = 15 - (GC MOD 15)

IF (t > 0 AND Som > 5) THEN GT = (GC MOD Som + 1) + 5

IF Som = 8 AND t > 1 THEN GT = RG

GKLAR:

IF GT > 14 THEN GT = 14 - (RND(1) * Som)

END IF

D6 = 1

ELSE

D6 = 0

END IF

' H-partij deelfaktor 9

H = t MOD RH

HIF:

IF H = 0 THEN

HC = HC + 1

HSTARTIF:

IF HC < 71 THEN

IF HC = 1 THEN HT = 0

IF HC = 2 THEN HT = 1

IF HC = 3 THEN HT = 0

IF HC = 4 THEN HT = 1

IF HC = 5 THEN HT = 2

IF HC = 6 THEN HT = 1

IF HC = 7 THEN HT = 0

IF HC > 7 AND HC < 11 THEN HT = HT + 1

IF HC > 10 AND HC < 13 THEN HT = HT - 1

IF HC > 12 AND HC < 16 THEN HT = HT + 1

IF HC > 15 AND HC < 18 THEN HT = HT - 1

IF HC > 17 AND HC < 21 THEN HT = HT + 1

IF HC > 20 AND HC < 23 THEN HT = HT - 1

IF HC > 22 AND HC < 26 THEN HT = HT + 1

IF HC > 25 AND HC < 28 THEN HT = HT - 1

IF HC > 27 AND HC < 31 THEN HT = HT + 1

IF HC > 30 AND HC < 33 THEN HT = HT - 1

IF HC > 32 AND HC < 36 THEN HT = HT + 1

IF HC > 35 AND HC < 38 THEN HT = HT - 1

IF HC > 37 AND HC < 41 THEN HT = HT + 1

IF HC > 40 AND HC < 43 THEN HT = HT - 1

IF HC > 42 AND HC < 46 THEN HT = HT + 1

IF HC > 45 AND HC < 48 THEN HT = HT - 1

IF HC > 47 AND HC < 51 THEN HT = HT + 1

IF HC > 50 AND HC < 53 THEN HT = HT - 1

IF HC > 52 AND HC < 56 THEN HT = HT + 1

IF HC > 55 AND HC < 58 THEN HT = HT - 1

IF HC > 57 AND HC < 61 THEN HT = HT + 1

IF HC > 60 AND HC < 63 THEN HT = HT - 1

IF HC > 62 AND HC < 66 THEN HT = HT + 1

IF HC > 65 AND HC < 68 THEN HT = HT - 1

IF HC > 67 AND HC < 71 THEN HT = HT + 1

ELSE

IF HC = 71 THEN HT = 15

IF (HC > 71 AND HC < 87) THEN HT = HT - 1

IF (HC > 86 AND HC < 120) THEN HT = HC MOD 14 + (RND(1) * 2)

IF (HC > 119 AND HC < 152) THEN HT = RND(1) * (HC MOD 16)

IF (HC > 151 AND HC < 218) THEN HT = 16 - (RND(1) * (HC MOD 16))

IF HC > 217 THEN HT = (16 - (HC MOD 15 + RND(1) * 1))

IF Som = 8 AND t > 1 THEN HT = RH

END IF

IF HT > 15 THEN HT = 15

D7 = 1

ELSE

D7 = 0

END IF

Som = D0 + D1 + D2 + D3 + D4 + D5 + D6 + D7

Slotkorrektie:

IF BT <> 0 AND CT <> 0 AND DT <> 0 AND FT <> 0 AND GT <> 0 AND HT <> 0 AND Som > 4 THEN

AT = 1: ET = 0: Q = Q + 1

IF Q > 4 THEN Q = 0

END IF

IF t = Nottot THEN

AT = RA: BT = RB: DT = RD: FT = RF

IF CT = ET OR CT = GT OR CT = HT THEN CT = 1

IF ET = GT OR ET = HT THEN ET = 6

IF GT = HT THEN GT = 8

END IF

Bind:

Nte(0) = AT: Nte(1) = BT: Nte(2) = CT: Nte(3) = DT:

Nte(4) = ET: Nte(5) = FT: Nte(6) = GT: Nte(7) = HT

Transposities:

IF Som > 6 AND t > 1 THEN

Transpose = Transpose + 1

LOCATE 23, 25: PRINT "Transposition Nr."; Transpose; " "; Trans(Transpose); IF Transpose > 0 THEN

FOR i = 0 TO 7: FOR j = 0 TO 15

midi(i, j) = mid(i, j) + Trans(Transpose)

NEXT j: NEXT i

END IF

END IF

midi:

IF Mipar = 1 THEN

FOR k = 0 TO 7

IF t MOD (k + RA) = 0 THEN GOSUB MISEND

NEXT k

GOSUB HOLD

ELSE

IF t MOD RA = 0 THEN k = 0: GOSUB MISEND

IF t MOD RB = 0 THEN k = 1: GOSUB MISEND

IF t MOD RC = 0 THEN k = 2: GOSUB MISEND

IF t MOD RD = 0 THEN k = 3: GOSUB MISEND

IF t MOD RE = 0 THEN k = 4: GOSUB MISEND

IF t MOD RF = 0 THEN k = 5: GOSUB MISEND

IF t MOD RG = 0 THEN k = 6: GOSUB MISEND

IF t MOD RH = 0 THEN k = 7: GOSUB MISEND

GOSUB HOLD

END IF

t = t + 1: LOCATE 25, 1: PRINT "Count="; t;

LOOP UNTIL t > Nottot

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

' einde van het eigenlijke komponeeralgoritme

LOCATE 22, 35: PRINT "E I N D E ";

Allesuit

SLEEP 5

IF Mipar THEN

'midi-all notes off

FOR k = 0 TO 7: Uit (176 + k): Uit (123): Uit (0): NEXT k

ELSE

Binarray

END IF

END

' SUBROUTINES *****************************:

MISEND:

'fb01 routine oorspronkelijk zonder note-off codes !

SELECT CASE Mipar

CASE 0

B = (64 + (Som * 3)) + (32 - (2 * (Hy(t, k))))

IF k < 4 THEN

P1(t, (k * 2) + 1) = midi(k, Nte(k))

P1(t, (k * 2) + 2) = B

' voor bin.file

ELSE

P2(t, (k * 2) + 1 - 8) = midi(k, Nte(k))

P2(t, (k * 2) + 2 - 8) = B

' bin-file 2

END IF

CASE 1 Uit (144)

FOR k = 0 TO 7

IF Noteoff THEN

IF midi(0, Nte(k)) <> Oldnot(k) THEN

Uit (Oldnot(k)): Uit (0): ' new note-offs

Oldnot(k) = (midi(0, Nte(k)))

Uit (Oldnot(k)): ' = (midi(0, Nte(k)))

Uit (64 + (Som * 3) + (32 - (2 * (Hy(t, k)))))

END IF

ELSE

Oldnot(k) = (midi(0, Nte(k)))

Uit (Oldnot(k)): ' = (midi(0, Nte(k)))

Uit (64 + (Som * 3) + (32 - (2 * (Hy(t, k)))))

END IF

NEXT k

CASE 2

IF Noteoff THEN

' new: interactive note OFF's added!

IF midi(k, Nte(k)) <> Oldnot(k) THEN

Uit (128 + k): Uit (Oldnot(k)): Uit (0)

Oldnot(k) = midi(k, Nte(k))

Uit (144 + k): Uit (Oldnot(k))

Uit ((64 + (Som * 3)) + (32 - (2 * (Hy(t, k)))))

END IF

ELSE

Oldnot(k) = midi(k, Nte(k))

Uit (144 + k): Uit (Oldnot(k))

Uit ((64 + (Som * 3)) + (32 - (2 * (Hy(t, k)))))

END IF

CASE 3

IF Synth$ = "FB01" THEN

Uit (&HF0): Uit (&H43): Uit (&H75): Uit (&H70): Uit (16 + k): Uit (midi(k, Nte(k))):

Uit (Cent(k, Nte(k))): Uit ((64 + (Som * 3)) + (32 - (2 * (Hy(t, k))))): Uit (&HF7)

ELSE

IF Noteoff THEN ' switch previous note/channel off if new note different:

IF midi(k, Nte(k)) <> Oldnot(k) THEN

Uit (128 + k): Uit (Oldnot(k)): Uit (0)

'pitch bend code comes first!

Uit (&HE0 + k): 'lsbmsb = 8192 + ((8192 / 100) * Cent(k, Nte(k)))

lsbmsb = 8191 + (82 * Cent(k, Nte(k)))

Uit (lsbmsb MOD 128): Uit (lsbmsb \ 128)

Oldnot(k) = (midi(k, Nte(k)))

Uit (144 + k): Uit (midi(k, Nte(k)))

Uit ((64 + (Som * 3)) + (32 - (2 * (Hy(t, k)))))

END IF

ELSE 'pitch bend code comes first!

Uit (&HE0 + k): lsbmsb = 8191 + (82 * Cent(k, Nte(k)))

Uit (lsbmsb MOD 128): Uit (lsbmsb \ 128)

Oldnot(k) = (midi(k, Nte(k)))

Uit (144 + k): Uit (Oldnot(k)): '(midi(k, Nte(k)))

Uit ((64 + (Som * 3)) + (32 - (2 * (Hy(t, k)))))

END IF

END IF

END SELECT

RETURN

HOLD: 'holdlus voor tijdsduur tempomodulaties

IF Som = 7 THEN Maxtim = Maxtim - (Maxtim \ 9)

SOUND 20000, Maxtim

IF t = Nottot THEN SLEEP Maxtim

RETURN

REM $STATIC

SUB Allesuit

IF t >= Nottot THEN

SLEEP 5

FOR k = 0 TO 7

Uit (176 + k): Uit (&H7B): Uit (0)

NEXT k

END IF

END SUB

DEFSNG A-Y

SUB Binarray

' hier worden twee files geschreven omdat anders het P array de grenzen van quickbasic te buiten gaat !

DEFLNG Z

NUL = 0: Z = 1

OPEN "SHIFTS1.BIN" FOR BINARY AS #4

FOR ii = 0 TO Nottot: FOR jj = 0 TO 15

IF jj < 9 THEN

PUT #4, Z, P1(ii, jj): Z = Z + 1

ELSE

PUT #4, Z, NUL: Z = Z + 1

END IF

NEXT jj: NEXT ii

CLOSE #4

' schrijf nu de tweede file weg...

NUL = 0: Z = 1

OPEN "SHIFTS2.BIN" FOR BINARY AS #4

FOR ii = 0 TO Nottot: FOR jj = 0 TO 15

IF jj < 9 THEN

PUT #4, Z, P2(ii, jj): Z = Z + 1

ELSE

PUT #4, Z, NUL: Z = Z + 1

END IF

NEXT jj: NEXT ii

CLOSE #4

END SUB

SUB Display ' for information display only. No variables changed nor returned.

Logo

LOCATE 10, 10: PRINT "a variable composition:";

SELECT CASE Synth$

CASE ""

LOCATE 12, 20: PRINT "Version 1 : SHIFTS for 4 to 14 players ";

LOCATE 13, 20: PRINT " Algoritmic Composition Program";

CASE "FB01"

LOCATE 12, 20: PRINT "Version 2 : SHIFTS for FB01 synthesizer";LOCATE 13, 10: PRINT " sub-version:"; FB01$;

CASE "TX81Z"

LOCATE 12, 20: PRINT "Version 3 : SHIFTS for TX81 synthesizer";

CASE "PROTEUS3"

LOCATE 12, 20: PRINT "Version 4 : WORLD SHIFTS for EMU Proteus 3 Module";

CASE "PROTEUS2"

LOCATE 12, 20: PRINT "Version 5 : ORCHESTRAL SHIFTS for EMU Proteus 2XR Module";

CASE "PLAYER"

LOCATE 12, 20: PRINT "Version 7 : SHIFTS for Player Piano";

CASE "PROFORMANCE"

LOCATE 12, 20: PRINT "Version 6 : SHIFTS for Sampled Piano";

LOCATE 13, 20: PRINT "Version 8 : BROKEN SHIFTS for Sampled Piano";

LOCATE 14, 20: PRINT "Version 9 : BROKEN SHIFTS for Player Piano ";

CASE "DEFAULT"

LOCATE 12, 20: PRINT "Version 1.1 : SHIFTS for Synthesizer ";

END SELECT

LOCATE 16, 20

SELECT CASE Mipar

CASE 0

PRINT " Score-calculation option ";

CASE 1

PRINT " Single Instrument Polyphonic Version";

CASE 2

PRINT " Multitimbral 8-voice Version ";

CASE 3

PRINT " 8-voice Just Intonation Version ";

END SELECT

SLEEP 5

END SUB

DEFINT A-Y

SUB FB01Bendon

FOR i = 0 TO 7

Uit (&HF0): Uit (&H43): Uit (16 + i): Uit (&H15): Uit (&HC):

Uit (1): Uit (&HF7)

'set bend-range to 1 semitone 'sys-ex for FB01

NEXT i

END SUB

SUB Lfopan

FOR i = 0 TO 7

' set panning - works on all synths

Uit (176 + i): Uit (&HA)

IF i MOD 3 = 0 THEN Uit (0)

IF i MOD 4 = 0 THEN Uit (64)

IF i MOD 3 > 0 AND i MOD 4 > 0 THEN Uit (127)

NEXT i

END SUB

DEFSNG A-Y

SUB Logo

DO: LOOP UNTIL INKEY$ = ""

FOR i = 1 TO 5

LOCATE i, 1: PRINT Scherm$(i);

NEXT i

FOR i = 6 TO 25 LOCATE i, 1: PRINT SPACE$(79);

NEXT i

LOCATE 25, 20: PRINT "Godfried-Willem RAES [1987-1993] "; DATE$; " "; TIME$; " ";

END SUB

SUB Menu0

' returned variables:

' Mipar, FB01$ , Synth$, Version$: 'Keuze-menu voor het aangesloten type synthesizer

Logo

LOCATE 10, 10: PRINT "Midi-data selection: ";

LOCATE 11, 20: PRINT "0.- Disable Midi ";

LOCATE 12, 20: PRINT "1.- POLY-mode (using channel 0) ";

LOCATE 13, 20: PRINT "2.- MONO-mode (using channels 0-7)";

LOCATE 14, 20: PRINT "3.- JUST-INTONATION mode (channels 0-7)";

LOCATE 16, 40: PRINT "Choice ? ";

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

LOCATE 16, 50: PRINT k0$;

Mipar = VAL(k0$): Mipar = Mipar MOD 4

LOCATE 10, 10: PRINT "Tonality selection menu: ";

LOCATE 11, 20: PRINT "0.- Instrumental (1987) ";

LOCATE 12, 20: PRINT "1.- Just Intonation ";

LOCATE 13, 20: PRINT "2.- Minor Thirds ";

LOCATE 14, 20: PRINT SPACE$(40);

LOCATE 16, 40: PRINT "Choice ? "; SPACE$(10);

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

LOCATE 16, 50: PRINT kv$; : version$ = ""

IF kv$ = "1" THEN version$ = "JUST"

IF kv$ = "2" THEN version$ = "DIM"

IF kv$ = "0" THEN version$ = "INSTRUMENTAL"

IF version$ = "" THEN version$ = "INSTRUMENTAL"

IF Mipar THEN

LOCATE 10, 10: PRINT "Synthesizer to be used: ";

LOCATE 11, 20: PRINT "0. None ";

LOCATE 12, 20: PRINT "1. CASIO630 - 1 channel polyphonic ";

LOCATE 13, 20: PRINT "2. YAMAHA FB01 ";

LOCATE 14, 20: PRINT "3. YAMAHA DX21 ";

LOCATE 15, 20: PRINT "4. YAMAHA TX81Z ";

LOCATE 16, 20: PRINT "5. EMU PROTEUS2 ";

LOCATE 17, 20: PRINT "6. EMU PROTEUS3 ";

LOCATE 18, 20: PRINT "7. EMU PROFORMANCE 1+ ";

LOCATE 19, 20: PRINT "8. Player-Piano ";

LOCATE 20, 20: PRINT "9. Generic Multichannel Synthesizer ";

LOCATE 21, 40: PRINT "Choice ? ";

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

PRINT k0$;

ELSE

k0$ = "0"

END IF

SELECT CASE k0$

CASE "0"

Synth$ = ""

CASE "1"

Synth$ = "CASIO"

CASE "2"

Synth$ = "FB01"

LOCATE 10, 10: PRINT "FB01-version wanted: ";

LOCATE 11, 20: PRINT "0. Instruments ";

LOCATE 12, 20: PRINT "1. Sinewaves ";

LOCATE 13, 20: PRINT "2. Percussion ";

LOCATE 14, 20: PRINT "3. Pianos only ";

FOR i = 15 TO 21

LOCATE i, 20

PRINT SPACE$(40);

NEXT i

LOCATE 21, 40: PRINT "Choice ? ";

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

PRINT kf$;

IF kf$ = "0" THEN FB01$ = "FB01_INSTRUMENTS"

IF kf$ = "1" THEN FB01$ = "FB01_SINEWAVES"

IF kf$ = "2" THEN FB01$ = "FB01_PERCUSSION"

IF kf$ = "3" THEN FB01$ = "FB01_PIANO"

CASE "3"

Synth$ = "DX21"

CASE "4"

Synth$ = "TX81Z"

CASE "5"

Synth$ = "PROTEUS2"

CASE "6"

Synth$ = "PROTEUS3"

CASE "7"

Synth$ = "PROFORMANCE"

CASE "8"

Synth$ = "PLAYER"

CASE "9"

Synth$ = "DEFAULT"

END SELECT

END SUB

SUB Menu2

Adropnieuw:

Logo

LOCATE 10, 10: PRINT "Midi-interface selection menu:";

LOCATE 11, 20: PRINT "1. &H378 (LPT1 on CGA-PC's)";

LOCATE 12, 20: PRINT "2. &H3BC (Hercules or MDA C's)";

LOCATE 13, 20: PRINT "3. &H278 (LPT2-port)";

LOCATE 14, 20: PRINT "4. &H338 (Logotronics Midi Interface)";

LOCATE 15, 20: PRINT "5. &H2FA (Logotronics T1000 Laptop Interface)";

LOCATE 16, 20: PRINT "6. &H320 (33MHz 80386/80486 PC's)";

LOCATE 17, 20: PRINT "7. &H330 (MPU401 or MusicQuest interface IRQ=2 I/O)";

LOCATE 18, 20: PRINT "8. &H330 (MPU401 - output only connected)";

LOCATE 20, 40: INPUT "KEUZE ? "; PK

IF PK = 1 THEN DP = &H378: OUT DP + 2, 1: ' set midi-output mode !

IF PK = 2 THEN DP = &H3BC

IF PK = 3 THEN DP = &H278

IF PK = 4 THEN DP = &H338

IF PK = 5 THEN DP = &H2FA

IF PK = 6 THEN DP = &H320

IF PK = 7 OR PK = 8 THEN DP = &H330: SHELL "MPUUART.EXE"

IF PK < 1 OR PK > 8 THEN

LOCATE 23, 10: PRINT SPACE$(15); "illegal choice - do it again ";

BEEP: BEEP: BEEP: GOTO Adropnieuw

END IF

END SUBDEFINT A-Y

SUB PROFBendon

' code om de Proformance op een bendrange van +/- 1 semitone te zetten

END SUB

SUB PROTBendon

' code om de proteus op bend-range= +/- 1 semitone te zetten

END SUB

SUB Tempo

' This Sub gets the initial tempo-value as well as the version parameter for

' Chordal or Broken Shifts

Logo

IF Mipar > 0 THEN

LOCATE 10, 20

PRINT "Pulse-duration ? (0-9) 0 = prestissimo";

DO: k$ = INKEY$: LOOP UNTIL (k$ >= "0" AND k$ <= "9")

IF k$ = "0" THEN Maxtim = 1

IF k$ = "1" THEN Maxtim = 2

IF k$ = "2" THEN Maxtim = 3

IF k$ = "3" THEN Maxtim = 4

IF k$ = "4" THEN Maxtim = 5

IF k$ = "5" THEN Maxtim = 8

IF k$ = "6" THEN Maxtim = 12

IF k$ = "7" THEN Maxtim = 16

IF k$ = "8" THEN Maxtim = 24

IF k$ = "9" THEN Maxtim = 36

LOCATE 11, 20: PRINT "Pulse ="; k$; " Maxtim-value= "; Maxtim;

LOCATE 13, 20: PRINT "Chordal-version or Broken-version? (0-1)";

DO: k$ = INKEY$: LOOP UNTIL k$ >= "0" AND k$ <= "1"

IF k$ = "0" THEN Broken = 0 ELSE Broken = 1

IF Broken THEN

LOCATE 14, 20: PRINT "< BROKEN SHIFTS > [1993]";

LOCATE 16, 20: INPUT "Arpeggio-value in 1/100sec. ?"; Arpeg

LOCATE 16, 20: PRINT " Arpeggio-value="; Arpeg; "cs";

ELSE

LOCATE 14, 20: PRINT "< CHORDAL SHIFTS > [1987]";

END IF

WHILE INKEY$ <> "": WEND: ' flush keyboard buffer

LOCATE 18, 20: PRINT "Push any key to start playing... ";

k$ = ""

DO: LOOP UNTIL INKEY$ <> ""

LOCATE 18, 20

PRINT " P l a y i n g ";

ELSE

k$ = "0"

Maxtim = 1

LOCATE 18, 20: PRINT " Calculating Score-files... ";

END IF

END SUB

DEFSNG A-Y

SUB Uit (byte AS INTEGER) STATIC

IF Broken THEN

LOCATE 20, 20: PRINT "Midi-byte="; byte, "Dataport="; DP;

Z1 = TIMER: Z2 = Arpeg / 100

DO: LOOP UNTIL TIMER - Z1 > Z2END IF

IF (DP = &H330) AND (PK = 7) THEN

IF INP(&H331) AND 128 THEN

WAIT &H331, 64, 64: OUT &H330, byte: EXIT SUB

ELSE

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

WAIT &H331, 64, 64: OUT &H330, byte: EXIT SUB

END IF

END IF

IF (DP = &H330) AND (PK = 8) THEN

WAIT &H331, 64, 64: OUT &H330, byte: EXIT SUB

END IF

IF DP = &H320 THEN

' this is for Abulafia

OUT &H320, byte: OUT &H322, 0: ZZ# = TIMER

DO: LOOP UNTIL TIMER - ZZ# > .00001

OUT &H322, 1

WHILE INP(&H321) AND 128: WEND

EXIT SUB

ELSE

OUT DP, byte: OUT DP + 2, 0: dummy$ = "_": OUT DP + 2, 1

WHILE INP(DP + 1) AND 128: WEND

END IF

END SUB

DEFINT A-Y

SUB VoicesFB01

FOR i = 0 TO 7

Uit (&HF0): Uit (&H43): Uit (&H75): Uit (&H70): Uit (112 + i): Uit (&HD): Uit (0): Uit (112 + i)

Uit (0): Uit (1): Uit (112 + i): Uit (&H4): Uit (Bank(i)): Uit (112 + i): Uit (&H5): Uit (Ins(i))

Uit (112 + i): Uit (&H10): Uit (0): Uit (112 + i): Uit (&HA): Uit (0): Uit (112 + i): Uit (&HE)

Uit (&H2): Uit (112 + i): Uit (&HC): Uit (&H1): Uit (&HF7)

' &HD - parameter = poly/mono mode

' 0 set poly-mode on

' 0 parameter=number of notes per channel

' 1 set to 1 note per channel

' &H4 parameter=voice bank: BANK(I)

' &H5 parameter= voice-select: INS(I)

' &H10 parameter= LFO speed - set to 0

' &HA parameter = LFO switch - set to OFF

' &HE parameter= select input controller

' &H2 select modulation wheel

' &HC parameter=pitch-bend range

' &H1 set to 1 semitone up or down

NEXT i

END SUB

SUB Volume

' works on all synths - sets all 8 channels!

FOR k = 0 TO 7

Uit (176 + k): Uit (&H7): Uit (90 + (k * 2))

NEXT k

END SUB

Een versie van deze kode omgezet naar PowerBasic PB3.2 is voorhanden in de klas.

Een versie die loopt onder PBDLL en werkt binnen de GMT-omgeving is eveneens beschikbaar.

Filedate:8709/9210