REM Program name: 100toGRF.bas modified from W7KKE's CONV101.BAS
REM This program takes the USGS cd rom 1 TO 100,000 Digital Line Graph
REM "Optional Format" output and converts it into the same format as the
REM 1 to 2,000,000 Graphic Format output which APRS MAPFIX can read.
REM ************** MODIFICATION HISTORY ****************
REM 24AUG94  W7KKE  Expanded menu to include other types of water boundaries.
REM 4 Nov    WB4APR Instead of prompting user, now program just generates and
REM                 names files for all the features in the given type
REM                 RENAMED PROGRAM to be 100toGRF.BAS
REM 15Nov94  W7KKE  Picked up the second attribute code when the first
REM                 was an "incidental feature". Due to CD ROM digitizing
REM                 techniques this was causing lines which ran due east/west
REM                 or north/south to be lost.
REM
REM RENAMED PROGRAM back to CONV100.bas

'Declare x and y as long variables
DIM lon AS DOUBLE
DIM x(400) AS LONG
DIM y(400) AS LONG'Largest number of x/y line pairs expected.
DIM origx(400) AS LONG
DIM origy(400) AS LONG
DIM lastx(5000) AS LONG
DIM lasty(5000) AS LONG

'Dimension integer variables for speed in extraction loop
DIM tyflag AS INTEGER
DIM id AS INTEGER
DIM k AS INTEGER
DIM k1 AS INTEGER
DIM i AS INTEGER
DIM txt$(3, 11)
txt$(1, 1) = "Water Bodies (color 11)"      'Output as WB
txt$(1, 2) = "Rivers and streams (color 3)" 'Output as ST

txt$(2, 1) = "AIRPORTS"                     'Output as CF

txt$(3, 1) = "1) Interstate freeways"     'All output as RD
txt$(3, 2) = "2) U.S. Highways"
txt$(3, 3) = "3) State Routes"
txt$(3, 4) = "4) County Routes"
txt$(3, 5) = "5) Primary Routes"
txt$(3, 6) = "6) Secondary Routes"
txt$(3, 7) = "7) Roads or streets (class 3)"
txt$(3, 8) = "8) Roads or streets (class 4)"
txt$(3, 9) = "9) Trails (other than four wheel drive)"
txt$(3, 10) = "10) Trails (four wheel drive)"

REM on error goto errorfix
CLS
PRINT "This program will take the output files from the 100,000 USGS EXTRACT"
PRINT "program and generate categories of intermediate files that look like"
PRINT "the 2,000,000:1  GRAPHIC format.  These files can then be pulled into"
PRINT "the APRS MAPFIX program using the alt-U command."
PRINT
PRINT "The source file (output by the CD ROM EXTRACT program) will identify the type"
PRINT "of data it contains (water, roads, or airports).  This program will then auto-"
PRINT "matically generate and name output files of the form PRE#TY.GRF where:"
PRINT "           PRE  is a  user defined prefix for all files in this run"
PRINT "           #    is the feature category (1-10 for roads)"
PRINT "           TY   is either WB, ST, RD or CF"
PRINT
PRINT "This naming convention is compatible with the 2,000,000 and MAPFIX format."
PRINT

top:
 id = 0 'Line ID counter
 IF tyflag = 0 THEN
    'Increment TYflag for each loop to make different files for each category
    'Files are named like BA4HYDxx or BA4RDSxx or BA4MTFxx (misc Transprtn)
    'Where the xx are numbers
    INPUT "Enter path and File name of source data"; F$
           'F$ = "d:\severn\" + F$
           'F$ = "SJ2RDF05"

    INPUT "Enter file name PREFIX to be used in all output files."; Fopre$
           Fopre$ = LEFT$(Fopre$, 4)
    PRINT

 END IF
 tyflag = tyflag + 1
 OPEN F$ FOR INPUT AS #3
 PRINT "Corner coordinates:"
 DO WHILE NOT EOF(3)
    LINE INPUT #3, a$    'Look for Quadrant calibration data
    b$ = LEFT$(a$, 2)
    IF b$ = "SW" THEN
       swlat = VAL(MID$(a$, 7, 11))
       swlon = ABS(VAL(MID$(a$, 19, 11)))
       swx = VAL(MID$(a$, 39, 11))
       swy = VAL(MID$(a$, 51, 11))
       PRINT "SW: "; swlat, swlon, swx, swy
    ELSEIF b$ = "NW" THEN
       nwlat = VAL(MID$(a$, 7, 11))
       nwlon = ABS(VAL(MID$(a$, 19, 11)))
       nwx = VAL(MID$(a$, 39, 11))
       nwy = VAL(MID$(a$, 51, 11))
       PRINT "NW: "; nwlat, nwlon, nwx, nwy
    ELSEIF b$ = "NE" THEN
       nelat = VAL(MID$(a$, 7, 11))
       nelon = ABS(VAL(MID$(a$, 19, 11)))
       nex = VAL(MID$(a$, 39, 11))
       ney = VAL(MID$(a$, 51, 11))
       PRINT "NE: "; nelat, nelon, nex, ney
    ELSEIF b$ = "SE" THEN
       selat = VAL(MID$(a$, 7, 11))
       selon = ABS(VAL(MID$(a$, 19, 11)))
       sex = VAL(MID$(a$, 39, 11))
       sey = VAL(MID$(a$, 51, 11))
       PRINT "SE: "; selat, selon, sex, sey
    END IF
    IF b$ = "SE" THEN EXIT DO
 LOOP

 'Determine type of map so proper line type will be extracted.
 tynum = 0' type map files we are reading.
 TY$ = "" ' TYpe file name to be output (WB, ST, CF, or RD)
 
 REM roadflag = 0' zero flag for roads and airports
 PRINT
 DO WHILE NOT EOF(3)
    LINE INPUT #3, a$
    IF LEFT$(a$, 5) = "HYDRO" THEN
                 tynum = 1: Endflag = 2
                      IF tyflag = 1 THEN TY$ = "WB" ELSE TY$ = "ST"
    END IF

    IF LEFT$(a$, 4) = "PIPE" THEN tynum = 2: Endflag = 1: TY$ = "CF"'AIRPORTS
                      'Named CF to match cultural features in 2,000,000 format
    IF LEFT$(a$, 5) = "ROADS" THEN tynum = 3: Endflag = 10: TY$ = "RD"
    IF LEFT$(a$, 1) = "N" THEN EXIT DO ' Found start of node data
    PRINT LEFT$(a$, 20)
 LOOP

convert: 'Calculate the x/y meters to lat/long conversion factors
   basex = sex: basey = ney
   baselat = nelat: baselon = selon

   xdelta = sex - swx: ydelta = ney - sey
   londelta = swlon - selon: latdelta = nelat - selat
 
   lonfac = londelta / xdelta: latfac = latdelta / ydelta

   PRINT
   PRINT "baselat ="; baselat; TAB(30); "baselon ="; baselon
   PRINT "base x ="; basex; TAB(30); "base y ="; basey
   PRINT "xdelta = "; xdelta; TAB(30); "ydelta ="; ydelta
   PRINT "londelta ="; londelta; TAB(30); "latdelta ="; latdelta
   PRINT "lonfac ="; lonfac; TAB(30); "latfac ="; latfac

 gotflag = 0
 IF tynum = 3 THEN num$ = MID$(STR$(tyflag), 2) ELSE num$ = ""
 FO$ = Fopre$ + num$ + TY$ + ".grf"
 OPEN FO$ FOR OUTPUT AS #4
 PRINT
 PRINT "Now doing "; txt$(tynum, tyflag); "   Outputting to file: "; FO$
 PRINT
 PRINT "Skipping NODE data looking for LINE data....";

 DO WHILE NOT EOF(3)
    LINE INPUT #3, a$
    b$ = LEFT$(a$, 1)
    IF b$ = "L" THEN  'We found the start of line segment data
       IF gotflag = 0 THEN
          gotflag = 1: PRINT "GOT IT.  Now doing lines...": PRINT
          PRINT "LineID:#pairs..."
       END IF
       pairs = VAL(MID$(a$, 43, 6))
       attrib = VAL(MID$(a$, 49, 6))
      
       'If there are no attributes then get another line
       'This line is probably just connecting two nodes and is not a road, etc.
    ' IF attrib <> 0 THEN
     
          'PRINT "Pairs =", pairs  '"Pairs" of x/y coordinates
          'PRINT "Attributes ="; attrib   'number of attributes
       
          'Get the line with x/y data
          k = 0   'This is the pointer to move through the line of data
          LINE INPUT #3, a$
          FOR i = 1 TO pairs
              k = k + 1
              z = 25 * (k - 1)
              origx(i) = VAL(MID$(a$, z + 1, 12))
              origy(i) = VAL(MID$(a$, z + 13, 12))
              'There is a maximum of 3 pairs of x/y coordinates on a line.
              'If there are more than 3 pairs get another line.
              IF k = 3 AND pairs > i THEN k = 0: LINE INPUT #3, a$
          NEXT i
          
          IF attrib > 0 THEN          'Recover attributes (i.e. road type, etc)
             LINE INPUT #3, a$
            
             IF attrib = 1 THEN
               major$ = MID$(a$, 3, 5)
               minor$ = MID$(a$, 10, 4)
             END IF
            
             'If first attribute code is "incidental feature" recover second
             'code.
             IF attrib > 1 THEN
               IF VAL(MID$(a$, 3, 5)) = 179 THEN
                 major$ = MID$(a$, 14, 5)
                 minor$ = MID$(a$, 21, 4)
               ELSE
                 major$ = MID$(a$, 3, 5)
                 minor$ = MID$(a$, 10, 4)
               END IF

               'For cases where both first & second attrib is "incidental"
               IF VAL(major$) = 179 AND attrib > 2 THEN
                 major$ = MID$(a$, 26, 5)
                 minor$ = MID$(a$, 33, 4)
               END IF
             END IF
            
             m = VAL(major$)
             n = VAL(minor$)
          END IF
         
          doit = 0
          
          IF tynum = 1 THEN     ' Water
             IF tyflag = 1 AND m = 50 AND (n = 200 OR n = 201) THEN doit = 1
             IF tyflag = 2 AND m = 50 AND n = 412 THEN doit = 1
          ELSEIF tynum = 2 THEN ' Airports
             IF tyflag = 1 AND m = 190 AND n = 403 THEN doit = 1
          ELSEIF tynum = 3 THEN ' Roads
             'skip coincident road features m=179
             IF tyflag = 1 AND m = 172 THEN doit = 1'Interstates
             IF tyflag = 2 AND m = 173 THEN doit = 1'U.S. Highways
             IF tyflag = 3 AND m = 174 THEN doit = 1'State Highways
             IF tyflag = 4 AND m = 176 THEN doit = 1'County Routes
             IF tyflag = 4 AND m = 177 THEN doit = 1'(alpha num. in Calif)
            
             IF m = 170 THEN
                IF tyflag = 5 AND m = 170 THEN
                   IF n = 201 THEN doit = 1
                   IF n = 202 THEN doit = 1
                   IF n = 203 THEN doit = 1
                   IF n = 204 THEN doit = 1
                ELSEIF tyflag = 6 AND m = 170 THEN
                   IF n = 205 THEN doit = 1
                   IF n = 206 THEN doit = 1
                   IF n = 207 THEN doit = 1
                   IF n = 208 THEN doit = 1
                ELSEIF tyflag = 7 AND n = 209 THEN doit = 1
                ELSEIF tyflag = 8 AND n = 210 THEN doit = 1
                ELSEIF tyflag = 9 AND n = 211 THEN doit = 1
                ELSEIF tyflag = 10 AND n = 212 THEN doit = 1
                END IF
             END IF
          END IF
          IF doit THEN

          'Check if reversing the order is needed so that the JOIN command
          'in MAPFIX will work. (Checking if last points x/y same as first point
          'in this segment.)
          reverse = 1
          IF id >= 2 THEN
             FOR k1 = 1 TO id
                 IF origx(1) = lastx(k1) AND origy(1) = lasty(k1) THEN
                    PRINT "*"; : lc = lc + 1
                    FOR i = 1 TO pairs
                        x(i) = origx(i)
                        y(i) = origy(i)
                    NEXT i
                    k1 = id
                    reverse = 0
                 END IF
             NEXT k1
          END IF
        
          IF reverse THEN
             'Reverse the order - last set of coordinates becomes first set.
             'Otherwise map segments will not be properly joined.
             FOR i = 0 TO pairs
                 x(i + 1) = origx(pairs - i)
                 y(i + 1) = origy(pairs - i)
             NEXT i
          END IF
        
          'Print header for line
          id = id + 1' Increment the line identifier
          rank = VAL(MID$(minor$, 2, 2))
          firstattrib = VAL(LEFT$(major$, 5))
          submajor = VAL(LEFT$(minor$, 2))
       
          'Convert the 1 to 100,000 scale attributes to those used by 1 to 2,000,000.
          'This is so the highway colors plot correctly.
   IF firstattrib = 172 THEN rank = 1: att$ = "I-": 'Interstate
   IF firstattrib = 173 THEN rank = 19: att$ = "US": 'U.S. route
   IF firstattrib = 174 THEN rank = 23: att$ = "SR": 'State route
   IF firstattrib = 176 THEN rank = 23: att$ = "CO": 'County route
   IF firstattrib = 170 THEN rank = 25: att$ = " ": 'state secondary unnamed
         
          IF lc > 300 THEN lc = 0: CLS : PRINT "Major, Minor"; major$; minor$
          PRINT RTRIM$(STR$(id)); ":"; LTRIM$(STR$(pairs)); : lc = lc + 1
          PRINT #4, USING "#######"; id;
          PRINT #4, USING "##"; rank;
          PRINT #4, USING "######"; pairs;
            'PRINT #4, USING "###"; firstattrib;
            'PRINT #4, USING "##"; submajor
          'Following prints Hwy type and number, i.e. US101
          PRINT #4, USING "\\###"; att$; VAL(minor$);

          'Convert from x/y meters to decimal lat/long
          FOR i = 1 TO pairs
              'Find the delta from base x and y coordinates
              dex = basex - x(i)
              dey = basey - y(i)
        
              'Convert the delta x/y into lat/long delta
              delat = dey * latfac
              delon = dex * lonfac

              'Add the lat/long delta to the base decimal lat/long
              lat = baselat - delat
              lon = baselon + delon

              'Convert decimal lat/long to lat/long in degrees, minutes, and seconds.
              latdeg = INT(lat)
              latmin = (lat - latdeg) * 60
              latminint = INT(latmin)
              latsec = (latmin - latminint) * 60
              'PRINT latmin, latminint; "  ";
              londeg = INT(lon)
              lonmin = (lon - londeg) * 60
              lonminint = INT(lonmin)
              lonsec = (lonmin - lonminint) * 60
              'PRINT lonmin, lonminint
         
              'Following for debug
              'PRINT USING "##ø"; latdeg;
              'PRINT USING "##'"; latminint;
              'PRINT USING "##''N  "; latsec;
              '
              ' PRINT USING "###ø"; londeg;
              ' PRINT USING "##'"; lonminint;
              ' PRINT USING "##''W"; lonsec
          
              'Check output format to match 1 to 2,000,000 graphics format which
              'APRS MAPFIX expects
              PRINT #4, USING "##"; latdeg; : IF latdeg < 30 THEN PRINT "******"; latdeg
              PRINT #4, USING "##"; latminint;
              PRINT #4, USING "##N"; latsec;
              PRINT #4, USING "###"; londeg;
              PRINT #4, USING "##"; lonminint;
              PRINT #4, USING "##W"; lonsec;
              PRINT #4, USING "#####"; i; ' sequence counter (counts up to the number of pairs).
          NEXT i
      
          'Save the last x/y for checking later on
          lastx(id) = x(i - 1)
          lasty(id) = y(i - 1)
          END IF' matches doit
      ' END IF'matches atribute<>0
    END IF ' This is from the IF statement which checked for an "L"
 LOOP

 'INPUT "Press any key to continue"; in$ 'for debugging
 'FOR x = 1 TO 50000: NEXT x 'For debugging
 CLOSE #3
 CLOSE #4
 PRINT
 PRINT "Finished!  OUTPUT IS IN FILE NAMED: "; FO$
 PRINT
 IF tyflag < Endflag THEN GOTO top
 INPUT "Convert another file (Y)"; a$
 IF UCASE$(a$) = "Y" THEN tyflag = 0: GOTO top
 SYSTEM
END

'Put the error routine here
Errorfix:

