10 REM **** HEADJOINT ACOUSTIC LENGTH - FROM CONES ****                  USE RUN 1000 TO CALCULATE U-BEND
20 NS = 5: REM NO. OF SECTIONS
30 H = 33.8: REM MOUTHHOLE HEIGHT, RELATIVE TO DIAMETER THERE *
40 C = 17.9: REM CORK DISTANCE FROM CL OF MOUTHHOLE *
50 REM THE FOLLOWING DATA ARE THE LENGTHS OF THE NS SECTIONS
60 DATA 40.9,39.5,12.5,21.7,36.3
70 REM  THE FOLLOWING ARE THE DIAMETERS OF THE NS+1 CROSS
80 DATA 17.4,18.18,18.82,18.93,19,19
81 INPUT "DO YOU RESULTS PRINTED (Y OR N)"; RP$
83 PRINT "MOUTH HEIGHT="; H; "   CORK DIST="; C
84 IF RP$ = "Y" THEN LPRINT "MOUTH HEIGHT="; H; "  CORK DIST="; C
90 DIM X(NS + 1): DIM D(NS + 1): DIM R(NS + 1): DIM L(96)
93 PI = 3.14159
95 POKE 16553, 255
100 FOR N = 1 TO NS: READ X(N): NEXT N
110 FOR N = 1 TO NS + 1: READ D(N): NEXT N
120 FOR N = 1 TO NS
125 IF D(N + 1) = D(N) THEN R(N) = 1000000!: GOTO 140
130 R(N) = X(N) * D(N) / (D(N + 1) - D(N))
140 NEXT N
145 PRINT " N", "DIAM", "LENGTH", "CONE APEX": PRINT
147 IF RP$ = "Y" THEN LPRINT CHR$(30); : LPRINT " N", "DIAM", "LENGTHS", "CONE APEX": LPRINT
150 FOR N = 1 TO NS + 1
160 PRINT N, D(N), X(N), R(N)
162 IF RP$ = "Y" THEN LPRINT N, D(N), X(N), R(N)
170 NEXT N
200 REM  FL IS FREQUENCY LEVEL WHERE C4 =48, A4=57
205 PRINT : PRINT "NOTE      FREQ           LENGTH, MM"
206 IF RP$ = "Y" THEN LPRINT : LPRINT "NOTE     FREQUENCY    LENGTH, MM"
210 FOR FL = 48 TO 84 STEP 4
220 F = 16.352 * EXP(FL / 17.3123)
230 K = F / 55386!: REM *  ASSUME VELOCITY OF SOUND =348,000 MM/SEC
300 B = TAN(K * C) - 1 / K / H
310 FOR N = 1 TO NS
320 X = ATN(1 / (1 / K / R(N) - B)) / K
324 IF X < 0 THEN X = X + PI / K: GOTO 324
330 X = X + X(N)
340 B = 1 / K / (R(N) + X(N)) - 1 / TAN(K * X)
350 NEXT N
360 L = ATN(-1 / B) / K
365 IF L < 160 THEN L = L + PI / K: GOTO 365
370 IN = INT(FL / 12)
380 P = (FL - 12 * IN) / 4
390 IF P = 0 THEN C$ = "C"
391 IF P = 1 THEN C$ = "E"
392 IF P = 2 THEN C$ = "G#"
400 PRINT C$; IN; "    "; F; "          "; L
402 IF RP$ = "Y" THEN LPRINT C$; IN; "    "; F; "           "; L
404 L(FL) = L
410 NEXT FL
420 IF RP$ = "Y" THEN LPRINT CHR$(12)
450 WHILE INKEY$ = "": WEND
GOSUB 3000
700 END
1000 REM - FORMULA FOR EFFECT OF CURVED SECTION
1010 INPUT "DIAMETER OF TUBE"; TD
1020 INPUT "RADIUS OF CURVATURE, CENTERLINE"; RC
1030 RA = RC / TD * 2
1040 RHO = 1 / 2 / (RA * RA - RA * SQR(RA * RA - 1))
1045 RHO = SQR(RHO)
1050 PRINT "EFFECTIVE LENGTH OF TUBE="; 3.14159 * RC * RHO
1060 PRINT "EFFECTIVE DIAMETER="; TD / SQR(RHO)
1070 GOTO 1000
2000 REM - FORMULA FOR EFFECTIVE CORK DISTANCE
2010 INPUT "DIAM AT MOUTH HOLE, DIAM AT CORK "; DH, DC
2020 INPUT " ACTUAL CORK DISTANCE"; CD
2030 DD = DC / DH
2040 CN = CD * (1 + DD + DD * DD) / 3
2050 PRINT "EFFECTIVE CORK DISTANCE FOR CONICAL FRUSTRUM ="; CN
2060 END
3000 SCREEN 12: VIEW (47, 7)-(446, 455): WINDOW (46, 180)-(86, 215)
3002 LABEL$ = "C  D#  F#  A   C  D#  F#  A   C  D#  F#  A   C"
3004 LOCATE 30, 9: PRINT LABEL$
3005 FOR I = 180 TO 220 STEP 5
3006 LINE (46, I)-(46.5, I)
3007 NEXT I
3010 LINE (46, 180)-(86, 180): LINE (46, 180)-(46, 230)
3012 FOR P = 0 TO 9: READ STD(P): NEXT P: REM READS IN REFERENCE CIRCLE POINTS
3013 ' THE FOLLOWING DATA ARE FOR WIMBERLEY HEADJOINT 1/30/97
3014 DATA 197.6,196.6,195.4,193.7,191.6,188.8,187.6,188.8,191.6,193.6
3020 FOR FL = 48 TO 84 STEP 3
3030 LINE (FL, 180)-(FL, 180.2): NEXT FL
3031 FOR FL = 48 TO 84 STEP 4
3032 FOR I = 215 TO 185 STEP -5
3034 LOCATE (215 - I) * .8 + 1, 1: PRINT I
3035 NEXT I
3036 P = (FL - 48) / 4
3038 CIRCLE (FL, STD(P)), .1, 3
3040 PSET (FL, L(FL))
3050 NEXT FL
3060 WHILE INKEY$ = "": WEND