home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / aprs72a.zip / USGSMAP1.BAS < prev   
BASIC Source File  |  1995-06-28  |  14KB  |  409 lines
  1. DECLARE SUB init (mapf AS STRING, datf AS STRING, fldr AS STRING)
  2. DECLARE SUB fbook (finx%, f AS STRING, fldr AS STRING, bcolor%, suffix AS STRING)
  3. DECLARE SUB test (rcno&, rstop&, testflg%, finx%, attrb%)
  4. DECLARE SUB redraw (cmaxrec&, datf AS STRING)
  5.  
  6. ' Based on Version 0.05  30 May 94 - KB4XF Jack Cavanagh, of Fredericksburg, VA
  7. ' Modified by APR on 3 May 1995 to add some explaination text to tell users
  8. ' to keep maps small (40 miles or so).  This plus increasing the max number of pts
  9. ' up to 6000 minimizes the number of TRUNCATED points
  10. ' Also put in test to prevent x=0 points....
  11. ' Modified By W4NMK Dan Reilly to make APRS maps from USGS date downloaded from
  12. ' the INTERNET
  13. DEFSTR A-Z
  14. COMMON SHARED lat0!, long0!, latmax!, longmax!, ppdy!, ppdx!
  15. COMMON SHARED latmin!, longmin!, version$, Hfac!
  16. version$ = "Version 1.1"
  17. CALL init(mapf, datf, fldr)
  18. npts& = 1
  19. finx% = 1
  20. nseg% = 0
  21. oldx! = 999
  22. oldy! = 999
  23. PRINT
  24. PRINT
  25. a! = 2
  26. CLS
  27. ON ERROR GOTO Errortrap
  28. WHILE finx% < a!
  29. Again: Fault% = 0
  30. CALL fbook(finx%, f, fldr, bcolor%, suffix)
  31. INPUT " Enter file and path name for USGS data"; f$  'Use combined filename
  32. IF INSTR(f$, ".") = 0 THEN f$ = f$ + ".GRA"
  33. OPEN f$ FOR RANDOM AS 1# LEN = 20
  34. IF Fault% = 75 THEN finx% = finx% + 1: GOTO Again
  35. labnr% = 0
  36. minrec% = 1000
  37. maxrec% = 0
  38. rcno& = 1
  39. startflg% = -1
  40. tstart = TIME$
  41. FIELD #1, 7 AS lno, 2 AS atc, 6 AS np, 5 AS att
  42. DO WHILE NOT EOF(1)
  43. LOCATE 1, 1
  44. PRINT suffix; rcno&
  45. GET 1, rcno&
  46. nrec% = VAL(np)
  47. aatc% = VAL(atc)
  48. aatt% = VAL(att) - 29000
  49. IF aatt% < 0 THEN aatt% = 0
  50. attrb% = 100 * aatt% + aatc%
  51. rstop& = rcno& + nrec%
  52. rcno& = rcno& + 1
  53. FIELD #1, 2 AS lad, 2 AS lam, 3 AS las, 3 AS lod, 2 AS lom, 2 AS los, 6 AS d$
  54. CALL test(rcno&, rstop&, testflg%, finx%, attrb%)
  55. LOCATE 1, 1
  56. PRINT SPACE$(12);
  57. IF testflg% THEN
  58. IF nrec% < minrec% AND nrec% <> 0 THEN minrec% = nrec%
  59.  IF nrec% > maxrec% THEN maxrec% = nrec%
  60.  DO WHILE rcno& <= rstop&
  61.  GET 1, rcno&
  62.  alat! = VAL(lad) + VAL(lam) / 60 + VAL(las) / 3600
  63.  along! = VAL(lod) + VAL(lom) / 60 + VAL(los) / 3600
  64.  REM Test to see if this point is on map
  65.  LOCATE 1, 1
  66.  PRINT alat!; along!; aatc%;
  67.  ok% = 0
  68.  IF (alat! <= latmax!) AND (alat! >= latmin!) THEN
  69.    IF (along! <= longmax!) AND (along! >= longmin!) THEN
  70.       ok% = -1
  71.    END IF
  72.  END IF
  73.  IF ok% THEN
  74.       x! = INT(.5 + (longmax! - along!) * ppdy!): IF x! = 0 THEN x! = 1
  75.       y! = INT(.5 + (latmax! - alat!) * ppdy!)
  76.     ' Test for continuation of last line segment
  77.       IF (x! = oldx!) AND (oldy! = y!) THEN startflg% = 0
  78.       oldx! = x!
  79.       oldy! = y!
  80.       npts& = npts& + 1
  81.      IF startflg% THEN
  82.        icolor% = bcolor%
  83.       IF finx% = 1 THEN
  84.        SELECT CASE aatc%
  85.            CASE 1: icolor% = 10
  86.            CASE 13 TO 19: icolor% = 12
  87.            CASE 20 TO 23: icolor% = 4
  88.            CASE 71 TO 75: icolor% = 8
  89.            CASE 9: icolor% = 6
  90.            CASE 4 TO 8: icolor% = 3
  91.            CASE 10 TO 12: icolor% = 3
  92.            CASE ELSE: icolor% = 7
  93.        END SELECT
  94.       END IF
  95.       IF finx% = 3 THEN
  96.          IF attrb% = 3095 THEN icolor% = 9' Intercoastal waterway
  97.       END IF
  98.        PSET (x! * Hfac!, y!), icolor%
  99.        PRINT #2, "   0,   0"
  100.        labnr% = labnr% + 1
  101.        lab = LEFT$(suffix, 1) + LTRIM$(STR$(labnr%))
  102.        PRINT #2, USING "##_,\    \"; icolor%; lab
  103.        PRINT #2, USING "####_,####"; x!; y!
  104.        ix% = INT(Hfac! * 80 * x! / 640) + 1
  105.        iy% = INT(43 * y! / 350) + 1
  106.        IF ix% > 75 THEN ix% = 75
  107.        IF iy% > 43 THEN iy% = 43
  108.        LOCATE iy%, ix%
  109.        PRINT lab;
  110.        nseg% = nseg% + 1
  111.        startflg% = 0
  112.      ELSE
  113.       LINE -(x! * Hfac!, y!), icolor%
  114.       PRINT #2, USING "####_,####"; x!; y!
  115.     END IF
  116.   ELSE
  117.     startflg% = -1
  118.  END IF
  119.  rcno& = rcno& + 1
  120.  LOOP
  121.  startflg% = -1
  122. ELSE
  123.  rcno& = rstop& + 1
  124. END IF
  125. LOOP
  126. tstop = TIME$
  127. PRINT tstart; " "; tstop; minrec%; maxrec%
  128. finx% = finx% + 1
  129. cmaxrec& = LOF(2) \ 11
  130. CLOSE 1
  131. CLOSE 2
  132. LOCATE 1, 1
  133. PRINT "make notes for manual deletion/merge. Hit key to continue";
  134. REM DO WHILE INKEY$ = "": LOOP
  135. CALL redraw(cmaxrec&, datf)
  136. OPEN datf FOR APPEND AS #2
  137. WEND
  138. CLOSE 1
  139. REM  Map extraction complete now thin map to reduce number of pts to 6000
  140. thin% = INT(npts& \ (6000 - 2 * nseg% - 7)) + 1
  141. LOCATE 1, 1: PRINT "KEEPING every"; thin%; "th point..."
  142. nrecm& = LOF(2) \ 11
  143. CLOSE 2
  144. ' re-open as a random file
  145. OPEN datf FOR RANDOM AS #2 LEN = 11
  146. OPEN mapf FOR RANDOM AS #1 LEN = 11
  147. FIELD 1, 11 AS stuff
  148. FIELD 2, 11 AS instuff
  149. 'copy first seven lines to output file
  150. FOR I% = 1 TO 8 'was 7
  151. GET 2, I%
  152. LSET stuff = instuff
  153. PUT 1, I%
  154. NEXT I%
  155. xtest% = 0
  156. rstart& = 8 'was 7
  157. DO WHILE rstart& < nrecm&
  158.  WHILE NOT xtest%
  159.  GET 2, rstart&
  160.  rstart& = rstart& + 1
  161.  IF (LEFT$(instuff, 9) = "   0,   0") THEN xtest% = -1
  162.    IF rstart& > nrecm& THEN
  163.     xtest% = -1
  164.     rstart& = nrecm&
  165.    END IF
  166.  WEND
  167.  xtest% = 0
  168.  rstop& = rstart&
  169.  WHILE NOT xtest%
  170.   rstop& = rstop& + 1
  171.   GET 2, rstop& + 1
  172.   IF (LEFT$(instuff, 9) = "   0,   0") THEN xtest% = -1
  173.    IF rstop& > nrecm& THEN
  174.      rstop& = nrecm&
  175.      xtest% = -1
  176.    END IF
  177.  WEND
  178. 'Copy every thin(t)h record from input to output file
  179. 'If line segment has less than n points then skip,
  180. ' but making sure first and last points the same
  181. ' for both long and short segment
  182.  N% = (rstop& - rstart&) / thin% + 1
  183.  rcno& = rstart&
  184.  IF N% > 2 THEN   'Forget short segments
  185.   LSET stuff = "   0,   0" + CHR$(&HD) + CHR$(&HA)
  186.   PUT 1
  187.   GET 2, rcno&
  188.   LSET stuff = instuff 'Color and segment label
  189.   PUT 1
  190.   rcno& = rcno& + 1
  191.   wflg% = -1
  192.   DO WHILE wflg%
  193.     IF rcno& < rstop& THEN
  194.       GET 2, rcno&
  195.       LSET stuff = instuff
  196.       PUT 1
  197.      ELSE
  198.       GET 2, rstop&
  199.       LSET stuff = instuff
  200.       PUT 1
  201.       wflg% = 0
  202.     END IF
  203.     x% = VAL(instuff)
  204.     y% = VAL(MID$(instuff, 6, 4))
  205.     PRESET (x% * Hfac!, y%), 15
  206.     rcno& = rcno& + thin%
  207.   LOOP
  208.  END IF
  209.   rcno& = rstop& + 1
  210.   rstart& = rcno&
  211. xtest% = 0
  212. LOOP
  213. CLOSE
  214. LOCATE 43, 1: INPUT "Map is complete... Hit ENTER to continue..."; a$
  215. CLS
  216. PRINT "Now your completed map is in file: "; mapf
  217. PRINT
  218. PRINT "Load MAPFIX and use the alt-JOIN and alt-SMOOTH functions to remove additional"
  219. PRINT "points.  I run alt-JOIN multiple times, starting with a factor of 1.2, then"
  220. PRINT "1.3, 1.4 and even 1.8 or so, until I get down to about 4000 points.  Use"
  221. PRINT "the minimum factor necessary to avoid straightening out the roads too much."
  222. PRINT "(below 1.5 will hardly be noticable; above 2 will really cut corners)"
  223. PRINT
  224. PRINT "Then finally, use the +/- keys to cycle through each and every point in the"
  225. PRINT "map and alt-DELETE any unnecessary points.  This takes the most time, but"
  226. PRINT "can get rid of hundreds of unnecessary points!  There are lots of wasted and"
  227. PRINT "duplicate points in the following areas:"
  228. PRINT
  229. PRINT "    COUNTY LINES!  (who cares about the detail crooks and crannies!"
  230. PRINT "    INTERSTATES    (BOTH lanes are duplicated and identical!)"
  231. PRINT "    STREAMS        (who cares about every crook and bend..."
  232. PRINT
  233. PRINT
  234. INPUT "Hit ENTER to end this program..."; a$
  235. STOP
  236.  
  237. Errortrap: Fault% = ERR
  238.            IF ERR = 75 THEN RESUME NEXT
  239. END
  240.  
  241. SUB fbook (finx%, f, fldr, bcolor%, suffix)
  242. SELECT CASE finx%
  243. CASE 1: suffix = "rd": bcolor% = 10
  244. CASE 2: suffix = "wb": bcolor% = 11
  245. CASE 3: suffix = "st": bcolor% = 3
  246. CASE 4: suffix = "pb": bcolor% = 6
  247. CASE 5: suffix = "ab": bcolor% = 14
  248. CASE 6: suffix = "cf": bcolor% = 5
  249. CASE 7: suffix = "rr": bcolor% = 8
  250. END SELECT
  251. f = fldr + suffix + ".grf"
  252. END SUB
  253.  
  254. SUB init (mapf, datf, fldr)
  255. REM DIM SHARED lat0!, long0!, latmax!, longmax!, ppdy!, ppdx!
  256. REM DIM SHARED latmin!, longmin!
  257. CLS
  258. PRINT "This program is a modified version of MAKEMAP.bas to take USGS date"
  259. PRINT "obtained from INTERNET and produces an APRS map.  This modification was"
  260. PRINT "made by Dan Reilly, W4NMK, in Black Mountain North Carolina"
  261. PRINT
  262. PRINT "The original MAKEMAP program was based on the program written by Jack"
  263. PRINT "Cavanagh, KB4XF, in Woodbridge VA to extract APRS map points from CD-ROM"
  264. PRINT "and modified by WB4APR. "
  265. PRINT
  266. PRINT "Data is obtained from http;//edcftp.cr.usgs.gov/pub/data/DLG/2M/{area of"
  267. PRINT "interest}/{transportation/hydrographic/political/railroads}/"
  268. PRINT
  269. PRINT "Chose the area of interest and the features from the menu."
  270. PRINT
  271. PRINT "You will get files named ROADS.GRA, WATER_BO.GRA, STREAMS.GRA, POLITICA.GRA"
  272. PRINT "and RAILROAD.GRA.  Combine these into one BIG file using the COPY command:"
  273. PRINT
  274. PRINT "Copy ROADS.GRA+WATER_BO.GRA+STREAMS.GRA+POLITICA.GRA+RAILROAD.GRA BIGFILE.GRA."
  275. PRINT "where BIGFILE.GRA will be your source file."
  276. PRINT
  277. PRINT "It is a hands-off, total map making process.  It extrtacts all points"
  278. PRINT "within a given range of a given lat/long point and saves them in an"
  279. PRINT "APRS compatible file named XXXXX.DAT."
  280. PRINT
  281. INPUT "Hit ENTER to proceed"; a$
  282. CLS
  283. PRINT "Then it uses a brute-force reduction technique that scans the total file and"
  284. PRINT "only keeps every Nth point.   As long as N is on the order of 2 or 3, this is"
  285. PRINT "not much of a problem, since the USGS data base has at least 100 points to"
  286. PRINT "the inch at the original map scale.  The map is then saved as XXXXX.MAP."
  287. PRINT
  288. PRINT "To minimize this truncation, WB4APR modifed This program to permit "
  289. PRINT "twice the nominal 3000 limit during this first reduction process.  By"
  290. PRINT "limiting the initial number of points by choosing a smaller area (30 miles"
  291. PRINT "or so (in the East) the result is a quite adequate map which can then be"
  292. PRINT "loaded into MAPFIX where you may then use the more intelligent MAPFIX"
  293. PRINT "alt-SMOOTH command and other techniques to eliminate more points down to the"
  294. PRINT "nominal 3000 point limit."
  295. PRINT
  296. PRINT
  297. INPUT "If you have your data and are ready to proceed, type GO "; ANS$
  298. IF ANS$ = "GO" OR ANS$ = "go" THEN CLS  ELSE END
  299. PRINT
  300. CLS
  301. INPUT "Enter a file name for results (.map) will be added "; mapf
  302. INPUT "Enter latitude of map center in degrees,minutes (DD,MM) "; lat0!, latm!
  303. INPUT "Enter longitude of map center in degrees,minutes (DDD,MM) "; long0!, longm!
  304. lat0! = lat0! + latm! / 60
  305. long0! = long0! + longm! / 60
  306.    PRINT
  307.    PRINT "Now select the map size.  In order to get about the right number of points"
  308.    PRINT "Select 36 to 40 miles for anywhere East of the Mississippi.  Maybe 70 miles"
  309.    PRINT "in the rural farm areas, and possibly 130 miles in the VERY sparse states."
  310.    PRINT
  311.    PRINT "You may go larger to get a larger map, and then spend lots more time using"
  312.    PRINT "MAPFIX to remove un-needed points."
  313. INPUT "Enter map radius in miles ", mradm!
  314. datf = mapf + ".dat"
  315. mapf = mapf + ".map"
  316. rady! = mradm! / 60
  317. radx! = 4 * mradm! / (COS(3.1416 * lat0! / 180) * 3 * 60)' Screen aspect ratio
  318. latmax! = lat0! + rady!
  319. latmin! = lat0! - rady!
  320. longmax! = long0! + radx!
  321. longmin! = long0! - radx!
  322. ppdy! = INT(.5 + (350! / (2! * rady!)))
  323. ppdx! = INT(.5 + (640! / (2! * radx!)))
  324. Hfac! = ppdx! / ppdy!
  325. OPEN datf FOR OUTPUT AS #2
  326. PRINT #2, USING "###.####_,"; latmax!
  327. PRINT #2, USING "###.####_,"; longmax!
  328. PRINT #2, USING "#####.##_,"; ppdy!
  329. PRINT #2, USING "###.####_,"; lat0!
  330. PRINT #2, USING "###.####_,"; long0!
  331. PRINT #2, USING "###.####_,"; mradm!
  332. PRINT #2, "0,resrved"
  333. PRINT #2, "comments "
  334. CLS
  335. SCREEN 9
  336. WIDTH 80, 43
  337. PALETTE 6, 6
  338. END SUB
  339.  
  340. SUB redraw (cmaxrec&, datf) STATIC
  341. nrec& = 8
  342. CLS
  343. OPEN datf FOR RANDOM AS #2 LEN = 11
  344. FIELD 2, 11 AS stuff
  345. WHILE nrec& < cmaxrec&
  346. GET 2, nrec&
  347.   IF stuff = "   0,   0" + CHR$(&HD) + CHR$(&HA) THEN
  348.      GET 2, nrec& + 1
  349.      clr% = VAL(stuff)
  350.      nrec& = nrec& + 2
  351.      GET 2, nrec&
  352.      x% = VAL(stuff)
  353.      y% = VAL(RIGHT$(stuff, 5))
  354.      PSET (x% * Hfac!, y%), clr%
  355.      nrec& = nrec& + 1
  356.   ELSE
  357.      x% = VAL(stuff)
  358.      y% = VAL(RIGHT$(stuff, 5))
  359.      LINE -(x% * Hfac!, y%), clr%
  360.      nrec& = nrec& + 1
  361.    END IF
  362. WEND
  363. CLOSE 2
  364. LOCATE 1, 58: PRINT "CD pts so far:"; cmaxrec&
  365. END SUB
  366.  
  367. SUB test (rcno&, rstop&, testflg%, finx%, attrb%)
  368. 'COMMON SHARED lat0!, long0!, latmax!, longmax!, ppdy!, ppdx!
  369. 'COMMON SHARED latmin!, longmin!
  370. ' Test last point to see if it is on map
  371. FIELD #1, 2 AS lad, 2 AS lam, 3 AS las, 3 AS lod, 2 AS lom, 2 AS los, 6 AS d$
  372. GET 1, rstop&
  373. alat! = VAL(lad) + VAL(lam) / 60 + VAL(las) / 3600
  374. along! = VAL(lod) + VAL(lom) / 60 + VAL(los) / 3600
  375. testflg% = 0
  376. IF (alat! <= latmax!) AND (alat! >= latmin!) THEN
  377.   IF (along! <= longmax!) AND (along! >= longmin!) THEN
  378.      testflg% = -1
  379.   END IF
  380. END IF
  381. ' Test midpoint to see if it falls on the map
  382. recmid& = (rstop& + rcno&) \ 2
  383. GET 1, recmid&
  384. alat! = VAL(lad) + VAL(lam) / 60 + VAL(las) / 3600
  385. along! = VAL(lod) + VAL(lom) / 60 + VAL(los) / 3600
  386. IF (alat! <= latmax!) AND (alat! >= latmin!) THEN
  387.   IF (along! <= longmax!) AND (along! >= longmin!) THEN
  388.      testflg% = -1
  389.   END IF
  390. END IF
  391. ' Test first point to see if it is  on map
  392. GET 1, rcno&
  393. alat! = VAL(lad) + VAL(lam) / 60 + VAL(las) / 3600
  394. along! = VAL(lod) + VAL(lom) / 60 + VAL(los) / 3600
  395. IF (alat! <= latmax!) AND (alat! >= latmin!) THEN
  396.   IF (along! <= longmax!) AND (along! >= longmin!) THEN
  397.      testflg% = -1
  398.   END IF
  399. END IF
  400. 'This limits stream data to eliminate small lakes
  401. ' and river centerlines
  402. IF finx% = 3 THEN
  403.   IF attrb% = 3002 THEN testflg% = 0
  404.   IF attrb% > 3030 AND attr% < 3070 THEN testflg% = 0
  405.   REM IF attrb% = 3095 THEN testflg% = 0' Intercoastal waterway
  406. END IF
  407. END SUB
  408.  
  409.