DECLARE SUB init (mapf AS STRING, datf AS STRING, fldr AS STRING)
DECLARE SUB fbook (finx%, f AS STRING, fldr AS STRING, bcolor%, suffix AS STRING)
DECLARE SUB test (rcno&, rstop&, testflg%, finx%, attrb%)
DECLARE SUB redraw (cmaxrec&, datf AS STRING)

' Based on Version 0.05  30 May 94 - KB4XF Jack Cavanagh, of Fredericksburg, VA
' Modified by APR on 3 May 1995 to add some explaination text to tell users
' to keep maps small (40 miles or so).  This plus increasing the max number of pts
' up to 6000 minimizes the number of TRUNCATED points
' Also put in test to prevent x=0 points....
' Modified By W4NMK Dan Reilly to make APRS maps from USGS date downloaded from
' the INTERNET
DEFSTR A-Z
COMMON SHARED lat0!, long0!, latmax!, longmax!, ppdy!, ppdx!
COMMON SHARED latmin!, longmin!, version$, Hfac!
version$ = "Version 1.1"
CALL init(mapf, datf, fldr)
npts& = 1
finx% = 1
nseg% = 0
oldx! = 999
oldy! = 999
PRINT
PRINT
a! = 2
CLS
ON ERROR GOTO Errortrap
WHILE finx% < a!
Again: Fault% = 0
CALL fbook(finx%, f, fldr, bcolor%, suffix)
INPUT " Enter file and path name for USGS data"; f$  'Use combined filename
IF INSTR(f$, ".") = 0 THEN f$ = f$ + ".GRA"
OPEN f$ FOR RANDOM AS 1# LEN = 20
IF Fault% = 75 THEN finx% = finx% + 1: GOTO Again
labnr% = 0
minrec% = 1000
maxrec% = 0
rcno& = 1
startflg% = -1
tstart = TIME$
FIELD #1, 7 AS lno, 2 AS atc, 6 AS np, 5 AS att
DO WHILE NOT EOF(1)
LOCATE 1, 1
PRINT suffix; rcno&
GET 1, rcno&
nrec% = VAL(np)
aatc% = VAL(atc)
aatt% = VAL(att) - 29000
IF aatt% < 0 THEN aatt% = 0
attrb% = 100 * aatt% + aatc%
rstop& = rcno& + nrec%
rcno& = rcno& + 1
FIELD #1, 2 AS lad, 2 AS lam, 3 AS las, 3 AS lod, 2 AS lom, 2 AS los, 6 AS d$
CALL test(rcno&, rstop&, testflg%, finx%, attrb%)
LOCATE 1, 1
PRINT SPACE$(12);
IF testflg% THEN
IF nrec% < minrec% AND nrec% <> 0 THEN minrec% = nrec%
 IF nrec% > maxrec% THEN maxrec% = nrec%
 DO WHILE rcno& <= rstop&
 GET 1, rcno&
 alat! = VAL(lad) + VAL(lam) / 60 + VAL(las) / 3600
 along! = VAL(lod) + VAL(lom) / 60 + VAL(los) / 3600
 REM Test to see if this point is on map
 LOCATE 1, 1
 PRINT alat!; along!; aatc%;
 ok% = 0
 IF (alat! <= latmax!) AND (alat! >= latmin!) THEN
   IF (along! <= longmax!) AND (along! >= longmin!) THEN
      ok% = -1
   END IF
 END IF
 IF ok% THEN
      x! = INT(.5 + (longmax! - along!) * ppdy!): IF x! = 0 THEN x! = 1
      y! = INT(.5 + (latmax! - alat!) * ppdy!)
    ' Test for continuation of last line segment
      IF (x! = oldx!) AND (oldy! = y!) THEN startflg% = 0
      oldx! = x!
      oldy! = y!
      npts& = npts& + 1
     IF startflg% THEN
       icolor% = bcolor%
      IF finx% = 1 THEN
       SELECT CASE aatc%
           CASE 1: icolor% = 10
           CASE 13 TO 19: icolor% = 12
           CASE 20 TO 23: icolor% = 4
           CASE 71 TO 75: icolor% = 8
           CASE 9: icolor% = 6
           CASE 4 TO 8: icolor% = 3
           CASE 10 TO 12: icolor% = 3
           CASE ELSE: icolor% = 7
       END SELECT
      END IF
      IF finx% = 3 THEN
         IF attrb% = 3095 THEN icolor% = 9' Intercoastal waterway
      END IF
       PSET (x! * Hfac!, y!), icolor%
       PRINT #2, "   0,   0"
       labnr% = labnr% + 1
       lab = LEFT$(suffix, 1) + LTRIM$(STR$(labnr%))
       PRINT #2, USING "##_,\    \"; icolor%; lab
       PRINT #2, USING "####_,####"; x!; y!
       ix% = INT(Hfac! * 80 * x! / 640) + 1
       iy% = INT(43 * y! / 350) + 1
       IF ix% > 75 THEN ix% = 75
       IF iy% > 43 THEN iy% = 43
       LOCATE iy%, ix%
       PRINT lab;
       nseg% = nseg% + 1
       startflg% = 0
     ELSE
      LINE -(x! * Hfac!, y!), icolor%
      PRINT #2, USING "####_,####"; x!; y!
    END IF
  ELSE
    startflg% = -1
 END IF
 rcno& = rcno& + 1
 LOOP
 startflg% = -1
ELSE
 rcno& = rstop& + 1
END IF
LOOP
tstop = TIME$
PRINT tstart; " "; tstop; minrec%; maxrec%
finx% = finx% + 1
cmaxrec& = LOF(2) \ 11
CLOSE 1
CLOSE 2
LOCATE 1, 1
PRINT "make notes for manual deletion/merge. Hit key to continue";
REM DO WHILE INKEY$ = "": LOOP
CALL redraw(cmaxrec&, datf)
OPEN datf FOR APPEND AS #2
WEND
CLOSE 1
REM  Map extraction complete now thin map to reduce number of pts to 6000
thin% = INT(npts& \ (6000 - 2 * nseg% - 7)) + 1
LOCATE 1, 1: PRINT "KEEPING every"; thin%; "th point..."
nrecm& = LOF(2) \ 11
CLOSE 2
' re-open as a random file
OPEN datf FOR RANDOM AS #2 LEN = 11
OPEN mapf FOR RANDOM AS #1 LEN = 11
FIELD 1, 11 AS stuff
FIELD 2, 11 AS instuff
'copy first seven lines to output file
FOR I% = 1 TO 8 'was 7
GET 2, I%
LSET stuff = instuff
PUT 1, I%
NEXT I%
xtest% = 0
rstart& = 8 'was 7
DO WHILE rstart& < nrecm&
 WHILE NOT xtest%
 GET 2, rstart&
 rstart& = rstart& + 1
 IF (LEFT$(instuff, 9) = "   0,   0") THEN xtest% = -1
   IF rstart& > nrecm& THEN
    xtest% = -1
    rstart& = nrecm&
   END IF
 WEND
 xtest% = 0
 rstop& = rstart&
 WHILE NOT xtest%
  rstop& = rstop& + 1
  GET 2, rstop& + 1
  IF (LEFT$(instuff, 9) = "   0,   0") THEN xtest% = -1
   IF rstop& > nrecm& THEN
     rstop& = nrecm&
     xtest% = -1
   END IF
 WEND
'Copy every thin(t)h record from input to output file
'If line segment has less than n points then skip,
' but making sure first and last points the same
' for both long and short segment
 N% = (rstop& - rstart&) / thin% + 1
 rcno& = rstart&
 IF N% > 2 THEN   'Forget short segments
  LSET stuff = "   0,   0" + CHR$(&HD) + CHR$(&HA)
  PUT 1
  GET 2, rcno&
  LSET stuff = instuff 'Color and segment label
  PUT 1
  rcno& = rcno& + 1
  wflg% = -1
  DO WHILE wflg%
    IF rcno& < rstop& THEN
      GET 2, rcno&
      LSET stuff = instuff
      PUT 1
     ELSE
      GET 2, rstop&
      LSET stuff = instuff
      PUT 1
      wflg% = 0
    END IF
    x% = VAL(instuff)
    y% = VAL(MID$(instuff, 6, 4))
    PRESET (x% * Hfac!, y%), 15
    rcno& = rcno& + thin%
  LOOP
 END IF
  rcno& = rstop& + 1
  rstart& = rcno&
xtest% = 0
LOOP
CLOSE
LOCATE 43, 1: INPUT "Map is complete... Hit ENTER to continue..."; a$
CLS
PRINT "Now your completed map is in file: "; mapf
PRINT
PRINT "Load MAPFIX and use the alt-JOIN and alt-SMOOTH functions to remove additional"
PRINT "points.  I run alt-JOIN multiple times, starting with a factor of 1.2, then"
PRINT "1.3, 1.4 and even 1.8 or so, until I get down to about 4000 points.  Use"
PRINT "the minimum factor necessary to avoid straightening out the roads too much."
PRINT "(below 1.5 will hardly be noticable; above 2 will really cut corners)"
PRINT
PRINT "Then finally, use the +/- keys to cycle through each and every point in the"
PRINT "map and alt-DELETE any unnecessary points.  This takes the most time, but"
PRINT "can get rid of hundreds of unnecessary points!  There are lots of wasted and"
PRINT "duplicate points in the following areas:"
PRINT
PRINT "    COUNTY LINES!  (who cares about the detail crooks and crannies!"
PRINT "    INTERSTATES    (BOTH lanes are duplicated and identical!)"
PRINT "    STREAMS        (who cares about every crook and bend..."
PRINT
PRINT
INPUT "Hit ENTER to end this program..."; a$
STOP

Errortrap: Fault% = ERR
           IF ERR = 75 THEN RESUME NEXT
END

SUB fbook (finx%, f, fldr, bcolor%, suffix)
SELECT CASE finx%
CASE 1: suffix = "rd": bcolor% = 10
CASE 2: suffix = "wb": bcolor% = 11
CASE 3: suffix = "st": bcolor% = 3
CASE 4: suffix = "pb": bcolor% = 6
CASE 5: suffix = "ab": bcolor% = 14
CASE 6: suffix = "cf": bcolor% = 5
CASE 7: suffix = "rr": bcolor% = 8
END SELECT
f = fldr + suffix + ".grf"
END SUB

SUB init (mapf, datf, fldr)
REM DIM SHARED lat0!, long0!, latmax!, longmax!, ppdy!, ppdx!
REM DIM SHARED latmin!, longmin!
CLS
PRINT "This program is a modified version of MAKEMAP.bas to take USGS date"
PRINT "obtained from INTERNET and produces an APRS map.  This modification was"
PRINT "made by Dan Reilly, W4NMK, in Black Mountain North Carolina"
PRINT
PRINT "The original MAKEMAP program was based on the program written by Jack"
PRINT "Cavanagh, KB4XF, in Woodbridge VA to extract APRS map points from CD-ROM"
PRINT "and modified by WB4APR. "
PRINT
PRINT "Data is obtained from http;//edcftp.cr.usgs.gov/pub/data/DLG/2M/{area of"
PRINT "interest}/{transportation/hydrographic/political/railroads}/"
PRINT
PRINT "Chose the area of interest and the features from the menu."
PRINT
PRINT "You will get files named ROADS.GRA, WATER_BO.GRA, STREAMS.GRA, POLITICA.GRA"
PRINT "and RAILROAD.GRA.  Combine these into one BIG file using the COPY command:"
PRINT
PRINT "Copy ROADS.GRA+WATER_BO.GRA+STREAMS.GRA+POLITICA.GRA+RAILROAD.GRA BIGFILE.GRA."
PRINT "where BIGFILE.GRA will be your source file."
PRINT
PRINT "It is a hands-off, total map making process.  It extrtacts all points"
PRINT "within a given range of a given lat/long point and saves them in an"
PRINT "APRS compatible file named XXXXX.DAT."
PRINT
INPUT "Hit ENTER to proceed"; a$
CLS
PRINT "Then it uses a brute-force reduction technique that scans the total file and"
PRINT "only keeps every Nth point.   As long as N is on the order of 2 or 3, this is"
PRINT "not much of a problem, since the USGS data base has at least 100 points to"
PRINT "the inch at the original map scale.  The map is then saved as XXXXX.MAP."
PRINT
PRINT "To minimize this truncation, WB4APR modifed This program to permit "
PRINT "twice the nominal 3000 limit during this first reduction process.  By"
PRINT "limiting the initial number of points by choosing a smaller area (30 miles"
PRINT "or so (in the East) the result is a quite adequate map which can then be"
PRINT "loaded into MAPFIX where you may then use the more intelligent MAPFIX"
PRINT "alt-SMOOTH command and other techniques to eliminate more points down to the"
PRINT "nominal 3000 point limit."
PRINT
PRINT
INPUT "If you have your data and are ready to proceed, type GO "; ANS$
IF ANS$ = "GO" OR ANS$ = "go" THEN CLS  ELSE END
PRINT
CLS
INPUT "Enter a file name for results (.map) will be added "; mapf
INPUT "Enter latitude of map center in degrees,minutes (DD,MM) "; lat0!, latm!
INPUT "Enter longitude of map center in degrees,minutes (DDD,MM) "; long0!, longm!
lat0! = lat0! + latm! / 60
long0! = long0! + longm! / 60
   PRINT
   PRINT "Now select the map size.  In order to get about the right number of points"
   PRINT "Select 36 to 40 miles for anywhere East of the Mississippi.  Maybe 70 miles"
   PRINT "in the rural farm areas, and possibly 130 miles in the VERY sparse states."
   PRINT
   PRINT "You may go larger to get a larger map, and then spend lots more time using"
   PRINT "MAPFIX to remove un-needed points."
INPUT "Enter map radius in miles ", mradm!
datf = mapf + ".dat"
mapf = mapf + ".map"
rady! = mradm! / 60
radx! = 4 * mradm! / (COS(3.1416 * lat0! / 180) * 3 * 60)' Screen aspect ratio
latmax! = lat0! + rady!
latmin! = lat0! - rady!
longmax! = long0! + radx!
longmin! = long0! - radx!
ppdy! = INT(.5 + (350! / (2! * rady!)))
ppdx! = INT(.5 + (640! / (2! * radx!)))
Hfac! = ppdx! / ppdy!
OPEN datf FOR OUTPUT AS #2
PRINT #2, USING "###.####_,"; latmax!
PRINT #2, USING "###.####_,"; longmax!
PRINT #2, USING "#####.##_,"; ppdy!
PRINT #2, USING "###.####_,"; lat0!
PRINT #2, USING "###.####_,"; long0!
PRINT #2, USING "###.####_,"; mradm!
PRINT #2, "0,resrved"
PRINT #2, "comments "
CLS
SCREEN 9
WIDTH 80, 43
PALETTE 6, 6
END SUB

SUB redraw (cmaxrec&, datf) STATIC
nrec& = 8
CLS
OPEN datf FOR RANDOM AS #2 LEN = 11
FIELD 2, 11 AS stuff
WHILE nrec& < cmaxrec&
GET 2, nrec&
  IF stuff = "   0,   0" + CHR$(&HD) + CHR$(&HA) THEN
     GET 2, nrec& + 1
     clr% = VAL(stuff)
     nrec& = nrec& + 2
     GET 2, nrec&
     x% = VAL(stuff)
     y% = VAL(RIGHT$(stuff, 5))
     PSET (x% * Hfac!, y%), clr%
     nrec& = nrec& + 1
  ELSE
     x% = VAL(stuff)
     y% = VAL(RIGHT$(stuff, 5))
     LINE -(x% * Hfac!, y%), clr%
     nrec& = nrec& + 1
   END IF
WEND
CLOSE 2
LOCATE 1, 58: PRINT "CD pts so far:"; cmaxrec&
END SUB

SUB test (rcno&, rstop&, testflg%, finx%, attrb%)
'COMMON SHARED lat0!, long0!, latmax!, longmax!, ppdy!, ppdx!
'COMMON SHARED latmin!, longmin!
' Test last point to see if it is on map
FIELD #1, 2 AS lad, 2 AS lam, 3 AS las, 3 AS lod, 2 AS lom, 2 AS los, 6 AS d$
GET 1, rstop&
alat! = VAL(lad) + VAL(lam) / 60 + VAL(las) / 3600
along! = VAL(lod) + VAL(lom) / 60 + VAL(los) / 3600
testflg% = 0
IF (alat! <= latmax!) AND (alat! >= latmin!) THEN
  IF (along! <= longmax!) AND (along! >= longmin!) THEN
     testflg% = -1
  END IF
END IF
' Test midpoint to see if it falls on the map
recmid& = (rstop& + rcno&) \ 2
GET 1, recmid&
alat! = VAL(lad) + VAL(lam) / 60 + VAL(las) / 3600
along! = VAL(lod) + VAL(lom) / 60 + VAL(los) / 3600
IF (alat! <= latmax!) AND (alat! >= latmin!) THEN
  IF (along! <= longmax!) AND (along! >= longmin!) THEN
     testflg% = -1
  END IF
END IF
' Test first point to see if it is  on map
GET 1, rcno&
alat! = VAL(lad) + VAL(lam) / 60 + VAL(las) / 3600
along! = VAL(lod) + VAL(lom) / 60 + VAL(los) / 3600
IF (alat! <= latmax!) AND (alat! >= latmin!) THEN
  IF (along! <= longmax!) AND (along! >= longmin!) THEN
     testflg% = -1
  END IF
END IF
'This limits stream data to eliminate small lakes
' and river centerlines
IF finx% = 3 THEN
  IF attrb% = 3002 THEN testflg% = 0
  IF attrb% > 3030 AND attr% < 3070 THEN testflg% = 0
  REM IF attrb% = 3095 THEN testflg% = 0' Intercoastal waterway
END IF
END SUB

