'-----------------------------------------------------------
'Declare subroutines
'-----------------------------------------------------------
'The output process is a subroutine in which the byte values are calculated
'and sent to the proper position in the right file.'
DECLARE SUB outproc (profilenum!, pointnum!, pointval$)  'outputs to FTDs

'The procedure used to build the bigstring$
DECLARE SUB buildbig (filenum!)  'creates the profile from one DEM
'-----------------------------------------------------------
'Establish contants for point separation to find the closest
'DEM profiles and points to the FTD 500m points
'-----------------------------------------------------------
CONST horpointsep = 500 / (87000 / 1200)    'Horizontal separation is
                                            ' 87 km seen in 1200 points
                                            ' 72.5 meters between points
                                            ' 6.89655 points per 500 meters
CONST vertpointsep = 500 / (111000 / 1200)  'Vertical separation is
                                            ' 111 km seen in 1200 points
                                            ' 92.5 meters between points
                                            ' 5.40540 points per 500 meters
'----------------------------------------------------------------------
'Hardcode the FTD file names numbered 1-12 from lower left, up,
'then to the right.

DIM SHARED ftd$(1 TO 12)

LET ftd$(1) = "d:\T_01_02.FTD" 'Lower Left
LET ftd$(2) = "d:\T_01_01.FTD"
LET ftd$(3) = "d:\T_01000.FTD"
LET ftd$(4) = "d:\T_01001.FTD" 'Top Left

LET ftd$(5) = "d:\T000_02.FTD" 'Lower Center
LET ftd$(6) = "d:\T000_01.FTD"
LET ftd$(7) = "d:\T000000.FTD"
LET ftd$(8) = "d:\T000001.FTD" 'Top Center

LET ftd$(9) = "d:\T001_02.FTD" 'Lower Right
LET ftd$(10) = "d:\T001_01.FTD"
LET ftd$(11) = "d:\T001000.FTD"
LET ftd$(12) = "d:\T001001.FTD" 'Top Right

'Build the .FTD header with this string and 90 0-value bytes
'The length of this string is 128 bytes, so our terrain data
'byte pairs start at byte position 129

LET ostring$ = "FST Terrain Data V01. SIZE=100 GAP=500"
FOR idx = 1 TO 90
ostring$ = ostring$ + CHR$(0)
NEXT idx

'Open the files and output the headers to each
'Do this for all 12 .FTD files
FOR num = 1 TO 12
LET fin = 50 + num
OPEN ftd$(num) FOR BINARY AS #fin
PUT #fin, 1, ostring$
CLOSE
NEXT num

'open the first four FTD files
FOR idx = 1 TO 4
   OPEN ftd$(idx) FOR BINARY AS (50 + idx)
NEXT idx

LET middleftd$ = "F"
LET rightftd$ = "F"

'----------------------------------------------------------------------
'Open all four DEM files and read the Type-A record
'This prepares the files for input as the Type-A records are not used
'and reading the files at this point places the file pointers where
'they need to be.

DIM SHARED profilesample AS STRING 'shared variable name for reading DEMs

OPEN "c:\fst\dad\pueblo-w.dem" FOR INPUT AS #1
INPUT #1, profilesample
OPEN "c:\fst\dad\denver-w.dem" FOR INPUT AS #2
INPUT #2, profilesample
OPEN "c:\fst\dad\pueblo-e.dem" FOR INPUT AS #3
INPUT #3, profilesample
OPEN "c:\fst\dad\denver-e.dem" FOR INPUT AS #4
INPUT #4, profilesample

LET demfileset = 1      'for opening and closing the DEM files

'-----------------------------------------------------------
'The variable bigstring is used to collect all the points of a profile
'from a single DEM for processing.

DIM SHARED bigstring$

'-------------------------------------------------------------------------
'Initialize the profile processing variables

LET profilebase = 1     'for calculating the profile to process
LET profiletoprocess = profilebase
LET profilesprocessed = 0

DO WHILE profilesprocessed < 300
   
   INPUT #demfileset, profilesample

   IF VAL(LTRIM$(MID$(profilesample, 4, 4))) > 1200 THEN
      CLOSE #1: CLOSE #2
      LET profilebase = 1
      LET profiletoprocess = profilebase
      LET demfileset = demfileset + 2
      INPUT #demfileset, profilesample
   END IF

   IF VAL(LTRIM$(MID$(profilesample, 4, 4))) <> profiletoprocess THEN
     
      INPUT #demfileset + 1, profilesample
      FOR lridx = 1 TO 7
      INPUT #demfileset, profilesample
      INPUT #demfileset + 1, profilesample
      NEXT lridx

   ELSE                               'process the points on a profile
      LET profilesprocessed = profilesprocessed + 1
      PRINT "Processing DEM Set ", demfileset, "Profile ", profilesprocessed
     
      CALL buildbig(demfileset)       'build bigstring$
     
      LET pointsprocessed = 0  'reset the number of points processed
      LET pointctr = 1  'reset the point counter
      LET pointbase = 1  'reset the point base
      LET pointtoprocess = pointbase   'start with point one.
      LET pointvalue$ = LEFT$(bigstring$, 6)
     
      DO WHILE LEN(MID$(bigstring$, (pointctr * 6))) > 6
         IF pointctr = pointtoprocess THEN
            LET pointsprocessed = pointsprocessed + 1
            CALL outproc(profilesprocessed, pointsprocessed, pointvalue$)
            LET pointbase = pointbase + vertpointsep 'These two lines
            LET pointtoprocess = INT(pointbase)  'caluclate the next point
         END IF
        
         LET pointctr = pointctr + 1 'increment point counter/pointer
         LET pointvalue$ = MID$(bigstring$, (pointctr * 6), 6) 'pick point
      LOOP
        
      INPUT #demfileset + 1, profilesample
      CALL buildbig(demfileset + 1)

      LET pointctr = 0
      LET pointbase = pointbase - 1200 'starting in a new DEM
      LET pointtoprocess = pointtoprocess - 1200

      DO 'until pointsprocessed = 400
         LET pointctr = pointctr + 1
         LET pointvalue$ = MID$(bigstring$, (pointctr * 6), 6)
         IF pointctr = pointtoprocess THEN
            LET pointsprocessed = pointsprocessed + 1
            CALL outproc(profilesprocessed, pointsprocessed, pointvalue$)
            LET pointbase = pointbase + vertpointsep
            LET pointtoprocess = INT(pointbase)
         END IF

      LOOP UNTIL pointsprocessed = 400
      LET profilebase = profilebase + horpointsep
      LET profiletoprocess = INT(profilebase)
   END IF
  
   IF ((profilesprocessed = 100) AND (middleftd$ = "F")) THEN
      'switch to middle FTDs
      PRINT "Middle FTDs"
      LET middleftd$ = ""
      FOR idx = 1 TO 4
      CLOSE #(50 + idx)
      NEXT idx
     
      FOR idx = 5 TO 8
      OPEN ftd$(idx) FOR BINARY AS (50 + idx)
      NEXT idx
      CLS
   END IF

   IF ((profilesprocessed = 200) AND (rightftd$ = "F")) THEN
      'switch to right FTDs
      PRINT "Right FTDs"
      LET rightftd$ = ""
      FOR idx = 5 TO 8
      CLOSE #(50 + idx)
      NEXT idx
     
      FOR idx = 9 TO 12
      OPEN ftd$(idx) FOR BINARY AS (50 + idx)
      NEXT idx
      CLS
   END IF
LOOP
CLOSE

SUB buildbig (filenum)

   LET bigstring$ = MID$(profilesample, 142, LEN(profilesample)) + "  "
   FOR lridx = 1 TO 7    'process filenum
   INPUT #filenum, profilesample
   LET bigstring$ = bigstring$ + profilesample + "  "
   NEXT lridx

END SUB

SUB outproc (profilenum, pointnum, pointval$)
'profilenum is between 1 and 300
'pointnum is between 1 and 400
'pointval$ is the string of elevation data from the DEM
'
IF ((profilenum > 300) OR (pointnum > 400)) THEN STOP
LET filenum = 51

'determine the filenumber for the output by first calculating the base

IF profilenum > 100 THEN filenum = filenum + 4
IF profilenum > 200 THEN filenum = filenum + 4

'now calculate the actual file number
IF pointnum > 100 THEN filenum = filenum + 1
IF pointnum > 200 THEN filenum = filenum + 1
IF pointnum > 300 THEN filenum = filenum + 1

'calculate the byte location in the file for the output of the two bytes
LET location = 0
LET locoffset = 0
LET locbase = 0

LET locbase = pointnum
IF locbase > 300 THEN locbase = locbase - 100
IF locbase > 200 THEN locbase = locbase - 100
IF locbase > 100 THEN locbase = locbase - 100

LET locoffset = profilenum
IF locoffset > 200 THEN locoffset = locoffset - 100
IF locoffset > 100 THEN locoffset = locoffset - 100

LET location = 128 + (((locbase - 1) * 200) + (locoffset * 2)) - 1

'determine the two byte values for the elevation
LET pointval = VAL(pointval$)
LET byteone = pointval MOD 256
LET bytetwo = INT(pointval / 256)

LET outbytes$ = CHR$(byteone) + CHR$(bytetwo)
PUT #filenum, location, outbytes$
filenum = 0

END SUB

