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