10 REM *** FLUTE RESONANCE - ALTO *** WITH HEADJOINT AND COLTMAN BLOWING CORRECTIONS 5/6/85 AND VELOCITY 351500 20 REM PROGRAM REV JOHN W. COLTMAN 2/18/92 * ALTRESO.BAS 30 REM WIMBERLY BENNETT SCALE - LARGE C# SET CLOSED - 40 WD = 2.7: REM HEADJOINT WITHDRAWAL 50 SD$ = "####.# ####.# ###.# ###.#" 60 DIM A$(19): KEY OFF 70 DEFINT B, K: DIM B(51, 19), Q$(39), T(39), L$(39) 80 PI = 3.14159 90 PRINT "READING KEY MATRIX - PLEASE WAIT" 100 FOR K = 1 TO 19: READ A$(K): NEXT K 110 GOSUB 350 120 FOR N% = 1 TO 51 130 FOR K = 1 TO 19 140 READ B(N%, K): NEXT K: NEXT N% 150 DM = 503: REM MOUTH NODE DISTANCE 160 PRINT "DO YOU WANT (1) PRINTOUT OF ENTIRE SCALE (2) MANUAL NOTE CHOICE (3) TRILLS - MANUAL" 170 INPUT "WHICH"; GG 180 PRINT 190 IF GG <> 1 AND GG <> 2 AND GG <> 3 GOTO 160 200 IF GG = 1 GOTO 1500 210 INPUT "DO YOU WANT TO REVIEW PARAMETERS (Y OR N)"; F$ 220 PRINT 230 IF F$ = "Y" OR F$ = "YES" THEN GOSUB 1110 240 IF GG = 3 GOTO 2090 250 INPUT "NOTE NAME"; D$ 260 GOSUB 1220 270 DATA TR1,TR2,C#1,C#2,C,B,A#,A,G#1,G#2,G,F#,F,E,D#,D,C#,C,B 280 N% = FL - 41 290 PRINT " A G# D#" 300 PRINT " C# C# B A# G F# F E D C# C B" 310 PRINT " TR1 TR2 C G#" 320 PRINT " "; 330 FOR K = 1 TO 19: PRINT B(N%, K); : NEXT K 340 GOTO 800 350 DIM C(20, 3): REM INCLUDES COLUMN 0 360 FOR K = 1 TO 19 370 FOR P = 0 TO 3 380 READ C(K, P) 390 NEXT P, K 400 RETURN 500 REM ** THESE KEY DATA FOR WIMBERLY BENNETT SCALE 510 REM * POS. H A B 520 DATA -173.6,90,.28,.16: 'TR1 530 DATA -149.6,90,.28,.16: 'TR2 540 DATA -127.1,90,.28,.16: 'C# VENT 550 DATA -108,1E5,1.4,.8 : 'C# EXTRA 560 DATA -83.3,37.8,1.4,.8: 'C THUMB 570 DATA -58.3,37.8,1.4,.8: 'B 580 DATA -29.4,37.8,1.4,.8: 'B FLAT 590 DATA 0,37.8,1.4,.8: 'A REFERENCE POSITION 600 DATA 31.49,37.8,1.4,.8 : 'G# BACK 610 DATA 31.5,37.8,1.4, .8 : 'G# TOP 620 DATA 63.2,37.8,1.4,.8 : 'G 630 DATA 99.5,37.8,1.4,.8 : 'F# 640 DATA 137.5,37.8,1.4,.8: 'F 650 DATA 176,37.8,1.4,.8: 'E 660 DATA 214.5,37.8,1.4,.8: 'D SHARP 670 DATA 260.4,37.8,1.4,.8: 'D 680 DATA 307.5,37.8,1.4,.8: 'C# 690 DATA 350,37.8,1.4,.8 : 'C (FOR END USE H=.3*ID AND B =0) 700 DATA 415,7.25,0,0 : 'B END (FOR C FOOT USE H=1E5) 800 FOR J = 1 TO 2 810 R = L / 4 + .001 820 C(20, 0) = C(19, 0) 830 FOR K = 19 TO 1 STEP -1 840 DR = C(K + 1, 0) - C(K, 0) 850 R1 = R + DR / 2 860 TF = 1 + .00066 * K * (COS(2 * PI * R1 / L)) ^ 2 870 R = R + TF * DR 880 IF B(N%, K) = 0 THEN GOSUB 920 890 IF B(N%, K) = 1 THEN GOSUB 940 900 NEXT K 910 R = R + DM + C(1, 0): GOTO 950 920 S = 1 / TAN(2 * PI * R / L) + L / 2 / PI / C(K, 1) 930 R = L / 2 / PI * ATN(1 / S): RETURN 940 R = R + C(K, 2) - ((C(K, 2) + C(K, 3)) * (COS(2 * PI * R / L)) ^ 2): RETURN 950 IF R < -L / 4 THEN R = R + L / 2: GOTO 950 960 IF R > L / 4 THEN R = R - L / 2: GOTO 960 970 IF J = 2 GOTO 990 980 RA = R: LA = L: L = L * 1.03 990 NEXT J 1000 LO = LA * (1 - .03 * RA / (R - RA)) 1010 IF GG <> 1 GOTO 1030 1020 IF GG = 1 AND N% < 40 GOTO 1800 ELSE GOTO 2040 1030 PRINT : PRINT 1040 PRINT " NOTE FREQUENCY WAVELENGTH COLUMN CENTS" 1050 PRINT " EXCESS DEVIATION" 1060 IF GG = 3 THEN D$ = E$ 1070 PRINT TAB(4); D$; : PRINT TAB(12); USING SD$; F; LA; RA; 51.93 * RA / (R - RA) 1080 REM 1090 IF GG = 3 GOTO 2090 1100 GOTO 250 1110 PRINT TAB(5); "KEY"; TAB(13); "POSITION"; TAB(25); "H"; TAB(33); "A"; 1120 PRINT TAB(41); "B": PRINT 1130 FOR K = 1 TO 19 1140 PRINT TAB(5); A$(K); 1150 PRINT TAB(15); C(K, 0); TAB(23); C(K, 1); TAB(31); C(K, 2); TAB(39); C(K, 3) 1160 NEXT K 1170 REM 1180 REM 1190 REM 1200 PRINT "HEADJOINT WITHDRAWN "; WD; " MM": INPUT "READY"; DD$: RETURN 1210 INPUT "NOTE"; D$ 1220 B$ = LEFT$(D$, 1) 1230 Q = ASC(B$) 1240 IF Q > 71 OR Q < 65 GOTO 250 1250 ON (Q - 64) GOTO 1260, 1270, 1280, 1290, 1300, 1310, 1320 1260 AN = 9: GOTO 1330 1270 AN = 11: GOTO 1330 1280 AN = 0: GOTO 1330 1290 AN = 2: GOTO 1330 1300 AN = 4: GOTO 1330 1310 AN = 5: GOTO 1330 1320 AN = 7: GOTO 1330 1330 IF MID$(D$, 2, 1) = "#" THEN BN = AN + 1 ELSE BN = AN 1340 CN$ = RIGHT$(D$, 1) 1350 CN = VAL(CN$) 1360 FL = 12 * CN + BN - 5 1370 IF FL < 42 OR FL > 82 GOTO 250 1380 F = 16.3516 * 2 ^ (FL / 12) 1390 IF FL > 41 AND FL < 54 THEN HJ = -.1 + .043 * (FL - 53) ^ 2: GOTO 1440 1400 IF FL > 55 AND FL < 66 THEN HJ = -3.7 + .1 * (FL - 61) ^ 2: GOTO 1440 1410 IF FL > 53 AND FL < 57 THEN HJ = -.2 * (FL - 55) - .3: GOTO 1440 1420 IF FL > 55 AND FL < 63 THEN HJ = -.42 * (FL - 53): GOTO 1440 1430 IF FL > 65 THEN HJ = 2! - .052 * (FL - 75) ^ 2: GOTO 1440 1440 DM = 503 + WD + HJ 1450 L = 351500! * (1 - .176 / F ^ .5) / F: REM WARM AND WET WAVELENGTH 1460 REM FOR 20 DEGREE C WAVELENGTH USE 343340 1470 RETURN 1480 PRINT "FREQUENCY="; F; " TUBE WAVELENGTH="; L 1490 RETURN 1500 INPUT "FLUTE NAME"; MN$ 1510 GOTO 1710 1520 IF B(1, 19) = 2 THEN PP = 2 ELSE PP = 1 1530 FOR N% = 1 TO 39 1540 FL = N% + 41: OC = INT((FL + 5) / 12): OC$ = STR$(OC): N2 = FL - OC * 12 + 6 1550 ON N2 GOTO 1590, 1600, 1610, 1620, 1630, 1640, 1650, 1660, 1670, 1560, 1570, 1580 1560 D$ = "A": GOTO 1680 1570 D$ = "A#": GOTO 1680 1580 D$ = "B": GOTO 1680 1590 D$ = "C": GOTO 1680 1600 D$ = "C#": GOTO 1680 1610 D$ = "D": GOTO 1680 1620 D$ = "D#": GOTO 1680 1630 D$ = "E": GOTO 1680 1640 D$ = "F": GOTO 1680 1650 D$ = "F#": GOTO 1680 1660 D$ = "G": GOTO 1680 1670 D$ = "G#": GOTO 1680 1680 D$ = D$ + OC$ 1690 GOSUB 1380: REM GETS FREQ F AND WAVELENGTH L 1700 GOTO 800 1710 LPRINT CHR$(27); "@"; : LPRINT CHR$(27); "N"; CHR$(4): LPRINT MN$ 1720 LPRINT TAB(5); "KEY"; TAB(13); "POSITION"; TAB(25); "H"; TAB(33); "A"; TAB(41); "B": LPRINT 1730 FOR K = 1 TO 19 1740 LPRINT TAB(5); A$(K); TAB(15); C(K, 0); TAB(23); C(K, 1); TAB(31); C(K, 2); TAB(39); C(K, 3): NEXT K 1750 LPRINT "HEADJOINT WITHDRAWN "; WD; "MM" 1760 LPRINT 1770 LPRINT " NOTE FREQUENCY WAVELENGTH COLUMN CENTS" 1780 LPRINT " EXCESS DEVIATION" 1790 GOTO 1520 1800 REM 1810 T(N%) = 51.93 * RA / (R - RA) 1820 LPRINT TAB(4); D$; : LPRINT TAB(12); USING SD$; F; LA; RA; T(N%) 1830 NEXT N% 1840 LPRINT : LPRINT "TRILLS -- DATA ARE FOR UPPER NOTE": LPRINT 1850 LPRINT "TRILL FREQUENCY WAVELENGTH COLUMN CENTS" 1860 LPRINT " EXCESS DEVIATION" 1870 FOR N% = 40 TO 51 1880 ON (N% - 39) GOTO 1890, 1900, 1910, 1920, 1930, 1940, 1950, 1960, 1970, 1980, 1990, 2000 1890 E$ = "C5-D5 (TR2)": FL = 62: GOTO 2010 1900 E$ = "C#5-D5 (TR2)": FL = 62: GOTO 2010 1910 E$ = "B5-C#6 (TR2)": FL = 73: GOTO 2010 1920 E$ = "C#6-D6 (TR2)": FL = 74: GOTO 2010 1930 E$ = "G6-G#6 (TR2)": FL = 80: GOTO 2010 1940 E$ = "G#6-A6 (TR2)": FL = 81: GOTO 2010 1950 E$ = "C#5-D#5 (TR1)": FL = 63: GOTO 2010 1960 E$ = "C6-D6 (TR1)": FL = 74: GOTO 2010 1970 E$ = "D6-D#6 (TR1)": FL = 75: GOTO 2010 1980 E$ = "C#6-D#6 (BOTH)": FL = 75: GOTO 2010 1990 E$ = "G6-A5 (BOTH+G#)": FL = 81: GOTO 2010 2000 E$ = "G#6-A#6 (BOTH)": FL = 82: GOTO 2010 2005 FL = FL - 5: GOSUB 1380 2010 GOSUB 1380 2020 IF GG = 3 GOTO 290 2030 GOTO 800 2040 LPRINT E$; : LPRINT TAB(19); USING SD$; F; LA; RA; 51.93 * RA / (R - RA) 2050 REM 2060 NEXT N% 2070 GOTO 5000 2080 END 2090 PRINT : PRINT "TRILL FINGER 1 TRILL FINGER 2 BOTH " 2100 PRINT "(1) C5-D5 (7) C#5-D#5 (10) C#6-D#6 " 2110 PRINT "(2) C#5-D5 (8) C6-D6 (11) G6-A6 +G#" 2120 PRINT "(3) B5-C#6 (9) D6-D#6 (12) G#6-A#6 " 2130 PRINT "(4) C#6-D6 " 2140 PRINT "(5) G6-G#6 " 2150 PRINT "(6) G#6-A6 "; : INPUT "WHICH"; TR 2160 N% = TR + 39: GOTO 1880 3000 REM *** THE FOLLOWING DATA ARE STANDARD FINGERINGS, INC COLTMAN C# ** 3010 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0: 'B3 3020 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0: 'C4 3030 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0 3040 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0 3050 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0 3060 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0 3070 DATA 1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0 3080 DATA 1,1,1,1,1,1,1,1,1,1,1,0,0,1,0,0,0,0,0 3090 DATA 1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0: 'G4 3100 DATA 1,1,1,1,1,1,1,1,0,1,0,0,0,0,0,0,0,0,0 3110 DATA 1,1,1,1,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0 3120 DATA 1,1,1,1,1,1,0,0,1,0,1,1,0,0,0,0,0,0,0 3130 DATA 1,1,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3140 DATA 1,1,1,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3150 DATA 1,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3160 DATA 1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0: 'D5 3170 DATA 1,1,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0 3180 DATA 1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0 3190 DATA 1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0 3200 DATA 1,1,1,1,1,1,1,1,1,1,1,0,0,1,0,0,0,0,0 3210 DATA 1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0: 'G5 3220 DATA 1,1,1,1,1,1,1,1,0,1,0,0,0,0,0,0,0,0,0 3230 DATA 1,1,1,1,1,1,1,0,1,0,0,0,0,0,0,0,0,0,0 3240 DATA 1,1,1,1,1,1,0,0,1,0,1,1,0,0,0,0,0,0,0 3250 DATA 1,1,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3260 DATA 1,1,1,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0: 'C6 3270 DATA 1,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3280 DATA 1,1,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0 3290 DATA 1,1,1,1,1,1,1,1,0,1,1,1,1,1,0,0,0,0,0 3300 DATA 1,1,1,1,1,1,1,0,1,0,1,1,1,0,0,0,0,0,0: 'CONVENTIONAL E 3310 DATA 1,1,1,1,1,1,0,1,1,1,1,1,0,0,0,0,0,0,0 3320 DATA 1,1,1,1,1,0,0,1,1,1,1,0,0,1,0,0,0,0,0 3330 DATA 1,1,1,1,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0: 'G6 3340 DATA 1,1,0,1,0,1,1,1,0,1,0,0,0,0,0,0,0,0,0 3350 DATA 1,1,0,1,1,1,1,0,1,0,1,1,0,0,0,0,0,0,0 3360 DATA 1,0,0,1,1,1,0,0,1,0,1,1,0,0,0,0,0,0,0 3370 DATA 0,1,1,1,1,0,0,1,1,1,0,0,0,0,0,0,0,0,0 3380 DATA 1,1,1,1,0,1,1,1,0,1,1,1,0,0,1,0,0,0,0: 'C6 3390 DATA 1,1,0,1,0,1,1,0,0,0,1,1,0,0,1,0,0,0,0 3400 DATA 1,0,1,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0: 'TRILLS BEGIN - 3410 DATA 1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3420 DATA 1,0,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3430 DATA 1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3440 DATA 1,0,1,1,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0 3450 DATA 1,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0 3460 DATA 0,1,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3470 DATA 0,1,1,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3480 DATA 0,1,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0 3490 DATA 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 3500 DATA 0,0,1,1,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0 3510 DATA 0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0 3520 END 5000 FOR I = 1 TO 39: READ X: Q$(I) = CHR$(X): NEXT I 5010 LPRINT CHR$(27); "@" 5020 D$ = ":" + STRING$(9, "-") 5030 FOR JJ = 1 TO 10: S$ = S$ + D$: NEXT JJ 5040 S$ = S$ + ":" 5050 DATA 66,67,32,68,32,69,70,32,71,32,65,32,66,67,32,68,32,69,70,32,71,32,65,32,66,67,32,68,32,69,70,32,71,32,65,32,66,67,32 5060 LPRINT CHR$(27); "U"; CHR$(1) 5070 QQ$ = "-50 -40 -30 -20 -10 0 10 20 30 40 50" 5080 LPRINT TAB(25); "CENTS DEVIATION FROM A440 SCALE" 5090 LPRINT TAB(11); QQ$ 5100 FOR I = 1 TO 39 5110 GOSUB 5230 5120 LPRINT CHR$(18); 5130 IF ASC(Q$(I)) = 32 THEN LPRINT TAB(9); Q$(I - 1); "#"; : GOTO 5150 5140 LPRINT TAB(9); Q$(I); " "; 5150 WIDTH "LPT1:", 132: LPRINT CHR$(15); 5160 IF T(I) = 0 THEN LPRINT TAB(15); S$: GOTO 5200 5170 LPRINT TAB(15); S1$; 5180 LPRINT "o"; 5190 LPRINT S2$ 5200 NEXT I 5210 WIDTH "LPT1:", 80: LPRINT CHR$(27); "@" 5220 END 5230 T(I) = T(I) + 50: T(I) = INT(T(I) + .5) 5240 IF T(I) < 0 OR T(I) > 100 THEN T(I) = 0 5250 S1$ = LEFT$(S$, T(I)) 5260 S2$ = RIGHT$(S$, 100 - T(I)) 5270 RETURN