CLS
OPEN "tout.txt" FOR OUTPUT AS #1
DIM g(20)
g(1) = 20: g(2) = 20: g(3) = 30: g(4) = 35: g(5) = 40: g(6) = 40: g(7) = 45: g(8) = 50
g(9) = 55: g(10) = 57: g(11) = 60: g(12) = 65: g(13) = 80: g(14) = 80: g(15) = 21
PRINT "This program calculates the gear positions for cutting threads on the"
PRINT "Mini Lathe. For each desired thread pitch it calculates all of the"
PRINT "possible combinations and displays those that work within a reasonable"
PRINT "error. Written by Al Harral on Bethel Island, CA"
PRINT "I have added the additional 21T gear to the standard gear set. If you"
PRINT "don't have the 21T gear, please ignore those setting which include it."
PRINT "http://www.varmintal.com/alath.htm"
PRINT "Last updated 11/23/1 to add Metric 1.5mm leadscrew and an additional gear"

REM Get the leadscred info
leadscrew = 0: REM The lead screw pitch in TPI
5 INPUT "Do you have an (I)nch or (M)etric lead screw?"; ls$
l$ = LEFT$(ls$, 1)
IF l$ = "I" OR l$ = "i" THEN leadscrew = 16
IF l$ = "M" OR l$ = "m" THEN leadscrew = 25.4 / 1.5
IF leadscrew = 0 THEN 5

REM See is an additional gear is desired
PRINT "The current 15 gears are:"
max = 15
FOR ig = 1 TO max
PRINT USING " ##   ## Tooth"; ig; g(ig)
NEXT ig
INPUT "Enter the number of teeth for an additional gear or (0) for none"; newg
IF newg < 10 OR newg > 150 THEN 10
max = 16
g(16) = newg

10 REM start calculation
k = 0
PRINT ""
PRINT #1, ""
INPUT "Do you want an (I)nch or (M)etric thread or (E)nd calculation"; a$
IF LEFT$(a$, 1) = "E" OR LEFT$(a$, 1) = "e" THEN END
IF LEFT$(a$, 1) = "M" OR LEFT$(a$, 1) = "m" THEN 20
IF LEFT$(a$, 1) = "I" OR LEFT$(a$, 1) = "i" THEN 15
GOTO 10
15 REM Calculate Inch Threads
INPUT "TPI thread pitch desired"; tpiin
REM loop
PRINT " A   B   C   D   TPI"
PRINT #1, " A   B   C   D   TPI"
REM For A and D gears
FOR a = 1 TO max - 1
IF a = 2 OR a = 6 THEN 300
FOR d = 1 TO max
IF a = d THEN 300
tpi = leadscrew * g(d) / g(a)
mm = 25.4 / tpi
IF tpi < .9997 * tpiin THEN 300
IF tpi > 1.0003 * tpiin THEN 300
k = k + 1
PRINT USING "##  ANY xx  ##  ##.###"; g(a); g(d); tpi
PRINT #1, USING "##  ANY xx  ##  ##.###"; g(a); g(d); tpi
300 REM jump out
NEXT d
NEXT a
IF k > 0 THEN 10
REM For A, B, C, and D gears
FOR a = 1 TO max - 1
IF a = 2 OR a = 6 OR a = 14 THEN 301
FOR b = 1 TO max
IF b = 2 AND a <> 1 THEN 301
IF b = 6 AND a <> 5 THEN 301
IF b = 14 AND a <> 13 THEN 301
FOR c = 1 TO max
IF a <> 1 AND a <> 5 AND b <> 1 AND b <> 5 AND c = 6 THEN 301
FOR d = 1 TO max
IF d = 1 OR d = 5 THEN 301
IF a = b OR a = c OR a = d THEN 301
IF b = c OR b = d THEN 301
IF c = d THEN 301
IF (g(b) + 10) > (g(c) + g(d)) THEN 301: REM check if they will fit
IF g(a) + g(b) + g(c) + g(d) < 160 THEN 301: REM needs to reach the two shafts
tpi = leadscrew * g(b) * g(d) / (g(a) * g(c))
mm = 25.4 / tpi
IF tpi < .9997 * tpiin THEN 301
IF tpi > 1.0003 * tpiin THEN 301
k = k + 1
PRINT USING "##  ##  ##  ##  ##.###"; g(a); g(b); g(c); g(d); tpi
PRINT #1, USING "##  ##  ##  ##  ##.###"; g(a); g(b); g(c); g(d); tpi
301 REM jump out
NEXT d
NEXT c
NEXT b
NEXT a
GOTO 10
20 REM Metric threads
INPUT "Metric thread pitch desired mm"; mmin
REM loop
PRINT " A   B   C   D   TPI       MM   % Error"
PRINT #1, " A   B   C   D   TPI       MM   % Error"
REM For A and D gears
FOR a = 1 TO max - 1
IF a = 2 OR a = 6 THEN 100
FOR d = 1 TO max
IF a = d THEN 100
tpi = leadscrew * g(d) / g(a)
mm = 25.4 / tpi
IF mm < .997 * mmin THEN 100
IF mm > 1.003 * mmin THEN 100
k = k + 1
arr = ABS(mm - mmin) * 100 / mmin
PRINT USING "##  ANY xx  ##  ##.###  ##.####  ##.####"; g(a); g(d); tpi; mm; arr
PRINT #1, USING "##  ANY xx  ##  ##.###  ##.####  ##.####"; g(a); g(d); tpi; mm; arr
100 REM jump out
NEXT d
NEXT a
IF k > 0 THEN 105
REM For A, B, C, and D gears
FOR a = 1 TO max - 1
IF a = 2 OR a = 6 THEN 101
FOR b = 1 TO max
IF b = 2 AND a <> 1 THEN 101
IF b = 6 AND a <> 5 THEN 101
FOR c = 1 TO max
IF a <> 1 AND a <> 5 AND b <> 1 AND b <> 5 AND c = 6 THEN 101
FOR d = 1 TO max
IF d = 1 OR d = 5 THEN 101
IF a = b OR a = c OR a = d THEN 101
IF b = c OR b = d THEN 101
IF c = d THEN 101
IF (g(b) + 10) > (g(c) + g(d)) THEN 101: REM check if they will fit
IF g(a) + g(b) + g(c) + g(d) < 160 THEN 101: REM needs to reach the two shafts
tpi = leadscrew * g(b) * g(d) / (g(a) * g(c))
mm = 25.4 / tpi
IF mm < .997 * mmin THEN 101
IF mm > 1.003 * mmin THEN 101
k = k + 1
arr = ABS(mm - mmin) * 100 / mmin
PRINT USING "##  ##  ##  ##  ##.###  ##.####  ##.####"; g(a); g(b); g(c); g(d); tpi; mm; arr
PRINT #1, USING "##  ##  ##  ##  ##.###  ##.#### ##.####"; g(a); g(b); g(c); g(d); tpi; mm; arr
101 REM jump out
NEXT d
NEXT c
NEXT b
NEXT a
105 REM all done
GOTO 10