home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
aprs72a.zip
/
CONV100C.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-04-11
|
16KB
|
401 lines
REM Program name: CONV100b.BAS
REM ********** FOR INSTRUCTIONS, SEE README.100
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 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 17Nov94 W7KKE Corrected lat/long calculations for UTM grid rotation.
REM 08Jan95 W7KKE Added "Far Shore" & "Near Shore" water body attribute
REM to pick up rivers.
REM 20Feb95 WB4APR changed line 81 to remove TEST line. Renamed CONV100b
REM 11Apr95 W7KKE Picked up name and source date (some maps are old!)
REM Reworked array logic to avoid crash on large files.
'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
'Dimension integer variables for speed in extraction loop
DIM tyflag AS INTEGER
DIM id AS INTEGER
DIM k 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 SCREEN 9
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
tyflag = 0 'for debugging (this was still = 2 as distroed in conv100b
END IF
tyflag = tyflag + 1
OPEN F$ FOR INPUT AS #3
LINE INPUT #3, a$ 'Throw away first line
LINE INPUT #3, a$ 'Get map name and source date from second line
unit$ = LEFT$(a$, 40)
sourcedate$ = MID$(a$, 42, 10)
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)
PRINT
PRINT unit$; " date of source material: "; sourcedate$
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
' Added for UTM grid error correction
yerr = ney - nwy
xerr = sex - nex
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 = 1 AND m = 50 AND (n = 605 OR n = 606) 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 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
IF origx(1) = lastx AND origy(1) = lasty THEN
PRINT "*"; : lc = lc + 1
FOR i = 1 TO pairs
x(i) = origx(i)
y(i) = origy(i)
NEXT i
reverse = 0
END IF
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)
'Added for UTM grid error correction
yfac = 1 - (dey / ydelta)
xfac = dex / xdelta
'x error is tied to y. Less y = more error
xerrfac = xerr * yfac
'y error is tied to x. Less x = more error
yerrfac = yerr * xfac
dey = dey - yerrfac
dex = dex - xerrfac
'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 = x(i - 1)
lasty = 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: