DECLARE SUB HELP ()
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....
' June 1,95 MAKEMAP1 increases PPD by a factor of 3 to get better resolution
' June 9, Added SKIPPT to skip every other pt in WB,ST,PB,AB and force % 2

DEFSTR A-Z
COMMON SHARED lat0!, long0!, latmax!, longmax!, ppdy!, ppdx!
COMMON SHARED latmin!, longmin!, version$, ALLpts%, 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! / 3, y! / 3), 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! / (3 * 640)) + 1
              iy% = INT(43 * y! / (3 * 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
              IF ALLpts% THEN
                 SkipPT% = 0
              ELSEIF suffix = "st" OR suffix = "wb" OR suffix = "pb" OR suffix = "ab" THEN
                 SkipPT% = NOT SkipPT%
              ELSE SkipPT% = 0
              END IF
              IF NOT SkipPT% THEN 'Skip every other point for WB,ST,AB and PB
                 LINE -(x! * Hfac! / 3, y! / 3), icolor%
                 PRINT #2, USING "####_,####"; x!; y!
              ELSE npts& = npts& - 1
              END IF
           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 "Total points:"; npts&
LOCATE 1, 22: PRINT "You will have to keep every"; Thin%; "rd point to stay under 5000..."
IF Thin% > 2 THEN
   Thin% = 2
   LOCATE 2, 1: PRINT "This is greater than 2 and may round off too many points.  You may select a"
   INPUT "this number or use the default factor of 2.  Divide points by how many (2)"; Thin$
   IF Thin$ <> "" THEN Thin% = VAL(Thin$) ELSE Thin% = 2
   PRINT "Final # of pts will be"; npts& / Thin%
END IF
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! / 3, y% / 3), 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
CALL HELP
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% = 2
CASE 6: suffix = "cf": bcolor% = 9
CASE 7: suffix = "rr": bcolor% = 8
END SELECT
f = fldr + suffix + ".grf"
END SUB

SUB HELP
PRINT "WHAT TO DO WITH THE TooLarge MAP PRODUCED BY THIS PROGRAM:"
PRINT
PRINT "Load MAPFIX and use the alt-JOIN command once.  Next use the alt-SMOOTH command"
PRINT "twice (or so) to remove additional points.  I run alt-SMOOTH twice at 1.1 and"
PRINT "twice at 1.2.  Beyond that, there is the danger of shortcutting long smooth"
PRINT "curves in roads, etc.  Once you get down to about 3500 or so points, the last"
PRINT "500 are best eliminated MANUALLY!  If you cant get below about 3600, then"
PRINT "either re-run MAKEMAP with a smaller area, or use the alt-TRIM command to"
PRINT "trim off excess area outside the alt-RANGE box."

PRINT
PRINT "Hit R to reset the MAP pointer to the first point in the file and zoom into"
PRINT "about the 8 mile range.  Hit the +/- keys to cycle through each and every point"
PRINT "in the map and alt-DELETE any unnecessary points.  Use the (G) GO command"
PRINT "to keep RE-CENTERING the map on the current MAPPOINT or use the Ctrl-A to"
PRINT "toggle on AUTO-CENTERING.  Continue with the + key through the entire map to"
PRINT "be sure you have looked at each and EVERY point.  This may take about an hour"
PRINT "but can get rid of hundreds of unnecessary points!   There are lots of wasted"
PRINT "and duplicate points in the following areas:"
PRINT
PRINT "    COUNTY LINES!  Who cares about the detail crooks and crannies!"
PRINT "    INTERSTATES    Often, BOTH lanes are duplicated and identical!)"
PRINT "    STREAMS        Who cares about every crook and bend..."
PRINT "    RAILROADS      You may want to leave em out, or alt-KILL 'em with MAPFIX"
PRINT
PRINT "Don't stop at exactly 2999 points, however.  Go on down to about 2950 to"
PRINT "leave a little room for adding 'personal' roads later.."
PRINT
PRINT "Use the ctrl-R command during the process to turn off the RE-DRAW function."
PRINT "This makes the alt-DELETE process much faster.  SPACE bar will re-draw"
PRINT "the map and turn RE-DRAW back on.  Similarly, hitting the END key will take"
PRINT "you back to the map center and will toggle off AUTO-CENTERING."
PRINT
PRINT
INPUT "Hit ENTER to continue..."; a$

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 (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 "Hit ENTER to proceed... OR hit H for more HELP"; a$
SCREEN 9
WIDTH 80, 43
PALETTE 6, 6

IF UCASE$(a$) = "H" THEN CALL HELP
CLS
PRINT
PRINT "The Digital Line Graph CD is divided into the following sectors."
PRINT
PRINT : PRINT "1 - ME,NH,VT,MA,RI,CT,NY", TAB(40); , "12 - AZ,NM"
PRINT : PRINT "2 - NJ,PA,OH,DE,MD,WV,VA", TAB(40); , "13 - Southern CA"
PRINT : PRINT "3 - NC,SC,GA", TAB(40); , "14 - Northern CA,NV,UT"
PRINT : PRINT "4 - Florida", TAB(40); , "15 - WA,OR,ID,Western MT"
PRINT : PRINT "5 - TN,AL,MS,AK,LA", TAB(40); , "16 - SE Alaska"
PRINT : PRINT "6 - KY,IN,IL,IA,MO", TAB(40); , "17 - Central Alaska"
PRINT : PRINT "7 - MI,WI,MN", TAB(40); , "18 - Northern Alaska"
PRINT : PRINT "8 - Southern TX", TAB(40); , "19 - SW Alaska"
PRINT : PRINT "9 - OK, Northern TX", TAB(40); , "20 - Aleutian Is."
PRINT : PRINT "10- KN,NB,CO", TAB(40); , "21 - Hawaiian Is."
PRINT : PRINT "11- ND,SD,WY MT(east of divide)"
PRINT
PRINT : INPUT "Enter your sector"; sect%
PRINT : 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
PRINT : INPUT "Enter a file name for results (.map) will be added "; mapf
PRINT : INPUT "Enter latitude of map center in degrees,minutes (DD,MM) "; lat0!, latm!
PRINT : 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 30 to 36 miles for anywhere East of the Mississippi.  Maybe 50 miles"
   PRINT "in the rural farm areas, and possibly 70 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."

PRINT : INPUT "Enter map radius in miles ", mradm!
PRINT : INPUT "Skip every other point in the Waterways and Borders (y/n) (Y)"; a$
IF UCASE$(a$) <> "N" THEN ALLpts% = 0 ELSE ALLpts% = -1
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 + (525! / (rady!))) 'had been 350/(2*rady)  I just made it 3X
ppdx! = INT(.5 + (960! / (radx!))) 'had been 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
REM SCREEN 9
REM WIDTH 80, 43
REM 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, 6)) 'had been 5
     PSET (x% * Hfac! / 3, y% / 3), clr%
     nrec& = nrec& + 1
  ELSE
     x% = VAL(stuff)
     y% = VAL(RIGHT$(stuff, 6)) 'had been 5
     LINE -(x% * Hfac! / 3, y% / 3), 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

