home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / HAMRADIO / UNIGRID2.BAS < prev    next >
BASIC Source File  |  2000-06-30  |  13KB  |  263 lines
  1. 10 CLS$=CHR$(26):' character to clear screen, set for your terminal 
  2. 20 ' =======================================================================
  3. 30 ' Version 2, 3 may 87 by Jim Lill, WA2ZKD
  4. 40 ' - optimized for CP/M, MBASIC 5.0
  5. 50 ' - changed text to upper and lower case for easier reading.
  6. 60 ' - added a inkey$ sub-routine for improved user interface
  7. 70 ' =======================================================================
  8. 80 ' worldwide QTH locator, contest scoring and map program by N6NB.
  9. 90 ' *a public domain program for use on apple, commodore, ibm, trs-80
  10. 100 '    and other microcomputers with basic and at least 32k of ram.
  11. 110 ' *this program converts Lat-Long to 4 and 6-digit locators, calculates
  12. 120 '    beam headings and distance between locators, tallies locator-based
  13. 130 '    contest scores, and provides map-to-locator translations.
  14. 140 ' *thanks to WA1JXN, W3RUU, KC6A and SM5AGM for their suggestions.
  15. 150 ' *note:  enter Minus sign ('-') for east Longitude or south latitude.
  16. 160 '  --if 0 Degrees east or south, use Minus sign ('-') with Minutes.
  17. 170 '   (examples:  -31 Degr, 10.1 Mins or 0 Degr, -10.1 Mins).
  18. 180 PI=3.14159:RA=57.2958:DEF FNA(X)=INT(X*100+.5)/100:PT=0:NR=5:C1=0
  19. 190 M(1)=50:M(2)=100:M(3)=150:M(4)=250:F(1)=1:F(2)=2:F(3)=3:F(4)=4:F(5)=5
  20. 200 U(1)=82:U(2)=82:U(3)=57:U(4)=57:U(5)=88:U(6)=88
  21. 210 L(1)=65:L(2)=65:L(3)=48:L(4)=48:L(5)=65:L(6)=65
  22. 220 SX(1)=.06336:SX(2)=.12672:SX(3)=.25344:SX(4)=1.01376:SX(5)=2.64
  23. 230 SY(1)=13.7149:SY(2)=6.85747:SY(3)=3.42873:SY(4)=.857184:SY(5)=.329159
  24. 240 S$(1)="1:1,000,000 scale":S$(2)="1:500,000 scale":ML$=" Mi"
  25. 250 S$(3)="1:250,000 scale":S$(4)="1:62,500 scale":S$(5)="1:24,000 scale"
  26. 260 PRINT CLS$
  27. 270 PRINT:PRINT:PRINT "  QTH Locator Program Startup Menu"
  28. 280 PRINT:PRINT "1 - Convert locators to coordinates"
  29. 290 PRINT "2 - Convert coordinates to locators"
  30. 300 PRINT "3 - Obtain locator of a point on map"
  31. 310 PRINT "4 - Pinpoint a known locator on map"
  32. 320 PRINT "5 - Compute DX and contest scores"
  33. 330 PRINT "6 - Change contest scoring system"
  34. 340 PRINT "7 - Exit"
  35. 350 PRINT:PRINT "Enter 1,2,3,4,5,6 or 7 ==>  ";:' get CN
  36. 360 K$=INKEY$
  37. 370 IF K$="" THEN 360
  38. 380 CN = ASC(K$) - 48
  39. 390 ON CN GOTO 430,580,1810,2160,780,1260,1690
  40. 400 PRINT "invalid choice.":GOTO 270
  41. 410 ' locator-to-coordinate conversion routine; 4 and 6-digit locators ok.
  42. 420 ' if 4 digits, approximate center of area is assumed.
  43. 430 PRINT CLS$: PRINT "Enter locator to convert:":GOSUB 440:GOTO 270
  44. 440 INPUT G1$
  45. 450 IF LEN(G1$)=4 THEN G1$=G1$+"MM"
  46. 460 IF LEN(G1$)<>6 THEN 1470
  47. 470 FOR K=1 TO 6:A(K)=ASC(MID$(G1$,K,1))
  48. 480 IF A(K)>U(K) OR A(K)<L(K) THEN 1470
  49. 490 NEXT K
  50. 500 LO=180-(A(1)-65)*20-(A(3)-48)*2-(A(5)-64.5)/12
  51. 510 LA=-90+(A(2)-65)*10+A(4)-48+(A(6)-64.5)/24
  52. 520 XO$="W Long":LX=ABS(LO):IF LO<0 THEN XO$="E Long"
  53. 530 XA$="n Lat":LY=ABS(LA):IF LA<0 THEN XA$="s Lat"
  54. 540 OM=(LX-INT(LX))*60:AM=(LY-INT(LY))*60
  55. 550 PRINT:PRINT G1$;" = ";INT(LX);"Deg ";FNA(OM);"Min ";XO$
  56. 560 PRINT TAB(10)INT(LY);"Deg ";FNA(AM);"Min ";XA$:RETURN
  57. 570 ' coordinate-to-locator conversion routine
  58. 580 PRINT CLS$:GOSUB 590:GOSUB 710:GOTO 270
  59. 590 PRINT:PRINT "use (-) for East Long, South Lat"
  60. 600 PRINT "Enter the Longitude (Degrees,Mins)":INPUT LO,OM
  61. 610 L2=ABS(OM):IF LO<0 THEN OM=-L2
  62. 620 L1=ABS(LO):LO=LO+OM/60:XO$="W Long":IF LO<0 THEN XO$="E Long"
  63. 630 IF L1>179 THEN 1440
  64. 640 IF L2>59.99 THEN 1440
  65. 650 PRINT "Enter the Latitude (Degs,Mins)":INPUT LA,AM
  66. 660 L4=ABS(AM):IF LA<0 THEN AM=-L4
  67. 670 L3=ABS(LA):LA=LA+AM/60:XA$="n Lat":IF LA<0 THEN XA$="s Lat"
  68. 680 IF L3>89 THEN 1440
  69. 690 IF L4>59.99 THEN 1440
  70. 700 QA=LA:QO=LO:RETURN
  71. 710 QP=(180-QO)/20:C=INT(QP):B$=CHR$(C+65):R=(QP-C)*10:C=INT(R):D$=CHR$(C+48)
  72. 720 M=(R-C)*24:C=INT(M):F$=CHR$(C+65):QB=(QA+90)/10:C=INT(QB):C$=CHR$(C+65)
  73. 730 R=(QB-C)*10:C=INT(R):E$=CHR$(C+48):M=(R-C)*24:C=INT(M):G$=CHR$(C+65)
  74. 740 A$=B$+C$+D$+E$+F$+G$
  75. 750 PRINT:PRINT "at ";INT(L1);"/";FNA(L2);XO$;" - ";INT(L3);"/";FNA(L4);XA$
  76. 760 PRINT "The Gridlocator is ";A$:RETURN
  77. 770 ' contest scoring routine--computes DX, beam headings and point totals.
  78. 780 PRINT CLS$:PRINT  "Enter your own QTH locator:":GOSUB 440
  79. 790 HO=LO/RA:HA=LA/RA:H$=G1$:XX=0
  80. 800 PRINT:INPUT "Locator or Command ('?' for menu) ";G1$
  81. 810 IF G1$="QRT" THEN PRINT:GOTO 1200
  82. 820 IF G1$="X" THEN 1480
  83. 830 IF G1$="?" THEN 1500
  84. 840 IF G1$="+" THEN 1580
  85. 850 IF G1$="-" THEN 1640
  86. 860 IF G1$="C" THEN GOSUB 590:GOSUB 710:PRINT:GOTO 800
  87. 870 IF G1$="M" THEN GOSUB 1730:PRINT:GOTO 800
  88. 880 IF LEN(G1$)>3 THEN GOSUB 450:GOSUB 900:GOTO 1190
  89. 890 PRINT "Invalid Entry.  Please try again!":GOTO 800
  90. 900 LO=LO/RA:LA=LA/RA:ZL=LA
  91. 910 L=HO-LO:IF L<>0 THEN 940
  92. 920 IF HA>ZL THEN AZ=180:GOTO 1040
  93. 930 IF HA<=ZL THEN AZ=0:GOTO 1040
  94. 940 IF L>PI THEN L=L-2*PI
  95. 950 IF L<-PI THEN L=L+2*PI
  96. 960 IF SIN(LA)=0 THEN AA=PI/2:GOTO 980
  97. 970 AA=COS(L)*(COS(LA)/SIN(LA)):AA=ATN(AA)
  98. 980 IF SIN(AA)=0 THEN AZ=0:GOTO 1000
  99. 990 AZ=((COS(L)/SIN(L))*COS(HA+AA))/SIN(AA):IF AZ<>0 THEN AZ=ATN(1/AZ)
  100. 1000 AZ=AZ*RA:L=L*RA
  101. 1010 IF L>0 AND AZ<0 THEN AZ=AZ+180
  102. 1020 IF L<0 AND AZ>0 THEN AZ=AZ+180
  103. 1030 IF L<0 AND AZ<0 THEN AZ=AZ+360
  104. 1040 AZ=INT(AZ+.5):DX=(SIN(HA)*SIN(LA))+(COS(HA)*COS(LA)*COS(HO-LO))
  105. 1050 IF DX>1 THEN DX=1
  106. 1060 IF DX<=-1 THEN DX=180:GOTO 1130
  107. 1070 DX=SQR(1-(DX*DX))/DX
  108. 1080 IF HO<>LO THEN 1110
  109. 1090 IF HA=>ZL THEN DX=HA-LA:GOTO 1120
  110. 1100 IF HA<ZL THEN DX=LA-HA:GOTO 1120
  111. 1110 DX=ATN(DX)
  112. 1120 DX=DX*RA:IF DX<0 AND DX>-90 THEN DX=DX+180
  113. 1130 DX=DX*69.0468:KM=DX/.6215:DX=FNA(DX):KM=FNA(KM):PX=F(1)
  114. 1140 PRINT "DX from center of ";H$;" to ";G1$;":"
  115. 1150 PRINT TAB(6)DX;" Mi";" and ";KM;" KM":IF ML$=" Mi" THEN KM=DX
  116. 1160 PRINT TAB(6)AZ;" Degrees Azimuth"
  117. 1170 FOR J=1 TO NR-1:IF KM=>M(J) THEN PX=F(J+1)
  118. 1180 NEXT J:RETURN
  119. 1190 PRINT TAB(6)PX;" Pt(s) for this QSO":PT=PT+PX:D9=D9+KM:QS=QS+1:XX=1
  120. 1200 PRINT:PRINT TAB(6)"----------------------"
  121. 1210 PRINT TAB(6)PT;" Total Pts"
  122. 1220 PRINT TAB(6)D9;" ";ML$;" Total DX"
  123. 1230 PRINT TAB(6)QS;" QSOs Entered":IF G1$="QRT" THEN 1690
  124. 1240 GOTO 800
  125. 1250 ' routine to modify scoring system.
  126. 1260 PRINT CLS$:PRINT  "Unless you change the values here,"
  127. 1270 PRINT "This scoring system will apply:":PRINT
  128. 1280 PRINT F(1);" Pt(s) per QSO if DX < ";M(1);ML$:IF NR<=2 THEN 1320
  129. 1290 FOR J=2 TO NR-1
  130. 1300 PRINT F(J);" Pts if DX = ";M(J-1);" to ";M(J);ML$
  131. 1310 NEXT J
  132. 1320 PRINT F(NR);" Pts if DX => ";M(NR-1);ML$:PRINT
  133. 1330 INPUT "Are these values correct (y/n)";OK$
  134. 1340 IF OK$="Y" OR OK$="y" THEN 270
  135. 1350 PRINT:INPUT "Use miles (Mi) or Kilometers (KM)";ML$:ML$=" "+ML$
  136. 1360 PRINT:INPUT "Enter the lowest Pt value";F(1):NR=2
  137. 1370 PRINT "Enter maximum DX for ";F(1);" Pt(s)";:INPUT M(1)
  138. 1380 PRINT:INPUT "Enter the next point value";F(NR)
  139. 1390 PRINT "Enter maximum DX for "F(NR);" Pts"
  140. 1400 INPUT "(if no higher limit exists, enter 0)";M(NR)
  141. 1410 IF M(NR)=0 THEN 1250
  142. 1420 NR=NR+1:GOTO 1380
  143. 1430 ' operator messages and editing functions
  144. 1440 PRINT "Entry incorrect.  Maximum Coordinates:"
  145. 1450 PRINT "89 Deg latitude, 179 Deg Longitude,"
  146. 1460 PRINT "and 59.99 Minutes":GOTO 590
  147. 1470 PRINT "Invalid Entry Format.  Please Try Again.":GOTO 440
  148. 1480 IF XX=0 THEN PRINT "Can't delete":GOTO 800
  149. 1490 XX=0:QS=QS-1:PT=PT-PX:D9=D9-KM:PRINT "--last entry deleted--":GOTO 1200
  150. 1500 PRINT:PRINT:PRINT TAB(12)"Data Entry Menu":PRINT
  151. 1510 PRINT "You may enter a station's locator, or--"
  152. 1520 PRINT:PRINT "'X' to delete the last entry"
  153. 1530 PRINT "'+' to add prior qsos to totals"
  154. 1540 PRINT "'-' to delete any previous qso"
  155. 1550 PRINT "'c' to convert coordinates to locator"
  156. 1560 PRINT "'m' to perform map operations"
  157. 1570 PRINT "'QRT' to end session":PRINT:GOTO 800
  158. 1580 PRINT:PRINT:PRINT "this option allows you to add QSOs,"
  159. 1590 PRINT "DX, and contest points from"
  160. 1600 PRINT "a previous session to your totals.":PRINT
  161. 1610 PRINT "how many QSOs to add?":INPUT Q1:QS=QS+Q1
  162. 1620 PRINT "how many total miles (or KM) to add?":INPUT D1:D9=D9+D1
  163. 1630 PRINT "how many points to add?":INPUT P1:PT=PT+P1:GOTO 1200
  164. 1640 PRINT:PRINT:PRINT "this option allows you to delete"
  165. 1650 PRINT "any previous QSO from the totals"
  166. 1660 PRINT "by entering its locator.":PRINT
  167. 1670 INPUT "locator to delete";G1$:GOSUB 450:GOSUB 900
  168. 1680 QS=QS-1:PT=PT-PX:D9=D9-KM:XX=0:GOTO 1200
  169. 1690 PRINT CLS$:PRINT "note:   you have exited the program."
  170. 1700 PRINT "be sure to write down your data"
  171. 1710 PRINT "before turning off your computer!":END
  172. 1720 ' map conversion routines 
  173. 1730 PRINT:PRINT "map operations.  choose either--"
  174. 1740 PRINT "1 - obtain locator of a point on map"
  175. 1750 PRINT "2 - pinpoint a known locator on map"
  176. 1760 PRINT "enter 1 or 2";:INPUT M9
  177. 1770 IF M9=1 THEN GOSUB 1820:GOTO 800
  178. 1780 IF M9=2 THEN GOSUB 2170:GOTO 800
  179. 1790 PRINT "invalid choice--try again":GOTO 1730
  180. 1800 ' routines to obtain QTH locator of a point on a map
  181. 1810 PRINT CLS$:GOSUB 1820:GOTO 270
  182. 1820 GOSUB 2300:PRINT:PRINT "measure the vertical and horizontal"
  183. 1830 PRINT "distance from the reference point"
  184. 1840 PRINT "to the point for which you need"
  185. 1850 PRINT "a QTH locator.":PRINT
  186. 1860 PRINT "note: use Minus ('-') to indicate a"
  187. 1870 PRINT "distance south or east of reference pt.":PRINT
  188. 1880 INPUT "# inches vertically from ref pt.";V
  189. 1890 INPUT "# inches horizontally from ref. pt.";H
  190. 1900 IF ABS(M3+(V*S2/50))<90 THEN 1920
  191. 1910 PRINT "error: entry >90 Degr Lat":GOTO 1880
  192. 1920 C2=4:IF H=>0 AND V<0 THEN C2=1
  193. 1930 IF V=>0 AND H=>0 THEN C2=2
  194. 1940 IF V=>0 AND H<0 THEN C2=3
  195. 1950 V3=ABS(V)*S2:H3=ABS(H)*S2
  196. 1960 IF V3=0 THEN A3=90:GOTO 1980
  197. 1970 A3=(ATN(H3/V3))*RA
  198. 1980 R3=(H3^2+V3^2)^.5
  199. 1990 IF C2=1 THEN T3=A3+180
  200. 2000 IF C2=2 THEN T3=360-A3
  201. 2010 IF C2=3 THEN T3=A3
  202. 2020 IF C2=4 THEN T3=180-A3
  203. 2030 NA=(R3*(COS(T3/RA))/60)+M3:XA$="n Lat":IF NA<0 THEN XA$="s Lat"
  204. 2040 IF T3=90 THEN 2090
  205. 2050 IF T3=270 THEN 2090
  206. 2060 X=LOG(TAN((45+(M3/2))/RA)):X1=LOG(TAN((45+(NA/2))/RA))
  207. 2070 NO=M4+RA*(TAN(T3/RA))*(X-X1)
  208. 2080 GOTO 2100
  209. 2090 NO=M4-(R3*SIN(T3/RA))/(60*COS(M3/RA))
  210. 2100 IF NO=>180 THEN NO=NO-360
  211. 2110 IF NO=<-180 THEN NO=360+NO
  212. 2120 XO$="W Long":IF NO<0 THEN XO$="E Long"
  213. 2130 QA=NA:NA=ABS(NA):L3=INT(NA):L4=(NA-INT(NA))*60
  214. 2140 QO=NO:NO=ABS(NO):L1=INT(NO):L2=(NO-INT(NO))*60:GOTO 710
  215. 2150 ' routines to pinpoint a known QTH locator on a map
  216. 2160 PRINT CLS$:GOSUB 2170:GOTO 270
  217. 2170 GOSUB 2300:PRINT:PRINT "Enter the Gridlocator that you"
  218. 2180 PRINT "wish to pinpoint on your map":GOSUB 440
  219. 2190 NA=LA:NO=LO:A4=ABS((M3+NA)/2):D4=ABS(M3-NA):D5=ABS(M4-NO)
  220. 2200 D6=69.0541-.351726*COS((2*A4)/RA)
  221. 2210 D7=69.23*COS(A4/RA)-.05875*COS((3*A4)/RA)
  222. 2220 V4=D6*D4*S3:G4=D7*D5*S3
  223. 2230 X7$=" north":IF LA<M3 THEN X7$=" south"
  224. 2240 X8$=" west":IF LO<M4 THEN X8$=" east"
  225. 2250 PRINT:PRINT "the center of ";G1$;" is"
  226. 2260 PRINT FNA(V4);" inches ";X7$
  227. 2270 PRINT "from the reference point and"
  228. 2280 PRINT FNA(G4);" inches ";X8$
  229. 2290 PRINT "from the reference point":RETURN
  230. 2300 IF C1=0 THEN 2370
  231. 2310 PRINT:PRINT "current map parameters:"
  232. 2320 PRINT:PRINT "reference point is"
  233. 2330 PRINT INT(L5);"/";FNA(L6);X1$;" - ";INT(L7);"/";FNA(L8);X2$
  234. 2340 IF S1=6 THEN PRINT "map scale: ";MI;" miles/inch":GOTO 2360
  235. 2350 PRINT "map uses ";S$(S1) 
  236. 2360 INPUT "want to change map parameters (y/n)";CM$:IF CM$<>"y" THEN RETURN
  237. 2370 PRINT:PRINT "please describe your map and select"
  238. 2380 PRINT "a reference point for measurements"
  239. 2390 PRINT "+----------------------------------+"
  240. 2400 PRINT "|                :                 |"
  241. 2410 PRINT "|     X----------:                 |"
  242. 2420 PRINT "|     :          :                 |"
  243. 2430 PRINT "|     :          :                 |"
  244. 2440 PRINT "|................R.................|"
  245. 2450 PRINT "|                :                 |"
  246. 2460 PRINT "|                :                 |"
  247. 2470 PRINT "|                :                 |"
  248. 2480 PRINT "|                :                 |"
  249. 2490 PRINT "+----------------------------------+"
  250. 2500 PRINT "(R is your reference point on the map,"
  251. 2510 PRINT "and X is an unknown point or locator).":C1=1:PRINT
  252. 2520 PRINT "for your reference point on the map:"
  253. 2530 GOSUB 590:M3=LA:M4=LO:L5=L1:L6=L2:L7=L3:L8=L4:X1$=XO$:X2$=XA$
  254. 2540 PRINT:PRINT "now specify the map's scale:"
  255. 2550 PRINT:PRINT TAB(7)"1.  ";S$(1):PRINT TAB(7)"2.  ";S$(2)
  256. 2560 PRINT TAB(7)"3.  ";S$(3):PRINT TAB(7)"4.  ";S$(4)
  257. 2570 PRINT TAB(7)"5.  ";S$(5):PRINT TAB(7)"6.  any # miles/inch"
  258. 2580 PRINT:INPUT "Enter 1,2,3,4,5 or 6";S1:IF S1=6 THEN 2610
  259. 2590 IF S1>6 THEN PRINT "invalid scale--try again.":GOTO 2540
  260. 2600 S2=SY(S1):S3=SX(S1):GOTO 2310
  261. 2610 PRINT:INPUT "enter map scale in miles/inch";MI
  262. 2620 S2=MI/1.15078:S3=1/MI:GOTO 2310
  263.