1 CLS : PRINT "CAVEMAP1, a program in GW-BASIC to calculate preliminary land surveys.": PRINT "Copywright (c) 1993 by Dave Byter. Send shareware fee to CAVE Inc, ½ Fast Road, Ritner KY 42639": CLOSE
2 PRINT "This one should run under QBASIC too"
3 PRINT "Shareware registration fee:"
4 PRINT "$ 10 = private use, one parcel"
5 PRINT "$ 25 = private use, multiple parcels"
6 PRINT "$ 50 = commercial use on your own lands, developers, foresters, miners"
7 PRINT "$100 = commercial use for hire, governments, realtors, attorneys, appraisors"
20 PRINT "Buy your $75 surveying instruments here too.": PRINT "See file REGISTER.ME to order."
30 PRINT "For this program to be of any use, you first must read": PRINT : PRINT " SURVEY IT YOURSELF": PRINT : PRINT "contained in files SIY*.TXT"
35 PRINT "Copied 20 Aug 93 for Shareware Distribution Network"
40 PRINT "CAVEMAP1 Control=CMTAB4P.029½ Date=930714": GOSUB 480: KEY OFF
42 IF NN% = 0 THEN NMAX% = 100: PRINT : PRINT "Will you be using more than"; NMAX%; "stations? N"; : GOSUB 520: IF IN$ = "Y" THEN INPUT "Maximum number of stations ->", NMAX%
43 IF NN% = 0 THEN DIM TT$(NMAX%), FR$(NMAX%), COMP(NMAX%), TAPE(NMAX%), INCL(NMAX%), DT$(NMAX%), NI(NMAX%), EI(NMAX%), NS(NMAX%), ES(NMAX%), RM$(NMAX%): GOSUB 3560
44 'To, From, Compass, Tape, Inclinometer, Data, North increment, East increment, North sum, East sum, Remark
50 PRINT "Whachawannado?"
60 PRINT : PRINT "A = Assign coordinates"
70 PRINT "B = Reassign coordinates"
80 PRINT "C = Close this loop"
90 PRINT "D = Display duh data"
100 PRINT "E = Eliminate intermediate stations"
110 PRINT "H = Help!"
120 PRINT "I = Instrument definitions"
130 PRINT "K = Kalibrate the map"
140 PRINT "L = List the coordinates"
150 PRINT "M = Map screen mode 2 (CGA)"
155 PRINT "* = Map screen mode 0 (80*25)"
160 PRINT "O = Offsets"
170 PRINT "P = Precision"
180 PRINT "Q = Quit"
190 PRINT "R = Read file from disk"
200 PRINT "S = Shoot a station"
210 PRINT "T = Throw out this data"
220 PRINT "W = Write file to disk"
230 PRINT "X = Segments"
235 A = FRE(0): PRINT A; " bytes free. "; : IF A < 1000 THEN PRINT "Garbage collection time. "; FRE(""); " bytes free";
240 PRINT : PRINT "A B C D E H I K L M * O P Q R S T W X ?"; : GOSUB 520
250 IF IN$ = "A" THEN GOSUB 550: GOTO 50
260 IF IN$ = "B" THEN GOSUB 2890: GOTO 50
270 IF IN$ = "C" THEN GOSUB 2960: GOTO 50
280 IF IN$ = "D" THEN GOSUB 1250: GOTO 50
290 IF IN$ = "E" THEN PRINT "I am too simple to eliminate intermediate stations.": PRINT "PRINT "; PLEASE; USE; CAVEMAP.BIG&; O0; UGLY; ": GOTO 50"
300 IF IN$ = "H" OR IN$ = "?" THEN PRINT "Help is available in file CAVEMAP1.DOC or from Dave Byter"
310 IF IN$ = "I" THEN GOSUB 3340: GOTO 50
320 IF IN$ = "K" THEN GOSUB 2450: GOTO 50
330 IF IN$ = "L" THEN GOSUB 2300: GOTO 50
340 IF IN$ = "M" THEN GOSUB 2600: GOTO 50
345 IF IN$ = "*" THEN GOSUB 12600: GOTO 50
350 IF IN$ = "O" THEN PRINT "I am too simple to calculate offsets.": PRINT "Please use CAVEMAP.BIG'UN"
360 IF IN$ = "P" THEN PRINT "Precision not calculated with this version.": GOTO 50
370 IF IN$ = "Q" THEN PRINT "Re-enter with GOTO 1": PRINT "Good riddance!": BEEP: END
380 IF IN$ = "R" THEN GOSUB 1680: GOTO 50
390 IF IN$ = "S" THEN GOSUB 600: GOTO 50
400 IF IN$ = "T" THEN PRINT "Wanna save it first? Y"; : GOSUB 520: IF IN$ = "N" THEN NN% = 0: GOTO 50 ELSE GOSUB 1990: GOTO 50
410 IF IN$ = "W" THEN GOSUB 1990: GOTO 50
420 IF IN$ = "X" THEN PRINT "Segments are not implemented in this version.": GOSUB 480: GOTO 50
430 BEEP: PRINT IN$; " is not a choice!": GOTO 50
440 BEEP: PRINT "QUIET! I'm thinking.": RETURN
450 REM common subroutines
460 II% = 0: IF IN$ = "" THEN II% = -1: RETURN ELSE IF ASC(IN$) = 96 THEN IN$ = PX$ + RIGHT$(IN$, LEN(IN$) - 1) 'FROM finder. SPLIT ME
470 IF IN$ = TT$(II%) THEN RETURN ELSE IF II% <= NN% THEN II% = II% + 1: GOTO 470 ELSE II% = -1: BEEP: PRINT "I can't find "; IN$: RETURN
480 PRINT "Stroke my key. ";
490 IN$ = INKEY$: IF IN$ = "" THEN 490 ELSE PRINT CHR$(168): RETURN
500 IF ASC(IN$) > 96 AND ASC(IN$) < 123 THEN IN$ = CHR$(ASC(IN$) - 32)'shift to CAPS
510 RETURN
520 I% = POS(I%): IF I% = 1 THEN PRINT : LOCATE , 1, 1, 0, 15 ELSE LOCATE , I% - 1, 1, 0, 15'back over last character for choice
540 REM AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
550 CLS : PRINT "Should I prefix this station with "; CHR$(34); PX$; CHR$(34); "Y"; : GOSUB 520: A$ = PX$: IF IN$ = "N" THEN A$ = ""
555 PRINT "Assign coordinates to station -> "; A$; : INPUT "", TT$(NN%): IF TT$(NN%) = "" OR TT$(NN%) = "-" THEN PRINT "Assign cancelled.": RETURN ELSE TT$(NN%) = A$ + TT$(NN%)
560 IN$ = "it. Must be a new station.": GOSUB 460: IF II% = -1 THEN N% = NN%: PRINT "Assign original coordinates": ELSE N% = II%: PRINT "Assign new coordinates to existing station"
590 REM SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
600 IF NN% = 0 THEN PRINT "You ain't got nowheres to start!": GOSUB 480: GOSUB 550
605 PRINT "Shoot stations": PRINT "Prefix stations with "; CHR$(34); PX$; CHR$(34); "? Y"; : GOSUB 520: IF IN$ = "N" THEN INPUT "New station name prefix ->", PX$
610 N% = NN%: F$ = "": GOSUB 630: IF F$ = "" THEN RETURN ELSE IF F$ = "-" THEN 610 ELSE GOSUB 800: NN% = NN% + 1: GOTO 610'get inputs: calculate position
630 A = FRE(0): IF A < 300 THEN PRINT "Collecting garbage, "; FRE(""); " bytes free."
635 PRINT : PRINT "TO ->"; PX$; : INPUT "", IN$: IF IN$ = "" OR IN$ = "-" THEN F$ = IN$: RETURN
640 TT$(N%) = PX$ + IN$
650 PRINT "FROM is "; PR$; " -> "; : INPUT "", IN$: IF IN$ = "-" THEN 630
660 IF IN$ = "" THEN IN$ = PR$ ELSE IF ASC(IN$) = 27 THEN RETURN
670 GOSUB 460: IF II% = -1 THEN 650 ELSE FR$(N%) = IN$
680 PR$ = TT$(N%)
690 DT$(N%) = ""
700 INPUT "Compass ->", IN$: IF IN$ = "-" THEN 650 ELSE DT$(N%) = DT$(N%) + " c" + IN$: GOSUB 940: IF A >= 0 AND A <= 360 THEN COMP(N%) = A ELSE BEEP: PRINT "Compass out of range. Try again!": GOTO 700
710 PRINT "COMPASS "; COMP(N%)
720 IF BZ THEN INPUT "Backcompass ->", IN$: IF IN$ = "-" THEN 700 ELSE DT$(N%) = DT$(N%) + " b" + IN$'but not used in this version
730 INPUT "Tape ->", IN$: DT$(N%) = DT$(N%) + " t" + IN$: IF IN$ = "-" THEN 700 ELSE GOSUB 920: IF A >= 0 THEN TAPE(N%) = A ELSE BEEP: PRINT "Try that again!": GOTO 700
740 PRINT "TAPE "; TAPE(N%)
750 IF IZ THEN INPUT "Inclinometer ->", IN$: IF IN$ = "-" THEN 700 ELSE DT$(N%) = DT$(N%) + " i" + IN$: GOSUB 870: IF A >= -90 AND A <= 90 THEN INCL(N%) = A ELSE BEEP: PRINT "Inclinometer out of range. Try again.": GOTO 750 ELSE INCL(N%) = 0
760 PRINT "Inclinometer is "; INCL(N%)
770 IF RZ THEN INPUT "Right offset -> ", IN$: IF IN$ = "-" THEN 750 ELSE DT$(N%) = DT$(N) + " r" + IN$
780 LINE INPUT "Remark ->", IN$: IF IN$ = "-" THEN 730 ELSE RM$(N%) = IN$
790 F$ = "½": RETURN'with complete data for this station
830 IN$ = FR$(N%): GOSUB 460: IF II% < 0 THEN PRINT "Calculation aborted": RETURN
840 NS(N%) = NS(II%) + NI(N%)
850 ES(N%) = ES(II%) + EI(N%)
860 RETURN
870 IF IN$ = "" THEN A = 0: RETURN ELSE A$ = IN$'incl handler
880 IF LEFT$(A$, 1) = " " THEN A$ = RIGHT$(A$, LEN(A$) - 1): GOTO 880 'incl handler
890 IF LEFT$(A$, 1) = "-" THEN B$ = RIGHT$(A$, LEN(A$) - 1) ELSE B$ = A$
900 A = 60: GOSUB 1060: IF LEFT$(A$, 1) = "-" THEN A = -A
910 IF IZ = 2 THEN A = A - 90: RETURN ELSE A = A * IZ: RETURN
920 IF IN$ = "" THEN A = 0: RETURN ELSE IF TZ = 1 THEN A = 12 ELSE IF TZ = POLE THEN A = 25 ELSE IF TZ = GUNTER THEN A = 100 ELSE A = 0'tape handler
930 B$ = IN$: GOSUB 1060: A = A * TZ: RETURN
940 IF IN$ = "" THEN A = -999: RETURN'compass handler; azimuth, quadrants, gradians
950 A$ = IN$: B$ = ""
960 FOR I% = 1 TO LEN(A$)'; finder
970 IN$ = MID$(A$, I%, 1)
980 IF IN$ = ";" THEN PRINT "Tell me why you want multiple compass readings and I'll let you do it.": B$ = LEFT$(A$, I% - 1): I% = LEN(A$)
990 NEXT
1000 IF B$ = "" THEN B$ = A$
1010 IF QZ = 0 THEN A = 60: GOSUB 1060: RETURN
1020 IF QZ = 1 THEN A = 60: GOSUB 1150: RETURN
1030 IF QZ = .9 THEN A = VAL(IN$) * QZ: RETURN
1040 BEEP: PRINT "Bad value for QZ = compass quadrant logic.": A = -9999: RETURN
1050 PRINT "Tell me why you want to enter multiple compass readings & I'll let you do it.": RETURN
1060 IF B$ = "" OR B$ = "/" THEN A = 0: RETURN'/minutes etc handler
1070 L% = 0: FOR J% = 1 TO LEN(B$): M% = ASC(MID$(B$, J%, 1)): IF NOT (M% = 32 OR M% > 42 AND M% < 58) THEN L% = -9: PRINT "Garbage character "; CHR$(K%)
1080 NEXT: IF L% = -9 THEN A = -999: RETURN
1090 J% = 1
1100 IF MID$(B$, J%, 1) = "/" THEN GOSUB 1120: RETURN 'minutes only
1110 IF J% = LEN(B$) THEN A = VAL(B$): RETURN ELSE J% = J% + 1: GOTO 1100 'no /
1120 IF J% = 1 THEN A = VAL(RIGHT$(B$, LEN(B$) - 1)) / A: RETURN'minutes only
1130 IF J% = LEN(B$) THEN A = VAL(LEFT$(B$, J% - 1)): RETURN 'degrees only
1150 IF LEN(B$) = 1 THEN IN$ = B$: GOSUB 500: IF IN$ = "N" THEN A = 0: RETURN ELSE IF IN$ = "E" THEN A = 90: RETURN ELSE IF IN$ = "S" THEN A = 180: RETURN ELSE IF IN$ = "W" THEN A = 270: RETURN ELSE PRINT B$; " is not a choice!": A = -888: RETURN
1160 IN$ = LEFT$(B$, 1): GOSUB 500: C$ = IN$
1170 IN$ = RIGHT$(B$, 1): GOSUB 500: D$ = IN$
1180 B$ = MID$(B$, 2, LEN(B$) - 2): IF B$ = "" THEN A = 45: ELSE GOSUB 1060
1190 IF C$ = "N" AND D$ = "E" THEN RETURN
1200 IF C$ = "S" AND D$ = "E" THEN A = 180 - A: RETURN
1210 IF C$ = "S" AND D$ = "W" THEN A = 180 + A: RETURN
1220 IF C$ = "N" AND D$ = "W" THEN A = 360 - A: RETURN
1230 BEEP: PRINT "Bad quadrant.": A = -999: RETURN
1240 REM DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD
1250 PRINT "Suppress output? N"; : GOSUB 520: IF IN$ = "Y" THEN 1360'Display duh data
1260 J% = 0: PRINT "Suppress remarks? Y"; : GOSUB 520: IF IN$ = "N" THEN J% = -1
1270 PRINT "Display original input? N"; : GOSUB 520: IF IN$ <> "Y" THEN K% = 0 ELSE K% = -1
1280 PRINT "To printer? N"; : GOSUB 520: IF IN$ = "Y" THEN GOSUB 1630: RETURN
1320 PRINT TT$(I%); TAB(10); FR$(I%); TAB(20); COMP(I%); TAB(30); TAPE(I%); : IF J% THEN PRINT TAB(40); RM$(I%);
1330 A$ = INKEY$: IF A$ = "" THEN 1330
1340 NEXT
1350 PRINT : INPUT "That's all.", IN$
1360 PRINT "Wanna change sump'un? N"; : GOSUB 520: IF IN$ <> "Y" THEN 1500
1370 PRINT "Delete station with OLD FROM=DELETE": PRINT "Insert before station with OLD FROM=INSERT.": PRINT "<RETURN> leaves old value."
1380 INPUT "TO->", IN$: IF IN$ = "" OR IN$ = "-" THEN 1360
1390 GOSUB 460: IF II% < 0 THEN 1360
1400 K% = II%: PRINT "OLD FROM= "; FR$(K%)
1410 INPUT "New FROM->", IN$: IF IN$ = "-" THEN 1380
1420 IF IN$ = "INSERT" OR IN$ = "insert" THEN GOSUB 440: GOSUB 1600: NN% = NN% + 1: GOTO 1360
1430 IF IN$ = "DELETE" OR IN$ = "delete" THEN GOSUB 440: GOSUB 1550: GOTO 1360
1440 IF IN$ <> "" THEN GOSUB 460: IF II% < 0 THEN 1360 ELSE FR$(K%) = IN$
1450 PRINT "Old COMP= "; COMP(K%): INPUT "NEW COMP->", IN$: IF IN$ <> "" THEN IF IN$ = "-" THEN 1400 ELSE DT$(K%) = DT$(K%) + " cc" + IN$: GOSUB 940: IF A >= 0 AND A <= 360 THEN COMP(K%) = A: ELSE BEEP: PRINT "Try again!": GOTO 1450
1460 PRINT "Old TAPE = "; TAPE(K%): INPUT "New TAPE->", IN$: IF IN$ <> "" THEN IF IN$ = "-" THEN 1450 ELSE GOSUB 920: IF A >= 0 THEN TAPE(K%) = A: DT$(K%) = DT$(K%) + " tt" + IN$ ELSE BEEP: PRINT "Try again!": GOTO 1460
1470 IF IZ THEN PRINT "Old INCL ="; INCL(K%): INPUT "New INCL->"; IN$: IF IN$ <> "" THEN IF IN$ = "-" THEN 1460 ELSE GOSUB 870: IF A >= -90 AND A <= 90 THEN DT$(K%) = DT$(K%) + " ii" + IN$: INCL(K%) = A ELSE PRINT "Incl out of range.": GOTO 1470
1480 PRINT "Old remark= "; RM$(K%): LINE INPUT "New remark->"; IN$: IF IN$ <> "" THEN IF IN$ = "-" THEN 1460 ELSE RM$(K%) = IN$
1490 GOTO 1360
1500 PRINT "Wanna recalculate? N"; : GOSUB 520: IF IN$ <> "Y" THEN RETURN
1510 PRINT "All of 'em? Y"; : GOSUB 520: I% = 0: J% = NN% - 1: IF IN$ <> "N" THEN 1540
1520 INPUT "Starting station->"; IN$: GOSUB 460: I% = II%: IF II% < 0 THEN 1500
1530 INPUT "Stopping station->"; IN$: GOSUB 460: J% = II%: IF II% < 0 THEN 1500
1540 GOSUB 440: FOR N% = I% TO J%: GOSUB 800: NEXT: RETURN
2440 REM KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK
2450 CLS : PRINT "Let's see if I can plot a map on your screen and printer.": PRINT "I'll plot a square. You measure the horizontal and vertical size.": PRINT "Then I'll adjust the square to make it squarer."
2460 PRINT "You may report in either millimeters or inches and twentieths.": GOSUB 480
2470 PRINT "Send it to the printer? N"; : GOSUB 520: IF IN$ = "Y" THEN A = PRNX: I% = -1 ELSE A = SCRX
2480 KEY OFF: ON ERROR GOTO 2580: SCREEN 2
2490 IF A <= 1 THEN LINE (120, 0)-(518, 0): LINE -(518, 199 * A): LINE -(120, 199 * A): LINE -(120, 0): LINE (318, 0)-(318, 199 * A): LINE (120, 99 * A)-(518, 99 * A)
2500 IF A > 1 THEN A = 1 / A: LINE (120 * A, 0)-(518 * A, 0): LINE -(518 * A, 199): LINE -(120 * A, 199): LINE -(120 * A, 0): LINE (318 * A, 0)-(318 * A, 199): LINE (120 * A, 99)-(518 * A, 99)
2510 A$ = INKEY$: IF A$ = "" THEN 2510 ELSE IF I% = -1 THEN GOSUB 2770
2520 SCREEN 0
2530 INPUT "What was the horizontal distance? If you don't know, then enter 0.0 ", B
2540 IF B = 0 THEN PRINT "So you like it the way it is? Y"; : GOSUB 520: IF IN$ = "N" THEN PRINT "OK Mush4brains, we'll do it again.": GOSUB 480: GOTO 2450 ELSE RETURN
2550 INPUT "What was the vertical distance"; C: B = B / C
2551 PRINT "I can change the screen by "; ABS(B - 1) / 1 * 100; "% if you wish.": PRINT "Your wish is my command. Y"; : GOSUB 520: IF IN$ <> "N" THEN IF K% THEN PRNX = PRNX * B ELSE SCRX = SCRX * B
2560 PRINT "You may permanently change the screen aspect by changing variable SCRX in the source code. The printer aspect is in variable PRNX"
2570 GOSUB 480: RETURN
2580 PRINT "I can't plot on your computer. I only know CGA.": PRINT "Error "; ERR; " in line "; ERL: RESUME 2570
2590 REM MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
2600 IF NN% < 2 THEN PRINT "You ain't got no data to plot!": GOSUB 480: RETURN ELSE PRINT "set scale? N"; : GOSUB 520: IF IN$ = "Y" THEN PRINT "Topo scale? Y"; : GOSUB 520: IF IN$ = "N" THEN INPUT "N-S size->", A ELSE A = 11050 ELSE A = 0
2610 B = 0: C = 0: D = 0: E = 0: PRINT "Send it to the printer? N"; : GOSUB 520: IF IN$ = "Y" THEN K% = -1 ELSE K% = 0
2620 FOR I% = 0 TO NN% - 1
2630 IF B < NS(I%) THEN B = NS(I%)
2640 IF C > NS(I%) THEN C = NS(I%)
2650 IF D < ES(I%) THEN D = ES(I%)
2660 IF E > ES(I%) THEN E = ES(I%)
2670 NEXT
2680 IF 198 / (B - C) < 338 / (D - E) THEN C = 198 / (B - C) ELSE C = 338 / (D - E)
2690 IF A <> 0 THEN A = 200 / A: IF A > C THEN PRINT "N-S size too small. Must be > "; 200 / C: GOTO 2600 ELSE ELSE A = C
2700 IF K% THEN C = PRNX ELSE C = SCRX
2710 KEY OFF: SCREEN 2: LINE (600, 0)-(639, 0): LINE (600, 199)-(639, 199): FOR I% = 0 TO NN% - 1: J% = I% + 1
2860 FOR J% = 0 TO 111: PRINT #1, CHR$(0); : NEXT'pad out line
2865 NEXT
2870 CLOSE : RETURN
2872 IF ERR = 25 THEN RESUME 2870 ELSE ON ERROR GOTO 0: RESUME
2880 REM BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
2890 INPUT "Reassign station "; IN$: GOSUB 460: K% = II%: IF K% < 0 THEN GOSUB 480: RETURN
2900 INPUT " such that station "; IN$: GOSUB 460: J% = II%: IF J% < 0 THEN GOSUB 480: RETURN
2910 INPUT " equals station "; IN$: GOSUB 460: IF II% < 0 THEN GOSUB 480: RETURN
2920 NS(K%) = NS(K%) - NS(J%) + NS(II%)
2930 ES(K%) = ES(K%) - ES(J%) + ES(II%)
2940 GOSUB 1500: RETURN
2950 REM CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2960 PRINT "Close a survey loop to check for blunder."
2970 INPUT "First closure station ->"; IN$: GOSUB 460: IF II% < 0 THEN RETURN ELSE J% = II%: A$ = IN$
2980 INPUT "Second name for the same closure station ->"; IN$: GOSUB 460: IF II% < 0 THEN RETURN ELSE K% = II%: B$ = IN$
2990 A = NS(K%) - NS(J%)
3000 B = ES(K%) - ES(J%)
3010 C = SQR(A * A + B * B)
3020 D = ATN(B / (A + 1E-08)) * RD: IF A < 0 THEN D = D + 180
3030 IF D < 0 THEN D = D + 360
3040 PRINT : PRINT "The closure error betwixt "; A$; " and "; B$; " is "; INT(C + .5);
3050 PRINT "In the direction "; INT(D + .5); " to "; B$; " from "; A$'for this sort of ½fast preliminary surveying, you don't need to keep tract of the change.
3060 PRINT "Do all the stations lay upon the loop? Y"; : GOSUB 520: IF IN$ = "N" THEN RETURN
3070 E = 0: FOR I% = 0 TO NN% - 1: E = E + TAPE(I%): NEXT: F = C / E * 100'run of loop
3080 PRINT "That's "; : PRINT USING "###.#"; F; : PRINT "% of a run of "; INT(E + .5)
3090 PRINT : PRINT "Should I close this loop assuming that all of the error is in the compass? Y"; : GOSUB 520: IF IN$ = "N" THEN RETURN
3100 IF F > 5 THEN PRINT "You don't really expect me to close a loop with "; CINT(F); "% closure error, do you? N"; : GOSUB 520: IF IN$ <> "Y" THEN RETURN
3110 C = 0: D = 0
3120 FOR I% = 0 TO NN% - 1'sum movements each axis each shot
3130 C = C + ABS(NI(I%))
3140 D = D + ABS(EI(I%))
3150 NEXT
3160 E = 0: F = 0
3170 FOR I% = 0 TO NN% - 1'adjust coordinates
3180 E = E + ABS(NI(I%)) / C * B
3190 F = F + ABS(EI(I%)) / D * A
3200 NS(I%) = NS(I%) - F'north error distributed with east movement. Compass Rule
3210 ES(I%) = ES(I%) - E
3220 NEXT
3230 PRINT "I can calculate the acreage in this loop. Your wish is my command. Y"; : GOSUB 520: IF IN$ = "N" THEN RETURN
3240 PRINT "Are you sure that this data forms a loop, that each station references the": PRINT "previous station, and that all the stations are on the loop? N"; : GOSUB 520
3250 A = 0
3260 FOR I% = 1 TO NN% - 1
3270 A = A + (NS(I%) + NS(I% - 1)) * (ES(I%) - ES(I% - 1))
3280 NEXT
3290 A = ABS(A / 87120!)
3300 PRINT "The area enclosed by this loop is "; : PRINT USING "####.##"; A; : PRINT " acres."
3310 IF IN$ <> "Y" THEN PRINT "But I'm not sure either."
3320 GOSUB 480: RETURN
3330 REM IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
3340 CLS : PRINT "Instrument parameters": PRINT : PRINT "A = Azimuth": PRINT " G = gradians": PRINT "; Q = Quadrants": PRINT "[May be degrees/minutes][Multiple readings separated by "; CHR$(34); ";"; CHR$(34); "]"
3350 IF QZ = 0 THEN A$ = "A" ELSE IF QZ = 1 THEN A$ = "Q" ELSE IF QZ = .9 THEN A$ = "G" ELSE A$ = "?"
3360 PRINT "How do you prefer your compass? "; A$; : GOSUB 520: IF ASC(IN$) = 13 THEN 3380 ELSE A$ = IN$
3370 IF A$ = "A" THEN QZ = 0 ELSE IF A$ = "Q" THEN QZ = 1 ELSE IF A$ = "G" THEN QZ = .9 ELSE PRINT A$; " is not a choice!": GOSUB 480: GOTO 3340
3380 PRINT "Compass declination of"; DC; "? Y"; : GOSUB 520: IF IN$ = "N" THEN INPUT "Compass declination ->", DC
3390 PRINT "Using backcompass? N"; : GOSUB 520
3400 IF IN$ = "Y" THEN PRINT "Backcompass not supported. But I'll write them down on the": PRINT "disk if you want.": BZ = 1: PRINT "Backcompass declination of "; DB; "? Y"; : GOSUB 520: IF IN$ = "N" THEN INPUT "Backcompass declination ->", DB
3410 PRINT "F = Feet [May be feet/inches]": PRINT "M = Meters": PRINT "P = Poles or rods [May be poles/links]": PRINT "C = Gunter Chains [May be chains/links]": PRINT "Q = Pace [User defined]"
3420 IF TZ = 1 THEN A$ = "F" ELSE IF TZ = MTR THEN A$ = "M" ELSE IF TZ = POLE THEN A$ = "P" ELSE IF TZ = GUNTER THEN A$ = "C" ELSE A$ = "Q"
3430 PRINT "And how do you measure your distance? "; A$; : GOSUB 520
3440 IF IN$ = "F" THEN TZ = 1 ELSE IF IN$ = "M" THEN TZ = MTR ELSE IF IN$ = "P" THEN TZ = POLE ELSE IF IN$ = "C" THEN TZ = GUNTER ELSE IF IN$ = "Q" THEN INPUT "Length, in feet -> "; TZ ELSE IF ASC(IN$) <> 13 THEN PRINT IN$; " no good": GOTO 3410
3450 IF IZ THEN A$ = "Y" ELSE A$ = "N"
3460 PRINT "Using clinometer? "; A$; : GOSUB 520
3470 IF ASC(IN$) = 13 THEN IN$ = A$
3480 IF IN$ = "Y" THEN IZ = 1: PRINT "D = degrees [May be degrees/minutes]": PRINT "G = gradians": PRINT "S = semicircular protractor": PRINT "D G S D"; : GOSUB 520 ELSE IZ = 0
3490 IF IZ THEN IF IN$ = "G" THEN IZ = .9 ELSE IF IN$ = "S" THEN IZ = 2 ELSE IF ASC(IN$) <> 13 THEN 3460
3500 IF IZ THEN PRINT "Clinometer correction of "; CC; "? Y"; : GOSUB 520: IF IN$ = "N" THEN INPUT "Clinometer correction -> ", CC
3510 PRINT "Using offsets? N"; : GOSUB 520: IF IN$ = "Y" THEN RZ = 1: PRINT "Offsets not supported in simple program." ELSE RZ = 0
3520 PRINT "Put the data on drive "; DR$; "? Y"; : GOSUB 520: IF IN$ <> "N" THEN 3540 ELSE PRINT "Data drive ->";
3530 IN$ = INKEY$: IF IN$ = "" THEN 3530 ELSE GOSUB 500: DR$ = IN$ + ":": PRINT DR$
3540 PRINT "With an extension of "; X10$; "? Y"; : GOSUB 520: IF IN$ = "N" THEN INPUT "Extension ->.", X10$: X10$ = "." + X10$: IF LEN(X10$) > 4 THEN PRINT "Extension too long! "; X10$: BEEP: GOTO 3540
3550 PRINT "Ya like it? Y"; : GOSUB 520: IF IN$ = "N" THEN 3340 ELSE RETURN
3560 PRINT "This is a simple version of CAVEMAP with many complications removed.": PRINT "Instructions for using this program are in the file CAVEMAP1.TXT"
3570 PRINT "Instructions for surveying [quickly, easily & inexpensively getting the data": PRINT "which CAVEMAP manipulates] are in the files SIY*.TXT"
3580 PRINT "For help, contact": PRINT "Dave Beiter": PRINT "CAVE, Inc": PRINT "½ Fast Road": PRINT "Ritner, KY 42639": PRINT "(606)376-3137 [please don't expect me to think on the phone]"
3620 BZ = 0'backcompass logic
3630 DC = 0: DB = 0'declination compass & backcompass
3640 DR$ = "A:"'data drive
3650 IC = 0'inclinometer correction
3660 IZ = 0'inclinometer logic
3670 X10$ = ".CAV"
3680 PR$ = ""'previous station
3690 PX$ = "prefix"
3700 QZ = 0'compass units logic
3710 TZ = 1'tape units logic
3720 RZ = 0'offset logic
3730 HD = 0'horizontal distance
3740 RD = 57.29578'degrees per radian
3750 MTR = 3.28083'feet per meter
3760 POLE = 16.5'feet per USA pole
3770 GUNTER = 66'feet per Gunter's chain of 100 links
3801 'CAVEMAP1.BAS^B4P, date 930714, (c) 1993 DP_BYTER, proliferate freely. CAVE Inc, ½ Fast Road, Ritner, KY 42639 606/376-3137
3802 'Silva Ranger Compass, $41. 200' fiberglass/PVC tapemeasure, $27. + $5 Shipping & handling. Instructions in CAVEMAP1.DOC
12600 IF NN% < 2 THEN PRINT "You ain't got no data to plot!": GOSUB 480: RETURN
12605 PRINT "The map will dump to your printer at the proper aspect in normal pica ": PRINT "(10/inch horizontal & 6/inch vertical). Use print screen key.": GOSUB 480
12610 A = 0: B = 0: C = 0: D = 0: E = 0
12620 FOR I% = 0 TO NN% - 1
12630 IF B < NS(I%) THEN B = NS(I%)
12640 IF C > NS(I%) THEN C = NS(I%)
12650 IF D < ES(I%) THEN D = ES(I%)
12660 IF E > ES(I%) THEN E = ES(I%)
12670 NEXT
12680 IF 4 / (B - C) < (79 / 10) / (D - E) THEN C = 4 / (B - C) ELSE C = (79 / 10) / (D - E)
12710 KEY OFF: SCREEN 0: CLS : FOR I% = 0 TO NN% - 1: J% = I% + 1