10 REM *** CONEPICC/BAS *** MANUAL *** FOR VARIABLE BORE PICCOLO
15 CLS
20 REM       *  PICCOLO RESONANCE - LOSSLESS   3/23/90 *
30 REM SET FOR 85 DEGREE WET WAVELENGTH,
40 REM NO TEMPERATURE CORRECTIONS ALONG TUBE, BUT USES DIAMETER CORRECTIONS * * * *
80 REM CONN DIMENSIONS - NOTE SPLIT C
100 DATA CORK,MH,HEAD,HEAD,HEAD,HEAD,JUNCT,TR1,TR2,C#,C,B,C,A#,A,G#1,G#2,G,F#,F,E,D#,D,C#,C
110 GOTO 180

120 PRINT "                          A     G#             D#"
130 PRINT "           C#    B     A#          G  F# F  E     D  C# C"
140 PRINT "    TR1 TR2   C     C        G#                           ": RETURN
160 DATA        1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0

180 DIM A$(25), R(26)
190 FOR N = 1 TO 25: READ A$(N): NEXT N
200 DEFINT M: DIM M(25)
210 CLS : GOSUB 120
215 M(1) = 1: M(2) = 0: FOR N = 3 TO 7: M(N) = 1: NEXT N: REM SPECIFIES SITUATION IN HEAD
220 FOR N = 8 TO 25: READ M(N): NEXT N: REM SPECIFIES FINGERING
230 PRINT "    ";
240 FOR N = 8 TO 25: PRINT M(N); : NEXT N: PRINT
250 PRINT : INPUT "WRITTEN NOTE SOUNDED FOR ABOVE FINGERING (NOTE PICC KEY)"; D$
260 GOSUB 1120
270 DIM C(25, 5): REM BORE AND KEY DATA
280 FOR N = 1 TO 25
290      FOR P = 1 TO 5
300 READ C(N, P)
310 NEXT P, N
400 REM POSITION, BORE DIAMETER, HOLE HEIGHT, CAVITY a, CAVITY b
500 REM ** THESE DATA FOR CONN PICCOLO -COLTMAN
510 DATA -172,9.6,1E8,0,0    :   ' CORK
515 DATA -164,9.8,16,0,0     :   'MOUTH HOLE
520 DATA -150,10.0,1E8,0,0
525 DATA -135,10.5,1E8,0,0
530 DATA -120,10.6,1E8,0,0
535 DATA -105,10.6,1E8,0,0
540 DATA -88,10.6,1E8,0,0    :    'BODY-HEAD JUNCTION
545 DATA -64.7,10.6,36.6,.27,.15  :    'TR #1
550 DATA -55.0,10.6,36.6,.26,.14  :    'TR #2
555 DATA -44.7,10.6,37.9,.26,.14  :    'C#
560 DATA -34.2,10.6,36.5,.26,.14  :    'C - UPPER THUMB
565 DATA -23.1,10.6,26.7,.41,.23  :    'B
570 DATA -23.1,10.6,36.5,.26,.14  :    'C - LOWER THUMB
575 DATA -11.6,10.6,25.0,.42,.23  :    'A#
580 DATA 0,10.6,24.5,.41,.23      :    'A HOLE REFERNCE
585 DATA 12.0,10.6,18.7,.55,.25   :    'G# SIDE
590 DATA 12.0,10.6,18.7,.55,.25   :    'G# TOP - FIXED TO A KEY
595 DATA 24.9,10.6,17.7,.55,.25   :    'G
600 DATA 38.1,10.6,17.7,.55,.25   :    'F#
605 DATA 52.5,10.6,17.7,.55,.25   :   'F
610 DATA 66.9,10.6,17.7,.55,.25   :    'E
615 DATA 82.6,10.6,17.7,.55,.25   :    'D#
620 DATA 105.2,10.6,3.26,0,0      :    'D - END FOR STD PICCOLO
625 DATA 105.2,10.6,1E8,0,0       :    'C# DUMMY
630 DATA 105.2,10.6,1E8,0,0       :    'C DUMMY

640 FOR P = 1 TO 5: C(0, P) = C(1, P): NEXT P
680 R(0) = 1E+08: R(26) = 1E+08
700 INPUT "DO YOU WANT TO REVIEW PARAMETERS (Y OR N)"; F$
710 IF F$ = "Y" THEN GOSUB 1040
720 PI = 3.14159: TR = 1
730 IF TR = 1 THEN F = FO: REM starts calculation WITH STD FREQ ON TRIAL 1
735 FOR N = 25 TO 1 STEP -1
740 CS = 350430 * (1 - 3.34 / C(N, 2) / SQR(F)): REM WARM AND WET VELOCITY
741                                       : REM USE 346000(... FOR 22 DEG DRY
745 KNEW = 2 * PI * F / CS
770 DR = C(N, 1) - C(N - 1, 1): REM STEP DISTANCE
775 IF N = 25 THEN B = 0: GOTO 810
800 GOSUB 2000: 'GETS VALUE OF SUSC B FROM X
810 K = KNEW
815 IF M(N) = 1 THEN B = B + K * C(N, 4): B = B / (1 + K * B * C(N, 5))
820 IF M(N) = 0 THEN B = B - 1 / K / C(N, 3)
840 GOSUB 2200: 'GETS X FROM B
910 IF N = 1 THEN PRINT F, X, B
920 X = X + DR
925 KOLD = KNEW: REM SAVES OLD K
930 NEXT N
936 IF ABS(B) < .0001 THEN GOTO 970
938 TR = TR + 1
940 IF TR = 2 THEN DF = 10: GOTO 952
950 DF = DF * B / (BO - B)
952 BO = B: REM SAVES B
955 F = F + DF: GOTO 730
970 PRINT
980 PRINT : PRINT
990  PRINT "  NOTE    STANDARD    RESONANCE      CENTS"
1000 PRINT "          FREQUENCY   FREQUENCY      DEVIATION"
1005 PRINT "   "; D$;
1010 L$ = "####.#      ####.#        ###.#"
1020 PRINT TAB(11); USING L$; FO; F; 1731 * LOG(F / FO)
1030 END
1040 PRINT "     KEY    POSITION   BORE      H      A       B        R"
1050 PRINT
1060 FOR N = 1 TO 24
1070 PRINT TAB(5); A$(N);
1080 PRINT TAB(15); C(N, 1); TAB(23); C(N, 2); TAB(31); C(N, 3); TAB(39); C(N, 4); TAB(47); C(N, 5);
1090 NEXT N: IF N = 25 THEN LOCATE 25, 5: GOTO 1070
1100 WHILE INKEY$ = "": WEND
1105 CLS : RETURN
1110 INPUT "NOTE"; D$
1120 B$ = LEFT$(D$, 1)
1130 Q = ASC(B$)
1140 IF Q > 71 OR Q < 65 GOTO 250
1150 ON (Q - 64) GOTO 1160, 1170, 1180, 1190, 1200, 1210, 1220
1160 AN = 9: GOTO 1230
1170 AN = 11: GOTO 1230
1180 AN = 0: GOTO 1230
1190 AN = 2: GOTO 1230
1200 AN = 4: GOTO 1230
1210 AN = 5: GOTO 1230
1220 AN = 7: GOTO 1230
1230 IF MID$(D$, 2, 1) = "#" THEN BN = AN + 1 ELSE BN = AN
1240 CN$ = RIGHT$(D$, 1)
1250 CN = VAL(CN$)
1260 FL = 100 * (12 * CN + BN)
1270 FO = 16.3516 * 2 ^ (FL / 1200)
1300 PRINT "STANDARD FREQUENCY="; : PRINT USING "####.##"; FO
1310 RETURN
2000 DEL = C(N, 2) - C(N + 1, 2): IF DEL = 0 THEN R = 1E+08: GOTO 2008
2002 R = C(N, 2) * (C(N + 1, 1) - C(N, 1)) / DEL: REM R TO RIGHT
2004 K = (KNEW + KOLD) / 2
2008 B = -1 / TAN(K * X) + 1 / K / R
2010 RETURN
2200 DEL = C(N - 1, 2) - C(N, 2): IF DEL = 0 THEN R = 1E+08: GOTO 2206
2204 R = C(N, 2) * (C(N, 1) - C(N - 1, 1)) / DEL: REM  R TO LEFT
2205 K = KNEW
2206 ANG = ATN(1 / (1 / K / R - B))
2208 IF ANG < 0 THEN ANG = ANG + PI: GOTO 2208
2210 X = ANG / K
2220 RETURN