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)

' Code to make APRS maps from USGS dlg CD
' 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....

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 "The CD ROM contains 7 major categories of map features as follows:"
PRINT
PRINT "  1  ROADS                - Included in all APRS maps"
PRINT "  2  Water Boundaries     - Lots of points along coastlines"
PRINT "  3  Rivers and Streams   - Lots of points."
PRINT "  4  Political Boundaries - County lines.  Lots of points"
PRINT "  5  Administrative       - Park and military boarders"
PRINT "  6  Cultural features    - Airports"
PRINT "  7  Railroads            - Railroads"
PRINT
PRINT "As a minimum, MAKEMAPS will always use categories 1 and 2, and additional"
PRINT "categories up to the final category you select."
PRINT
INPUT "Select the maximum number of categories (7)"; a$
IF a$ = "" THEN a! = 8 ELSE a! = 1 + VAL(a$)
IF a! < 3 THEN a! = 3
IF a! > 8 THEN a! = 8
CLS
ON ERROR GOTO Errortrap
WHILE finx% < a!
Again: Fault% = 0
CALL fbook(finx%, f, fldr, bcolor%, suffix)
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
 REM 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 TO 13: icolor% = 10
        REM CASE 2 OR 6: icolor% = 12
        CASE 14 TO 19: icolor% = 12
        CASE 20 TO 23: icolor% = 4
        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 "READ AND COMPREHEND THESE ABOVE STEPS, SINCE YOU WILL RECEIVE NO FURTHER"
PRINT "SUCH GUIDANCE, hi hi..."
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 "WB4APR INTRODUCTION AND COMMENT:        "; version$
PRINT
PRINT "This program was written by Jack Cavanagh, KB4XF to extract APRS map points"
PRINT "Directly from the 2,000,000:1 CD ROM.  It is a hands-off, total map making"
PRINT "process.  It extrtacts all points within a given range of a given lat/long"
PRINT "point and saves them in an APRS compatible file named XXXXX.DAT."
PRINT
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, I (APR) have modifed his program to permit "
PRINT "twice the nominal 3000 limit during this first reduction process.  By also"
PRINT "limiting the initial number of points by choosing a smaller area (40 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 "Hit ENTER to proceed..."; a$

PRINT
PRINT "The Digital Line Graph CD is divided into sectors."
PRINT "You need to pick which sector to work with."
PRINT "The sector numbers and states are:"
PRINT
PRINT "1 - ME,NH,VT,MA,RI,CT,NY", TAB(40); , "12 - AZ,NM"
PRINT "2 - NJ,PA,OH,DE,MD,WV,VA", TAB(40); , "13 - Southern CA"
PRINT "3 - NC,SC,GA", TAB(40); , "14 - Northern CA,NV,UT"
PRINT "4 - Florida", TAB(40); , "15 - WA,OR,ID,Western MT"
PRINT "5 - TN,AL,MS,AK,LA", TAB(40); , "16 - SE Alaska"
PRINT "6 - KY,IN,IL,IA,MO", TAB(40); , "17 - Central Alaska"
PRINT "7 - MI,WI,MN", TAB(40); , "18 - Northern Alaska"
PRINT "8 - Southern TX", TAB(40); , "19 - SW Alaska"
PRINT "9 - OK, Northern TX", TAB(40); , "20 - Aleutian Is."
PRINT "10- KN,NB,CO", TAB(40); , "21 - Hawaiian Is."
PRINT "11- ND,SD,WY MT(east of divide)"
PRINT
INPUT "your choice"; sect%
INPUT "Enter letter designation for CD ROM drive ", d$
sectc$ = RIGHT$(STR$(INT(100 + sect%)), 2)
fldr = LEFT$(d$, 1) + ":\graphic\sect" + sectc$ + "\s" + sectc$ + "_"
CLS
PRINT "File name leader is "; fldr
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

