home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / aprs72a.zip / CONV100C.BAS < prev    next >
BASIC Source File  |  1995-04-11  |  16KB  |  401 lines
  1. REM Program name: CONV100b.BAS
  2.  
  3. REM **********  FOR INSTRUCTIONS, SEE README.100
  4.  
  5. REM This program takes the USGS cd rom 1 TO 100,000 Digital Line Graph
  6. REM "Optional Format" output and converts it into the same format as the
  7. REM 1 to 2,000,000 Graphic Format output which APRS MAPFIX can read.
  8. REM ************** MODIFICATION HISTORY ****************
  9. REM 24AUG94  W7KKE  Expanded menu to include other types of water boundaries.
  10. REM 4 Nov    WB4APR Instead of prompting user, now program just generates and
  11. REM                 names files for all the features in the given type
  12. REM 15Nov94  W7KKE  Picked up the second attribute code when the first
  13. REM                 was an "incidental feature". Due to CD ROM digitizing
  14. REM                 techniques this was causing lines which ran due east/west
  15. REM                 or north/south to be lost.
  16. REM 17Nov94  W7KKE  Corrected lat/long calculations for UTM grid rotation.
  17. REM 08Jan95  W7KKE  Added "Far Shore" & "Near Shore" water body attribute
  18. REM                 to pick up rivers.
  19. REM 20Feb95  WB4APR changed line 81 to remove TEST line. Renamed CONV100b
  20. REM 11Apr95  W7KKE  Picked up name and source date (some maps are old!)
  21. REM                 Reworked array logic to avoid crash on large files.
  22.  
  23. 'Declare x and y as long variables
  24. DIM lon AS DOUBLE
  25. DIM x(400) AS LONG
  26. DIM y(400) AS LONG'Largest number of x/y line pairs expected.
  27. DIM origx(400) AS LONG
  28. DIM origy(400) AS LONG
  29.  
  30. 'Dimension integer variables for speed in extraction loop
  31. DIM tyflag AS INTEGER
  32. DIM id AS INTEGER
  33. DIM k AS INTEGER
  34. DIM i AS INTEGER
  35. DIM txt$(3, 11)
  36. txt$(1, 1) = "Water Bodies (color 11)"      'Output as WB
  37. txt$(1, 2) = "Rivers and streams (color 3)" 'Output as ST
  38.  
  39. txt$(2, 1) = "AIRPORTS"                     'Output as CF
  40.  
  41. txt$(3, 1) = "1) Interstate freeways"     'All output as RD
  42. txt$(3, 2) = "2) U.S. Highways"
  43. txt$(3, 3) = "3) State Routes"
  44. txt$(3, 4) = "4) County Routes"
  45. txt$(3, 5) = "5) Primary Routes"
  46. txt$(3, 6) = "6) Secondary Routes"
  47. txt$(3, 7) = "7) Roads or streets (class 3)"
  48. txt$(3, 8) = "8) Roads or streets (class 4)"
  49. txt$(3, 9) = "9) Trails (other than four wheel drive)"
  50. txt$(3, 10) = "10) Trails (four wheel drive)"
  51.  
  52. REM SCREEN 9
  53. REM on error goto errorfix
  54. CLS
  55. PRINT "This program will take the output files from the 100,000 USGS EXTRACT"
  56. PRINT "program and generate categories of intermediate files that look like"
  57. PRINT "the 2,000,000:1  GRAPHIC format.  These files can then be pulled into"
  58. PRINT "the APRS MAPFIX program using the alt-U command."
  59. PRINT
  60. PRINT "The source file (output by the CD ROM EXTRACT program) will identify the type"
  61. PRINT "of data it contains (water, roads, or airports).  This program will then auto-"
  62. PRINT "matically generate and name output files of the form PRE#TY.GRF where:"
  63. PRINT "           PRE  is a  user defined prefix for all files in this run"
  64. PRINT "           #    is the feature category (1-10 for roads)"
  65. PRINT "           TY   is either WB, ST, RD or CF"
  66. PRINT
  67. PRINT "This naming convention is compatible with the 2,000,000 and MAPFIX format."
  68. PRINT
  69.  
  70. top:
  71.  id = 0 'Line ID counter
  72.  IF tyflag = 0 THEN
  73.     'Increment TYflag for each loop to make different files for each category
  74.     'Files are named like BA4HYDxx or BA4RDSxx or BA4MTFxx (misc Transprtn)
  75.     'Where the xx are numbers
  76.     INPUT "Enter path and File name of source data"; F$
  77.            'F$ = "d:\severn\" + F$
  78.            'F$ = "SJ2RDF05"
  79.  
  80.     INPUT "Enter file name PREFIX to be used in all output files."; Fopre$
  81.            Fopre$ = LEFT$(Fopre$, 4)
  82.     PRINT
  83.     tyflag = 0 'for debugging (this was still = 2 as distroed in conv100b
  84.  
  85.  END IF
  86.  tyflag = tyflag + 1
  87.  OPEN F$ FOR INPUT AS #3
  88.     LINE INPUT #3, a$   'Throw away first line
  89.     LINE INPUT #3, a$   'Get map name and source date from second line
  90.       unit$ = LEFT$(a$, 40)
  91.       sourcedate$ = MID$(a$, 42, 10)
  92.  PRINT "Corner coordinates:"
  93.  DO WHILE NOT EOF(3)
  94.     LINE INPUT #3, a$    'Look for Quadrant calibration data
  95.     b$ = LEFT$(a$, 2)
  96.     IF b$ = "SW" THEN
  97.        swlat = VAL(MID$(a$, 7, 11))
  98.        swlon = ABS(VAL(MID$(a$, 19, 11)))
  99.        swx = VAL(MID$(a$, 39, 11))
  100.        swy = VAL(MID$(a$, 51, 11))
  101.        PRINT "SW: "; swlat, swlon, swx, swy
  102.     ELSEIF b$ = "NW" THEN
  103.        nwlat = VAL(MID$(a$, 7, 11))
  104.        nwlon = ABS(VAL(MID$(a$, 19, 11)))
  105.        nwx = VAL(MID$(a$, 39, 11))
  106.        nwy = VAL(MID$(a$, 51, 11))
  107.        PRINT "NW: "; nwlat, nwlon, nwx, nwy
  108.     ELSEIF b$ = "NE" THEN
  109.        nelat = VAL(MID$(a$, 7, 11))
  110.        nelon = ABS(VAL(MID$(a$, 19, 11)))
  111.        nex = VAL(MID$(a$, 39, 11))
  112.        ney = VAL(MID$(a$, 51, 11))
  113.        PRINT "NE: "; nelat, nelon, nex, ney
  114.     ELSEIF b$ = "SE" THEN
  115.        selat = VAL(MID$(a$, 7, 11))
  116.        selon = ABS(VAL(MID$(a$, 19, 11)))
  117.        sex = VAL(MID$(a$, 39, 11))
  118.        sey = VAL(MID$(a$, 51, 11))
  119.        PRINT "SE: "; selat, selon, sex, sey
  120.     END IF
  121.     IF b$ = "SE" THEN EXIT DO
  122.  LOOP
  123.  
  124.  'Determine type of map so proper line type will be extracted.
  125.  tynum = 0' type map files we are reading.
  126.  TY$ = "" ' TYpe file name to be output (WB, ST, CF, or RD)
  127.  
  128.  PRINT
  129.  PRINT unit$; "  date of source material: "; sourcedate$
  130.  
  131.  REM roadflag = 0' zero flag for roads and airports
  132.  PRINT
  133.  DO WHILE NOT EOF(3)
  134.     LINE INPUT #3, a$
  135.     IF LEFT$(a$, 5) = "HYDRO" THEN
  136.                  tynum = 1: Endflag = 2
  137.                       IF tyflag = 1 THEN TY$ = "WB" ELSE TY$ = "ST"
  138.     END IF
  139.  
  140.     IF LEFT$(a$, 4) = "PIPE" THEN tynum = 2: Endflag = 1: TY$ = "CF"'AIRPORTS
  141.                       'Named CF to match cultural features in 2,000,000 format
  142.     IF LEFT$(a$, 5) = "ROADS" THEN tynum = 3: Endflag = 10: TY$ = "RD"
  143.     IF LEFT$(a$, 1) = "N" THEN EXIT DO ' Found start of node data
  144.     PRINT LEFT$(a$, 20)
  145.  LOOP
  146.  
  147. convert: 'Calculate the x/y meters to lat/long conversion factors
  148.    basex = sex: basey = ney
  149.    baselat = nelat: baselon = selon
  150.  
  151.    xdelta = sex - swx: ydelta = ney - sey
  152.    londelta = swlon - selon: latdelta = nelat - selat
  153.  
  154.    lonfac = londelta / xdelta: latfac = latdelta / ydelta
  155.  
  156. ' Added for UTM grid error correction
  157.    yerr = ney - nwy
  158.    xerr = sex - nex
  159.  
  160.    PRINT
  161.    PRINT "baselat ="; baselat; TAB(30); "baselon ="; baselon
  162.    PRINT "base x ="; basex; TAB(30); "base y ="; basey
  163.    PRINT "xdelta = "; xdelta; TAB(30); "ydelta ="; ydelta
  164.    PRINT "londelta ="; londelta; TAB(30); "latdelta ="; latdelta
  165.    PRINT "lonfac ="; lonfac; TAB(30); "latfac ="; latfac
  166.  
  167.  gotflag = 0
  168.  IF tynum = 3 THEN num$ = MID$(STR$(tyflag), 2) ELSE num$ = ""
  169.  FO$ = Fopre$ + num$ + TY$ + ".grf"
  170.  OPEN FO$ FOR OUTPUT AS #4
  171.  PRINT
  172.  PRINT "Now doing "; txt$(tynum, tyflag); "   Outputting to file: "; FO$
  173.  PRINT
  174.  PRINT "Skipping NODE data looking for LINE data....";
  175.  
  176.  DO WHILE NOT EOF(3)
  177.     LINE INPUT #3, a$
  178.     b$ = LEFT$(a$, 1)
  179.     IF b$ = "L" THEN  'We found the start of line segment data
  180.        IF gotflag = 0 THEN
  181.           gotflag = 1: PRINT "GOT IT.  Now doing lines...": PRINT
  182.           PRINT "LineID:#pairs..."
  183.        END IF
  184.        pairs = VAL(MID$(a$, 43, 6))
  185.        attrib = VAL(MID$(a$, 49, 6))
  186.       
  187.        'If there are no attributes then get another line
  188.        'This line is probably just connecting two nodes and is not a road, etc.
  189.     ' IF attrib <> 0 THEN
  190.      
  191.           'PRINT "Pairs =", pairs  '"Pairs" of x/y coordinates
  192.           'PRINT "Attributes ="; attrib   'number of attributes
  193.        
  194.           'Get the line with x/y data
  195.           k = 0   'This is the pointer to move through the line of data
  196.           LINE INPUT #3, a$
  197.           FOR i = 1 TO pairs
  198.               k = k + 1
  199.               z = 25 * (k - 1)
  200.               origx(i) = VAL(MID$(a$, z + 1, 12))
  201.               origy(i) = VAL(MID$(a$, z + 13, 12))
  202.               'There is a maximum of 3 pairs of x/y coordinates on a line.
  203.               'If there are more than 3 pairs get another line.
  204.               IF k = 3 AND pairs > i THEN k = 0: LINE INPUT #3, a$
  205.           NEXT i
  206.           
  207.           IF attrib > 0 THEN          'Recover attributes (i.e. road type, etc)
  208.              LINE INPUT #3, a$
  209.             
  210.              IF attrib = 1 THEN
  211.                major$ = MID$(a$, 3, 5)
  212.                minor$ = MID$(a$, 10, 4)
  213.              END IF
  214.             
  215.              'If first attribute code is "incidental feature" recover second
  216.              'code.
  217.              IF attrib > 1 THEN
  218.                IF VAL(MID$(a$, 3, 5)) = 179 THEN
  219.                  major$ = MID$(a$, 14, 5)
  220.                  minor$ = MID$(a$, 21, 4)
  221.                ELSE
  222.                  major$ = MID$(a$, 3, 5)
  223.                  minor$ = MID$(a$, 10, 4)
  224.                END IF
  225.  
  226.                'For cases where both first & second attrib is "incidental"
  227.                IF VAL(major$) = 179 AND attrib > 2 THEN
  228.                  major$ = MID$(a$, 26, 5)
  229.                  minor$ = MID$(a$, 33, 4)
  230.                END IF
  231.              END IF
  232.             
  233.              m = VAL(major$)
  234.              n = VAL(minor$)
  235.           END IF
  236.          
  237.           doit = 0
  238.           
  239.           IF tynum = 1 THEN     ' Water
  240.              IF tyflag = 1 AND m = 50 AND (n = 200 OR n = 201) THEN doit = 1
  241.              IF tyflag = 1 AND m = 50 AND (n = 605 OR n = 606) THEN doit = 1
  242.              IF tyflag = 2 AND m = 50 AND n = 412 THEN doit = 1
  243.           ELSEIF tynum = 2 THEN ' Airports
  244.              IF tyflag = 1 AND m = 190 AND n = 403 THEN doit = 1
  245.           ELSEIF tynum = 3 THEN ' Roads
  246.              'skip coincident road features m=179
  247.              IF tyflag = 1 AND m = 172 THEN doit = 1'Interstates
  248.              IF tyflag = 2 AND m = 173 THEN doit = 1'U.S. Highways
  249.              IF tyflag = 3 AND m = 174 THEN doit = 1'State Highways
  250.              IF tyflag = 4 AND m = 176 THEN doit = 1'County routes
  251.  
  252.              IF m = 170 THEN
  253.                 IF tyflag = 5 AND m = 170 THEN
  254.                    IF n = 201 THEN doit = 1
  255.                    IF n = 202 THEN doit = 1
  256.                    IF n = 203 THEN doit = 1
  257.                    IF n = 204 THEN doit = 1
  258.                 ELSEIF tyflag = 6 AND m = 170 THEN
  259.                    IF n = 205 THEN doit = 1
  260.                    IF n = 206 THEN doit = 1
  261.                    IF n = 207 THEN doit = 1
  262.                    IF n = 208 THEN doit = 1
  263.                 ELSEIF tyflag = 7 AND n = 209 THEN doit = 1
  264.                 ELSEIF tyflag = 8 AND n = 210 THEN doit = 1
  265.                 ELSEIF tyflag = 9 AND n = 211 THEN doit = 1
  266.                 ELSEIF tyflag = 10 AND n = 212 THEN doit = 1
  267.                 END IF
  268.              END IF
  269.           END IF
  270.           IF doit THEN
  271.  
  272.           'Check if reversing the order is needed so that the JOIN command
  273.           'in MAPFIX will work. (Checking if last points x/y same as first point
  274.           'in this segment.)
  275.           reverse = 1
  276.           IF id >= 2 THEN
  277.                  IF origx(1) = lastx AND origy(1) = lasty THEN
  278.                     PRINT "*"; : lc = lc + 1
  279.                     FOR i = 1 TO pairs
  280.                         x(i) = origx(i)
  281.                         y(i) = origy(i)
  282.                     NEXT i
  283.                     reverse = 0
  284.                  END IF
  285.           END IF
  286.         
  287.           IF reverse THEN
  288.              'Reverse the order - last set of coordinates becomes first set.
  289.              'Otherwise map segments will not be properly joined.
  290.              FOR i = 0 TO pairs
  291.                  x(i + 1) = origx(pairs - i)
  292.                  y(i + 1) = origy(pairs - i)
  293.              NEXT i
  294.           END IF
  295.         
  296.           'Print header for line
  297.           id = id + 1' Increment the line identifier
  298.           rank = VAL(MID$(minor$, 2, 2))
  299.           firstattrib = VAL(LEFT$(major$, 5))
  300.           submajor = VAL(LEFT$(minor$, 2))
  301.        
  302.           'Convert the 1 to 100,000 scale attributes to those used by 1 to 2,000,000.
  303.           'This is so the highway colors plot correctly.
  304.    IF firstattrib = 172 THEN rank = 1: att$ = "I-": 'Interstate
  305.    IF firstattrib = 173 THEN rank = 19: att$ = "US": 'U.S. route
  306.    IF firstattrib = 174 THEN rank = 23: att$ = "SR": 'State route
  307.    IF firstattrib = 176 THEN rank = 23: att$ = "CO": 'County route
  308.    IF firstattrib = 170 THEN rank = 25: att$ = " ": 'state secondary unnamed
  309.          
  310.           IF lc > 300 THEN lc = 0: CLS : PRINT "Major, Minor"; major$; minor$
  311.           PRINT RTRIM$(STR$(id)); ":"; LTRIM$(STR$(pairs)); : lc = lc + 1
  312.           PRINT #4, USING "#######"; id;
  313.           PRINT #4, USING "##"; rank;
  314.           PRINT #4, USING "######"; pairs;
  315.             'PRINT #4, USING "###"; firstattrib;
  316.             'PRINT #4, USING "##"; submajor
  317.           'Following prints Hwy type and number, i.e. US101
  318.           PRINT #4, USING "\\###"; att$; VAL(minor$);
  319.  
  320.           'Convert from x/y meters to decimal lat/long
  321.           FOR i = 1 TO pairs
  322.               'Find the delta from base x and y coordinates
  323.               dex = basex - x(i)
  324.               dey = basey - y(i)
  325.  
  326.   'Added for UTM grid error correction
  327.          yfac = 1 - (dey / ydelta)
  328.          xfac = dex / xdelta
  329.          'x error is tied to y. Less y = more error
  330.          xerrfac = xerr * yfac
  331.          'y error is tied to x. Less x = more error
  332.          yerrfac = yerr * xfac
  333.          dey = dey - yerrfac
  334.          dex = dex - xerrfac
  335.             
  336.         
  337.               'Convert the delta x/y into lat/long delta
  338.               delat = dey * latfac
  339.               delon = dex * lonfac
  340.  
  341.               'Add the lat/long delta to the base decimal lat/long
  342.               lat = baselat - delat
  343.               lon = baselon + delon
  344.  
  345.               'Convert decimal lat/long to lat/long in degrees, minutes, and seconds.
  346.               latdeg = INT(lat)
  347.               latmin = (lat - latdeg) * 60
  348.               latminint = INT(latmin)
  349.               latsec = (latmin - latminint) * 60
  350.               'PRINT latmin, latminint; "  ";
  351.               londeg = INT(lon)
  352.               lonmin = (lon - londeg) * 60
  353.               lonminint = INT(lonmin)
  354.               lonsec = (lonmin - lonminint) * 60
  355.               'PRINT lonmin, lonminint
  356.          
  357.               'Following for debug
  358.               'PRINT USING "##°"; latdeg;
  359.               'PRINT USING "##'"; latminint;
  360.               'PRINT USING "##''N  "; latsec;
  361.               '
  362.               ' PRINT USING "###°"; londeg;
  363.               ' PRINT USING "##'"; lonminint;
  364.               ' PRINT USING "##''W"; lonsec
  365.           
  366.               'Check output format to match 1 to 2,000,000 graphics format which
  367.               'APRS MAPFIX expects
  368.               PRINT #4, USING "##"; latdeg; : IF latdeg < 30 THEN PRINT "******"; latdeg
  369.               PRINT #4, USING "##"; latminint;
  370.               PRINT #4, USING "##N"; latsec;
  371.               PRINT #4, USING "###"; londeg;
  372.               PRINT #4, USING "##"; lonminint;
  373.               PRINT #4, USING "##W"; lonsec;
  374.               PRINT #4, USING "#####"; i; ' sequence counter (counts up to the number of pairs).
  375.           NEXT i
  376.       
  377.           'Save the last x/y for checking later on
  378.           lastx = x(i - 1)
  379.           lasty = y(i - 1)
  380.           END IF' matches doit
  381.       ' END IF'matches atribute<>0
  382.     END IF ' This is from the IF statement which checked for an "L"
  383.  LOOP
  384.  
  385.  'INPUT "Press any key to continue"; in$ 'for debugging
  386.  'FOR x = 1 TO 50000: NEXT x 'For debugging
  387.  CLOSE #3
  388.  CLOSE #4
  389.  PRINT
  390.  PRINT "Finished!  OUTPUT IS IN FILE NAMED: "; FO$
  391.  PRINT
  392.  IF tyflag < Endflag THEN GOTO top
  393.  INPUT "Convert another file (Y)"; a$
  394.  IF UCASE$(a$) = "Y" THEN tyflag = 0: GOTO top
  395.  SYSTEM
  396. END
  397.  
  398. 'Put the error routine here
  399. Errorfix:
  400.  
  401.