DISTANCE computes the shortest distance and true bearing from any point on the earth’s surface to any other location.
Type in this easy-to-use program (line 10 has 97 spaces) and input geographical coordinates when prompted. Get latitude and longitude from a map or almanac. Enter coordinates in degrees and tenths (six minutes is 1/10 degree); enter east longitude or south latitude as a negative number, to distinguish from west and north. For example, enter 18 degrees, 30 min. east, and 27 degrees, 18 min. north as -18.5 and 27.3. Your computer then calculates bearings in true (not magnetic) north and distance in land (statute) miles, nautical miles and kilometers.
When you get another reading, you can keep or change your initial start point (K/C). SAVE the program with GOTO 4000.
Beginners can learn from subroutines earmarked with REMs in this well prompted listing. For example, GOTO 9977 to use a line renumbering routine. (This routine will not renumber GOTO and GOSUB statements in the main listing; you must change these yourself.)
DISTANCE serves as a subroutine in longer sea/air navigation programs. I sell this and another 16K program for use with ham radios that calculates distance/direction. Each tape costs $5.
William Bosley, K3NN, 201 Highland
St., Valparaiso, FL 32580
1 REM (C)82, BOSLEY, K3NN
8 REM INITIALIZE
9 REM X$ USED TO ERASE
10 LET X$=" "
20 LET S$="********************************"
30 CLS
40 PRINT TAB 5;"BEARING AND DISTANCE"
49 REM INPUT START COORDINATES
50 PRINT AT 9,2;"ENTER START POINT LONGITUDE",,,TAB 5;"(DEGREES AND TENTHS)",,,TAB 8;"( - FOR EAST)"
59 REM INPUT START LONGITUDE
60 GOSUB 3000
69 REM C$= INPUT LONG OR LAT IN DEGREES G=START LONG IN DEGREES
70 LET G=VAL C$
79 REM G$=LONG IN DEGREES WITH "WEST" OR "EAST" INDICATED
80 LET G$=STR$ G+" WEST"
90 IF SGN G=-1 THEN LET G$=STR$ ABS G+" EAST"
99 REM CONVERT DEG TO RADIANS
100 LET G=G*PI/180
110 CLS
119 REM DISPLAY START LONG
120 PRINT "FROM: ";G$
130 PRINT AT 9,2;"ENTER START POINT LATITUDE",,,TAB 5;"(DEGREES AND TENTHS)",,,TAB 8;"( - FOR SOUTH)"
139 REM INPUT START LATITUDE
140 GOSUB 3000
149 REM E=START LATITUDE (DEG)
150 LET E=VAL C$
159 REM CHECK LIMITS
160 IF E<=90 AND E>=-90 THEN GOTO 190
169 REM OUT OF LIMITS
170 PRINT AT 16,0;X$;X$;AT 18,0;S$;" MUST BE BETWEEN 90 AND -90 DEG",TAB 8;"PLEASE REENTER",S$
180 GOTO 140
189 REM E$=START LAT N/S
190 LET E$=STR$ E+" NORTH"
200 IF SGN E=-1 THEN LET E$=STR$ ABS E+" SOUTH"
209 REM CONVERT TO RADIANS
210 LET E=E*PI/180
219 REM DISPLAY START LAT
220 PRINT AT 1,6;E$
998 REM INPUT END POINT COORD==
999 REM ERASE BOTTON OF SCREEN
1000 PRINT AT 4,0;X$;X$;X$;X$;X$;X$
1010 PRINT AT 9,3;"ENTER END POINT LONGITUDE",,,TAB 5;"(DEGREES AND TENTHS)",,,TAB 8;"( -FOR EAST)"
1019 REM INPUT END LONG
1020 GOSUB 3000
1029 REM H=END LONG (DEG)
1030 LET H=VAL C$
1039 REM H$=END LONG E/W
1040 LET H$=STR$ H+" WEST"
1050 IF SGN H=-1 THEN LET H$=STR$ ABS H+" EAST"
1059 REM CONVERT TO RADIANS
1060 LET H=H*PI/180
1069 REM DISPLAY END LONG AND ERASE REST OF SCREEN
1070 PRINT AT 4,0;"TO: ";H$;AT 7,0;X$;X$;X$;X$;X$
1080 PRINT AT 9,3;"ENTER END POINT LATITUDE",,,TAB 5;"(DEGREES AND TENTHS)",,,TAB 8;"( - FOR SOUTH)"
1089 REM INPUT END LAT
1090 GOSUB 3000
1099 REM F=END LAT IN DEGREES
1100 LET F=VAL C$
1109 REM CHECK LIMITS
1110 IF F<=90 AND F>=-90 THEN GOTO 1140
1119 REM OUT OF LIMITS
1120 PRINT AT 16,0;X$;X$;AT 18,0;S$;" MUST BE BETWEEN 90 AND -90 DEG",TAB 8;"PLEASE REENTER",S$
1130 GOTO 1090
1139 REM F$=END LAT N/S
1140 LET F$=STR$ F+" NORTH"
1150 IF SGN F=-1 THEN LET F$=STR$ ABS F+" SOUTH"
1159 REM CONVERT TO RADIANS
1160 LET F=F*PI/180
1169 REM DISPLAY END LAT AND ERASE REST OF SCREEN
1170 PRINT AT 5,6;F$;AT 7,0;X$;X$;X$;X$;X$
1998 REM ===CALCULATION=========
1999 REM CRASHPROOFING
2000 IF F=0 OR F=-E OR F=-PI/2 THEN LET F=F+.00017
2009 REM L=DIFFERENCE IN START AND END LONGITUDES
2010 LET L=G-H
2019 REM ADJUST QUADRANT
2020 IF L>PI THEN LET L=L-2*PI
2030 IF L<-PI THEN LET L=L+2*PI
2039 REM CRASHPROOFING
2040 IF INT (2*L/PI)=2*L/PI THEN LET L=L+.00017
2049 REM A=INTERIM PARAMETER
2050 LET A=ATN (COS L*(COS F/SIN F))
2059 REM C=TRUE BEARING(RADIANS)
2060 LET C=ATN (SIN A/((COS L/SIN L)*COS (E+A)))
2069 REM CONVERT TO DEGREES AND ADJUST QUADRANT
2070 IF SGN L=1 AND SGN C=1 THEN LET C=C*180/PI
2080 IF SGN L<>SGN C THEN LET C=180*(1+C/PI)
2090 IF SGN L=-1 AND SGN C=-1 THEN LET C=180*(2+C/PI)
2099 REM NM=DIST (NAUTIAL MILES)
2100 LET NM=(3437.7468*ACS (SIN E*SIN F+COS E*COS F*COS L))
2109 REM ROUNDOFF C TO INT DEG
2110 LET C=INT (C+.5)
2119 REM SM=STATUTE MILES
2120 LET SM=INT (1.1515152*NM+.5)
2129 REM KM=KILOMETERS
2130 LET KM=INT (1.853184*NM+.5)
2139 REM ROUNDOFF NM
2140 LET NM=INT (NM+.5)
2149 REM B$=BEARING EXPRESSED AS A 3 DIGIT NUMBER IN DEGREES
2150 LET B$=STR$ C
2160 IF LEN B$=3 THEN GOTO 2190
2170 LET B$="0"+B$
2180 GOTO 2160
2189 REM DISPLAY RESULTS
2190 PRINT AT 9,0;"BEARING:",B$;" DEGREES",,,"DISTANCE:",NM;" NAUT MI",,SM;" STAT MI",,KM;" KILOMETERS"
2199 REM =====ANOTHER GO ?======
2200 PRINT AT 19,0;S$;" ANOTHER COMPUTATION? (Y/N)?",S$
2210 PAUSE 33333
2219 REM CONT UNLESS "N" PRESSED
2220 IF INKEY$<>"N" THEN GOTO 2260
2230 CLS
2239 REM MAKE FRIENDLY
2240 PRINT AT 10,13;"BYE",,,TAB 7;"HAVE A NICE DAY"
2250 STOP
2260 PRINT AT 20,0;"KEEP OR CHANGE START POINT(K/C)?"
2270 PAUSE 33333
2280 LET C$=INKEY$
2289 REM REJECT <ENTER>
2290 IF C$="" THEN GOTO 2270
2299 REM GOTO "ENTER END POINT"
2300 IF C$="K" THEN GOTO 1000
2310 IF C$="C" THEN RUN
2319 REM "K" OR "C" NOT PRESSED
2320 PRINT AT 15,0;S$;" PLEASE ANSWER THE QUESTION",S$
2330 GOTO 2270
2999 REM ENTER DEGREES-CHECK FOR -180 TO +180===============
3000 INPUT C$
3009 REM REJECT <ENTER>
3010 IF C$="" THEN GOTO 3000
3019 REM 1ST CHARACTER MUST BE NUMBER, MINUS SIGN, OR DECIMAL POINT
3020 IF C$(1)<>"-" AND C$(1)<"." OR C$(1)>"9" THEN GOTO 3100
3029 REM ALL OTHER CHARACTERS MUST BE NUMBER OR DECIMAL POINT
3030 FOR I=2 TO LEN C$
3040 IF C$(I)<"." OR C$(I)>"9" THEN GOTO 3100
3050 NEXT I
3059 REM CHECK LIMITS
3060 IF VAL C$<=180 AND VAL C$>=-180 THEN RETURN
3099 REM ======ERROR============
3100 PRINT AT 19,0;X$;AT 18,0;S$;TAB 11-LEN C$/2;"CANT BE ";C$,TAB 8;"PLEASE REENTER",S$
3110 GOTO 3000
3998 REM =AUTOSTART /SAVE / LOGO
3999 REM CLEAR TO CUT LOAD TIME
4000 CLEAR
4010 FAST
4020 SAVE "DISTANCE"
4030 PRINT AT 9,11;"BOSLEYS",,,TAB 11;"BASEMENT",,,TAB 9;"LABORATORIES"
4040 PAUSE 250
4050 RUN
9966 REM ====PROGRAMING AID===== ==NOT PART OF PROGRAM==
9967 STOP
9968 LET A=16509
9969 INPUT S
9970 PRINT S
9971 LET L=256*PEEK A+PEEK (A+1)
9972 IF L=S THEN RETURN
9973 IF L>9966 THEN GOTO 9976
9974 LET A=A+4+PEEK (A+2)+265*PEEK (A+3)
9975 GOTO 9971
9976 PRINT S;" NOT FOUND"
9977 PRINT "LAST LINE TO BE RENUMBERED=";
9978 GOSUB 9968
9979 LET AE=A+3
9980 PRINT "1ST LINE TO BE RENUMBERED=";
9981 GOSUB 9968
9982 PRINT "1ST NEW LINE NUMBER=";
9983 INPUT N
9984 PRINT N,"INCREMENT BY=";
9985 INPUT I
9986 PRINT I
9987 IF A>AE THEN GOTO 9997
9988 IF N>9966 THEN GOTO 9999
9989 LET M=INT (N/256)
9990 POKE A,M
9991 POKE (A+1),N-256*M
9992 LET LE=PEEK (A+2)+256*PEEK (A+3)
9994 LET A=A+4+LE
9995 LET N=N+I
9996 GOTO 9987
9997 PRINT ,,"RENUMBER COMPLETE"
9998 STOP
9999 PRINT ,,"CANT COMPLETE. LINE NR >9965"
SYNTACTIC SUM: 3758, 8K ROM
Media
Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.