REM Program DEFRAG.BAS
REM
REM This program takes the output of the mapfix program and shuffles the
REM line sequence so that adjoining line segments are placed in adjacent
REM positions and can be joined.

REM ************** MODIFICATION HISTORY ****************
REM  30AUG94  W7KKE  Distributed "pre-beta test" version with known
REM                  bugs due to interest expressed in 1:100,000 USGS
REM                  CD ROM maps.
REM  27OCT94  W7KKE  Added counter to track number of passes with no changes
REM                  so program would exit out of endless loop.
REM  20FEB95  WB4APR added error trap for pre-existence of SCRATCH files
REM                  and changed RENAME to COPY at end of file

mxln = 40 'Maximum number of line segments
mxpnt = 500 'Maximum number of x/y points (in any SINGLE line)

REM $DYNAMIC
DIM header$(10)
DIM line$(mxln)
DIM x(mxln, mxpnt) AS INTEGER
DIM y(mxln, mxpnt) AS INTEGER
DIM rx(mxpnt) AS INTEGER
DIM ry(mxpnt) AS INTEGER
DIM tempx(mxpnt) AS INTEGER
DIM tempy(mxpnt) AS INTEGER
DIM tempx2(mxpnt) AS INTEGER
DIM tempy2(mxpnt) AS INTEGER
DIM high(mxln) AS INTEGER
DIM x AS INTEGER
DIM y AS INTEGER
DIM i AS INTEGER
DIM k AS INTEGER

top:
'Zero the flags
changes = 0
pass = 0
eflag = 0
joined = 0 ' for debugging only

ON ERROR GOTO ErrorKill
KILL "scratch1.tmp"
KILL "scratch2.tmp"
ON ERROR GOTO 0


CLS
prompt:
   pass = 0
  REM  ON ERROR GOTO Errorfix
  'F$ = "livint.map"
  INPUT "Enter File name of source data"; F$
 
readit:
   k = 0
   IF pass > 0 THEN F$ = "scratch1.tmp"
   OPEN F$ FOR INPUT AS #3

   IF pass = 0 THEN
    'Fo$ = "temp.map"
    INPUT "Enter file name for output."; Fo$
     realfile$ = Fo$
     Fo$ = "scratch2.tmp"
   END IF
  
   OPEN Fo$ FOR OUTPUT AS #4

Loadit:
        FOR i = 1 TO 9 ' Get first 10 lines of map file which contain
                       ' the setup information.
          LINE INPUT #3, a$
          header$(i) = a$
       
        NEXT i
        
        'replace header line 8 with new comment
        header$(8) = "Map generated from USGS 1:100,000 CD ROM"

storehdr: 'Place the map header info in the output file.
        FOR i = 1 TO 9
          PRINT #4, header$(i)
        NEXT i
     
      k = k + 1        'Increment the line counter
collect: 'Collect line segments from the map file
   
     eflag = 0
     i = 0
       
        LINE INPUT #3, a$  'This is the first line label
        line$(k) = a$

     DO WHILE NOT EOF(3)
       INPUT #3, x, y   'Get the line segment x/y point
        i = i + 1

         IF x = 0 AND y = -1 THEN
              high(k) = i
              x(k, i) = x
              y(k, i) = y
              IF high(k) = 1 THEN STOP
              k = k + 1
              IF i > hiseg THEN hiseg = i
              i = 0
              eflag = 1
          END IF
       
          IF x = 0 AND y = 0 THEN
              high(k) = i
              x(k, i) = x
              y(k, i) = y
              k = k + 1
              IF i > hiseg THEN hiseg = i
              i = 0
            
             LINE INPUT #3, a$  'This is the line label for the next line
             'PRINT "reading "; a$
             line$(k) = a$
              
               IF k > 1 THEN
                  'Store the map color to join proper adjacent lines
                   mapclr1$ = LEFT$(line$(k - 1), 2)  'Store the previous line color
                   mapclr2$ = LEFT$(line$(k), 2)      'Store current line's color
               END IF
          END IF
      

        IF x(k - 1, high(k - 1)) <> 0 THEN STOP 'Shouldn't get here

dupes:
         'Check for duplicate points in same line segment
           IF i >= 2 AND high(k) > 2 THEN
              IF x(k, i - 1) = x AND y(k, i - 1) = y THEN
               'PRINT
               'PRINT x(k, i - 1), y(k, i - 1)
               'PRINT x, y
                 i = i - 1
                 PRINT "Suppressed duplicate data point in line"; k
                 changes = 1
              END IF
           END IF

join:
          'Store last point in previous line
              IF k > 1 AND i = 1 THEN
                z = k - 1
                w = high(z) - 1
                lastx = x(z, w)
                lasty = y(z, w)
              END IF

          'We join the lines if previous line's last x/y matches first x/y
           'of current segment and the line color code matches.
 
  IF k > 1 AND high(z) > 1 AND i = 1 AND x = lastx AND y = lasty AND mapclr1$ = mapclr2$ THEN

               'Following is so we can see if segments are joining properly.
               IF lastx = 0 AND lasty = 0 AND x = 0 AND y = 0 THEN STOP

               PRINT "joining adjacent map segments"
               k = k - 1 'Backup the line counter
               i = i + high(k)' keep incrementing based on previous high line
               i = i - 1  ' Backup the counter to write over the zero,zero
               changes = 1
               joined = 1 'for debugging
        IF x(k, high(k)) <> 0 THEN STOP
               
  END IF
                x(k, i) = x
                y(k, i) = y

              'Following for debugging only
              'IF joined = 1 THEN
                 'PRINT x(k, i - 1), y(k, i - 1)
                 'PRINT x(k, i), y(k, i)
                 'joined = 0
              'END IF

presson:
           
         IF k < mxln - 1 AND eflag = 0 THEN GOTO lopit ELSE GOTO FILTER
      IF eflag = 1 THEN GOTO FILTER

lopit:
      LOOP
      i = 0
       
    IF high(k) = 1 THEN k = k - 1: STOP: GOTO dupes ' get rid of garbage lines
                                                    'shouldn't get here.
FILTER:
      maxk = k - 1
     

nearby:

     'Check if any other nearby map segments first x,y are same as last x,y
     'in this segment so they can be joined
     'If first x/y of next segment is same as last x/y of previous segement,
     'there is no problem.

     PRINT "Testing for nearby ajoining map segments"
   
        FOR kt = 1 TO maxk - 2
           lastx = x(kt, high(kt) - 1)
           lasty = y(kt, high(kt) - 1)
       
         FOR kt1 = (kt + 2) TO maxk - 1
           tstx = x(kt1, 1)
           tsty = y(kt1, 1)
     
          IF lastx = tstx AND lasty = tsty THEN
             PRINT "swapping line"; kt + 1; "with line"; kt1
             IF tstx = 0 AND tsty = 0 THEN STOP
             
        
          'Swap the line segments in the array
          'first, store the next line
            temp1$ = line$(kt + 1)
            thigh = high(kt + 1)
            FOR i = 1 TO high(kt + 1)
              tempx(i) = x(kt + 1, i)
              tempy(i) = y(kt + 1, i)
            NEXT i
           IF tempx(thigh) <> 0 THEN STOP

          'next, store the line to be advanced
            temp2$ = line$(kt1)
            thigh2 = high(kt1)
            FOR i = 1 TO high(kt1)
              tempx2(i) = x(kt1, i)
              tempy2(i) = y(kt1, i)
            NEXT i
            IF tempx2(thigh2) <> 0 THEN STOP

          'place the advanced line in the second array
            line$(kt + 1) = temp2$
            high(kt + 1) = thigh2
            IF high(kt + 1) = 1 THEN STOP
            FOR i = 1 TO high(kt + 1)
              x(kt + 1, i) = tempx2(i)
              y(kt + 1, i) = tempy2(i)
            NEXT i
              IF x(kt + 1, high(kt + 1)) <> 0 THEN STOP

          'place the old second array in the vacated advanced array
            line$(kt1) = temp1$
            high(kt1) = thigh
            IF high(kt1) = 1 THEN STOP
            FOR i = 1 TO high(kt1)
              x(kt1, i) = tempx(i)
              y(kt1, i) = tempy(i)
            NEXT i
            IF x(kt1, high(kt1)) > 0 THEN STOP
          END IF
       NEXT kt1
     NEXT kt

IF pass < 3 THEN GOTO fileit

TOPTOP:
   
      'Check to see if sequence is reversed when comparing first segment
      'to first segment
      PRINT "Checking for reverse sequence - first to first"
        FOR kt = 1 TO maxk - 2
         firstx = x(kt, 1)
         firsty = y(kt, 1)
    
        FOR kt1 = (kt + 1) TO maxk - 1
           tstx = x(kt1, 1)
           tsty = y(kt1, 1)
   
        IF firstx = tstx AND firsty = tsty THEN
           PRINT "reversing line (top to top)"; kt
             IF tstx = 0 AND tsty = 0 THEN STOP
             

          'reverse the line segments in the array
          'the new corrected sequence will be picked up on the next pass
          'first, store the original line
           
            FOR i = 1 TO high(kt)
              tempx(i) = x(kt, i)
              tempy(i) = y(kt, i)
            NEXT i
      
          'now store the points in reverse order
            FOR i = 1 TO high(kt)
              x(kt, i) = tempx(high(kt) - i)
              y(kt, i) = tempy(high(kt) - i)
            NEXT i
         END IF
         NEXT kt1
       NEXT kt

IF pass < 6 THEN GOTO fileit

lastlast:

      'Check to see if sequence is reversed when comparing last segment
      'to last segment
      PRINT "Checking for reverse sequence - last to last"
        FOR kt = 1 TO maxk - 2
         lastx = x(kt, high(kt) - 1)
         lasty = y(kt, high(kt) - 1)
      
        FOR kt1 = (kt + 1) TO maxk - 1
           tstx = x(kt1, high(kt1) - 1)
           tsty = y(kt1, high(kt1) - 1)

        IF lastx = tstx AND lasty = tsty THEN
           PRINT "reversing line"; kt1
             
             IF tstx = 0 AND tsty = 0 THEN STOP

          'reverse the line segments in the array
          'the new corrected sequence will be picked up on the next pass
          'first, store the original line
            FOR i = 1 TO high(kt1)
              tempx(i) = x(kt1, i)
              tempy(i) = y(kt1, i)
            NEXT i
        
          'now store the points in reverse order
            FOR i = 1 TO high(kt1)
              x(kt1, i) = tempx(high(kt1) - i)
              y(kt1, i) = tempy(high(kt1) - i)
            NEXT i
           IF x(kt1, high(kt1)) <> 0 THEN STOP
         END IF
        NEXT kt1
       NEXT kt

IF pass < 9 THEN GOTO fileit

toplast:
          'Compare top figure of first pair with last of other pairs.
          'Reverse the top pair if match found.
     
      PRINT "Checking for reverse sequence - top to last"
        FOR kt = 1 TO maxk - 2
         firstx = x(kt, 1)
         firsty = y(kt, 1)
      
        FOR kt1 = (kt + 1) TO maxk - 1
           tstx = x(kt1, high(kt1) - 1)
           tsty = y(kt1, high(kt1) - 1)

        IF firstx = tstx AND firsty = tsty THEN
           PRINT "reversing line"; kt
             IF tstx = 0 AND tsty = 0 THEN STOP

          'reverse the line segments in the first array.
          'the new corrected sequence will be picked up on the next pass.
          'first, store the original line.
            FOR i = 1 TO high(kt)
              tempx(i) = x(kt, i)
              tempy(i) = y(kt, i)
            NEXT i
        
          'now store the points in reverse order
            FOR i = 1 TO high(kt)
              x(kt, i) = tempx(high(kt) - i)
              y(kt, i) = tempy(high(kt) - i)
            NEXT i
           IF x(kt, high(kt)) <> 0 THEN STOP
          END IF
          NEXT kt1
       NEXT kt

fileit:
      maxnum = maxnum + k
      IF EOF(3) THEN
        PRINT
        PRINT "Number of line segments = "; maxnum
        PRINT "Highest number of points per line = "; hiseg
        hiseg = 0' zero so counter will be valid after next pass
      END IF

    'Print the revised array to the file
    PRINT
    PRINT "Printing revised array to disk"
     FOR i = 1 TO maxk
         
        'Corrects problem with missing line due to the sequence of reading
        'data.
        IF i = 1 AND LEN(line$(1)) < 9 THEN
           ' for debugging, show the original line
           ' PRINT "bad "; line$(1)
           ' FOR x = 1 TO high(1)
           ' PRINT "original "; x(1, x), y(1, x)
           ' NEXT x

            'shift data points down one to make room at top for data which
            'was sucked into line$
           
            FOR x = high(1) TO 1 STEP -1
                x(1, x + 1) = x(1, x)
                y(1, x + 1) = y(1, x)
            NEXT x
            'bump the counter for this line by one
            high(1) = high(1) + 1

            'put an end of segment marker for this segment
            x(1, high(1)) = 0
            y(1, high(1)) = 0
           
            'retrieve the line segment data which was in the header line
            a = INSTR(line$(1), ",")
            b = LEN(line$(1))
            x(1, 1) = VAL(LEFT$(line$(1), a - 1))
            y(1, 1) = VAL(RIGHT$(line$(1), b - a))
            line$(1) = lost$
            lflag = 0'Reset the "lost" flag so it can pick up lost lable again
        
         'Following for debugging this routine
           ' PRINT "Fixing "; line$(1)
           ' FOR x = 1 TO high(1)
           '   PRINT "fixing "; x(1, x), y(1, x)
           ' NEXT x
        END IF

        IF k = mxln - 1 AND lflag = 0 THEN lost$ = a$: lflag = 1
        PRINT #4, line$(i)
        FOR ii = 1 TO high(i)
           WRITE #4, x(i, ii), y(i, ii)
        NEXT ii
       IF high(i) > hiseg THEN hiseg = high(i)
     NEXT i
    k = 1 'reset the line segment counter
   IF eflag = 1 THEN GOTO endit
    
    GOTO collect 'go back to the start and run through the filter again.
                 'Only gets here when end of file not yet reached.

endit:
       IF changes = 1 THEN  'Keep looping through the filter until there
                            'are no more changes (i.e. changes = 0).
           pass = pass + 1  'Increment the pass counter
           PRINT
           PRINT "Starting pass"; pass + 1
           CLOSE
           maxnum = 0
           'swap the temporary files and kill the old one
           IF pass > 1 THEN KILL "scratch1.tmp"
           NAME "scratch2.tmp" AS "scratch1.tmp"
           changes = 0 'Zero the changes flag
           GOTO readit
       END IF
      
       IF changes = 0 THEN
        CLOSE
         SHELL "copy scratch1.tmp " + realfile$
       END IF

 PRINT
 PRINT
 PRINT "WARNING, DEFRAG does NOT transfer map labels!"
 PRINT
 PRINT "Usually not a problem during map building from source CD data, but"
 PRINT "if you are using DEFRAG on an EXISTING mapfile with LABELS, you will"
 PRINT "have to separately use a DOS editor to move the LABELS to the new file!"
 PRINT
 PRINT

 INPUT "Filter another map"; a$
 IF UCASE$(a$) = "Y" THEN GOTO top
 SYSTEM


ErrorKill:
 BEEP
 IF ERR = 53 THEN RESUME NEXT
 ON ERROR GOTO 0
 RESUME

 END

