10 REM       *   MULTIPICC - piccolo RESONANCE - WITH LOSSES  *
20 REM  GIVES COLUMN CURRENT / EXCITING CURRENT FOR ANY FREQUENCY LEVEL.        18 '
30 '     LINE 90  SHOWS FINGERING. EDIT USING 0 FOR OPEN, 1 FOR CLOSED
40 '          AND 2 FOR MISSING.
50 SCREEN 2: KEY OFF: CLS
60 PRINT "                              A     G#             D#"
70 PRINT "               C#    B     A#          G  F# F  E     D  C# C  B"
80 PRINT "        TR1 TR2   C1    C2       G#"
90 DATA            1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 2, 2
100 '
110 DATA MH ,TR1,TR2,C#1,C1,B,C2,A#,A,G#1,G#2,G,F#,F,E,D#,D,C#,C,B
120 DIM A$(19), B(19), C(20, 3): ' INCLUDES 0
130 FOR K = 1 TO 19: READ B(K): NEXT K
140 PRINT "        ";
150 FOR K = 1 TO 19: PRINT B(K); : NEXT K: PRINT : PRINT
160 FOR K = 0 TO 19: READ A$(K): NEXT K
170 FOR K = 0 TO 19
180      FOR P = 0 TO 3
190 READ C(K, P)
200 NEXT P, K
500 REM ** THESE DATA FOR CONN PICCOLO 25245 -COLTMAN
510 DATA -163.5,21.1,0,0       : 'MOUTH HOLE POSITION - NOTE H MAY NEED CHANGING
520 DATA -64.7,36.6,.27,.15  :    'TR #1
530 DATA -55.0,36.6,.26,.14  :    'TR #2
540 DATA -44.7,37.9,.26,.14  :    'C#
550 DATA -34.2,36.5,.26,.14  :    'C - UPPER THUMB
560 DATA -23.1,26.7,.41,.23  :    'B
570 DATA -23.1,36.5,.26,.14  :    'C - LOWER THUMB
580 DATA -11.6,25.0,.42,.23  :    'A#
590 DATA 0,24.5,.41,.23      :    'A HOLE REFERNCE
600 DATA 12.0,18.7,.55,.25   :    'G# SIDE
610 DATA 12.0,18.7,.55,.25   :    'G# TOP - FIXED TO A KEY
620 DATA 24.9,17.7,.55,.25   :    'G
630 DATA 38.1,17.7,.55,.25   :    'F#
640 DATA 52.5,17.7,.55,.25   :    'F
650 DATA 66.9,17.7,.55,.25   :    'E
660 DATA 82.6,17.7,.55,.25   :    'D#
670 DATA 105.2,3.26,0,0      :    'D - END FOR STD PICCOLO
680 DATA 105.2,1E8,0,0       :    'C# DUMMY
690 DATA 105.2,1E8,0,0       :    'C DUMMY
700 DATA 105.2,1E8,0,0       :    'B DUMMY END
800 INPUT "DO YOU WANT TO REVIEW PARAMETERS (Y OR N)"; F$
805 IF F$ <> "Y" AND F$ <> "N" THEN PRINT "Y OR N, PLEASE": GOTO 800
810 IF F$ = "Y" THEN GOSUB 1290
820 INPUT "PLOT WHOLE SCALE OR CHOOSE TABLE INTERVAL (P OR T)"; C$
830 IF C$ = "P" GOTO 960
840 IF C$ = "T" GOTO 860
850 PRINT "P OR T, PLEASE": GOTO 820
860 GOSUB 1350
870 PRINT "STARTING FREQUENCY LEVEL IS "; FS; " ENTER THIS OR A NEW VALUE NOW"; : INPUT FS
880 INPUT "POINT INTERVAL, CENTS"; CE
890 PRINT : PRINT "FREQ. LEVEL", "RESPONSE"
900 FOR FL = FS TO FS + 4 STEP CE / 100
910 GOSUB 1050
920 PRINT USING "##.##"; FL, : PRINT "          "; MI
930 IF INKEY$ = " " THEN GOTO 860
940 NEXT FL
950 END
960 CLS : VIEW (1, 1)-(636, 186), , 1: WINDOW (58.4, 0)-(98!, 10)
970 LOCATE 25, 1
980 PRINT " B C5  D   E F   G   A   B C6  D   E F   G   A   B C7  D   E F   G   A   B C8";
990 FOR X = 59 TO 98: PSET (X, .01): PSET (X, .02): NEXT X
1000 FOR FL = 59 TO 98 STEP .25
1010 GOSUB 1050
1020 PSET (FL, MI)
1030 NEXT FL
1040 IF INKEY$ = "" GOTO 1040 ELSE GOTO 820
1050 PI = 3.14159
1060 F = 16.3516 * 2 ^ (FL / 12): C = 350403 * (1 - .3 / F ^ .5): K = 2 * PI * F / C: 'WET AT 85 DEG F
1070 AL = .00145 * SQR(K)
1080 R = 1: ANG = PI: G = 0: B = 0
1090 FOR J = 19 TO -.3 STEP -1
1100 IF B(J) = 1 THEN DX = (C(J, 2) - C(J, 3)) / 2 - (C(J, 2) + C(J, 3)) / 2 * COS(ANG): ANG = ANG + 2 * K * DX: R = R * (1 - 2 * AL * DX): GOTO 1190
1110 G = G + 14.32 / (C(J, 1)) ^ 2: ' TWICE radiation loss for 10.7 mm bore
1120 B = B - 1 / K / C(J, 1)
1130 IF J = 0 THEN 1260
1140 RD = (B ^ 2 + (1 - G) ^ 2) / (B ^ 2 + (1 + G) ^ 2)
1150 R = SQR(RD)
1160 DN = 1 - G ^ 2 - B ^ 2
1170 ANG = ATN(2 * B / DN)
1180 IF DN > 0 THEN ANG = ANG + PI
1190 X = C(J, 0) - C(J - 1, 0)
1200 R = R * EXP(-2 * AL * X)
1210 ANG = ANG + 2 * K * X
1220 D2 = 1 + R ^ 2 - 2 * R * COS(ANG)
1230 G = (1 - R ^ 2) / D2
1240 B = -2 * R * SIN(ANG) / D2
1250 NEXT J
1260 B1 = B + TAN(K * 9): 'ADDS CORK CAVITY ADMITTANCE
1265 MI = 1 / ((G ^ 2 + B1 ^ 2) ^ .5) / K / C(0, 1): 'MOUTH HOLE CURRENT GENERATED BY JET
1270 RETURN
1280 END
1290 PRINT TAB(5); "KEY"; TAB(11); "POSITION"; TAB(25); "H"
1300 FOR K = 0 TO 19
1310 PRINT TAB(5); A$(K);
1320 PRINT TAB(15); C(K, 0); TAB(23); C(K, 1)
1330 NEXT K
1340 RETURN
1350 INPUT "STARTING NOTE NAME"; N$
1360 E$ = LEFT$(N$, 1)
1370 E = ASC(E$)
1380 IF E > 71 OR E < 65 GOTO 1350
1390 ON (E - 64) GOTO 1400, 1410, 1420, 1430, 1440, 1450, 1460
1400 AN = 9: GOTO 1470
1410 AN = 11: GOTO 1470
1420 AN = 0: GOTO 1470
1430 AN = 2: GOTO 1470
1440 AN = 4: GOTO 1470
1450 AN = 5: GOTO 1470
1460 AN = 7: GOTO 1470
1470 IF MID$(N$, 2, 1) = "#" THEN BN = AN + 1 ELSE BN = AN
1480 CN$ = RIGHT$(N$, 1)
1490 CN = VAL(CN$)
1500 FS = 12 * CN + BN
1510 RETURN