Init: 'First set up the constants
      DTG$ = "131218z"'a test time
      Period = 30'seconds (real world should be 30 or more)
      MaxNum = 18 'Max number of OBJects (max of 18 or screen scrolls!)
                  'Make this smaller to limit the QRM you are transmitting
                  'and accumulating on everyone's screen!
      UNvia$ = "APRS VIA WIDE"
      MyPOS$ = "!0000.00N/00000.00W!Automatic NWS bulletin Parser"
               REM Put your POSIT in this string so that U show on the map!
      DIM P$(MaxNum + 1)'Make room for MaxNum different objects
      DIM Count(MaxNum + 1)

CLS : PRINT "                           APRS NWS PARSER": PRINT
PRINT "This program will parse incomming NWS bulletins on COM1 and output APRS"
PRINT "OBJECTS and BULLETINS via a TNC connected to COM2. (or also COM1 !)"
PRINT ""
PRINT "The overall objective is to convert all available information on a tropical"
PRINT "storm into a plottable APRS storm object, and all of its forcast  future "
PRINT "positions.  So far, the following syntax is parsed, where ... is any length,"
PRINT "and ___ means exact spaces.  Lower case are data fields extracted:"
REM    Programmers, please keep this list updated as you add more parsing!
PRINT
PRINT "... NNNN                             (indicates start of a new message"
PRINT "... xxxxZ .... dd_1995               (message date/time. Change this in 96..."
PRINT "... TROPICAL STORM_name.... ADVISORY NUMBER"
PRINT "... TROPICAL STORM .... LOCATED NEAR__lattN_longW"
PRINT "... CENTRAL PRESSURE_pres"
PRINT "... MOVEMENT TOWARD .....xxx_DEGREES.... xx_KT"
PRINT "... FORCAST VALID_datetime_lattN_longW"
PRINT "... OUTLOOK VALID_datetime_lattN_longW"
PRINT "... MAX SUSTAINED... xx_KT_comments"
PRINT "... MAX WINDS... xx_KT_comments"; ""
PRINT
PRINT "Enter the period between packets ("; Period; ")"; : INPUT a$
       IF a$ <> "" THEN Period = VAL(a$)
CLS
PRINT "This is just a beginning of this capability.  I am making this program"
PRINT "available as source code, so that others can add additional NWS parsing."
PRINT "You will need to manually modify portions of the code to match your needs."
PRINT
PRINT "Since the program only listens to incomming messages and only outputs packets"
PRINT "to a TNC, a single COM port can be used for both functions!  Just connect the"
PRINT "incomming data to the COM1 RXD, and the TNC to TXD.  Be sure the TNC is at"
PRINT "9600 baud (or whatever you have in this program).  The program will set the"
PRINT "TNC to CONV mode so that it will transmit all packets over the air."
PRINT
PRINT "Other programmers, add instructions here..."
PRINT
PRINT "As distributed, this program has a TEST line in the GETMORE subroutine at"
PRINT "the end of the program, to simulate serial data input.  To begin parsing"
PRINT "REAL serial data, simply REM out that statement."
PRINT
 OPEN "COM1:9600,N,8,1,CD0,CS0,DS0" FOR RANDOM AS #1  'For NWS messages
PRINT "Enter UNPROTO path to be used by TNC ("; UNvia$; ")"; : INPUT a$
       IF a$ <> "" THEN UNvia$ = a$

 REM   OPEN "COM2:9600,N,8,1,CD0,CS0,DS0" FOR RANDOM AS #2 'For TNC output
 REM to use separate COM ports for input and output, remove the REM in the
 REM above line to activate COM2, and scan the program for "OUTPORT" and
 REM change the port numbers there to #2....

InitTNC: T = TIMER: PRINT #1, CHR$(3); CHR$(3); CHR$(3);
         DO UNTIL TIMER - T > 1: LOOP
         PRINT #1, "UNPROTO "; UNvia$; CHR$(13);
         DO UNTIL TIMER - T > 2: LOOP
         PRINT #1, "CONV"; CHR$(13);
CLS
PRINT "The following is a list of the packets currently in the transmit queue."
PRINT "The number indicates how many more times the particular packet will be sent."
PRINT
PRINT "NUM OBJECT   DA-TIME LAT      LONG      CSE SPD COMMENTS.... "
PRINT "--- -------- ------- -------- ---------$--- --- -------------"
Main: REM Scan the text comming in COM1 forever, and each time you see a key
      REM word, try to build a position report out of it.  Once a complete
      REM position report or object report is put together, add it to the
      REM P$() array.  Then send out these OBJECTS from the P$() array at
      REM regular intervals.  Decrement the COUNT() counter, and stop sending
      REM when the COUNT for each object gets to 0.
      REM TO TEST THIS THING, PUT THINGS IN a$ in the GETMORE subroutine
  DO
     GOSUB Getmore 'Get next line of message from serial port #1
     LOCATE 25, 1: PRINT "Parsing: "; LEFT$(a$ + SPACE$(70), 70);
     a = INSTR(a$, "NNNN"): IF a > 0 THEN GOSUB BeginNEW
     a = INSTR(a$, "1995"): IF a > 0 THEN GOSUB GetDate
     a = INSTR(a$, "TROPICAL STORM"): IF a > 0 THEN GOSUB Tropical
     a = INSTR(a$, "MOVEMENT TOWARD"): IF a > 0 THEN GOSUB Movement
     a = INSTR(a$, "CENTRAL PRESSURE"): IF a > 0 THEN GOSUB Pressure
     a = INSTR(a$, "MAX SUSTAINED"): IF a > 0 THEN GOSUB Winds
     a = INSTR(a$, "FORECAST VALID"): IF a > 0 THEN GOSUB Forecast
     a = INSTR(a$, "MAX WIND"): IF a > 0 THEN GOSUB Winds
     a = INSTR(a$, "OUTLOOK VALID"): IF a > 0 THEN GOSUB Forecast
     IF Pos$ <> "" AND CSpd$ <> "" AND Cmts$ <> "" THEN GOSUB BuildPOS
     IF TIMER - LastPkt > Period THEN GOSUB SendNext
     IF TIMER - LastPOS > 600 THEN GOSUB SendMyPos
     LOCATE 4, 68: PRINT "ToGo:"; Period - INT(TIMER - LastPkt);
  LOOP
  END
'********************** SUBROUTINES FOLLOW ***************************

BeginNEW: REM Clear everything to get ready for new message
          Pos$ = "": CSpd$ = "": Name$ = ""
          TropStrm = 0
          RETURN

GetDate:  DTG$ = "******/": IF a > 3 THEN Day$ = MID$(a$, a - 3, 2)
          b = INSTR(a$, "Z"): IF b > 4 THEN DTG$ = Day$ + MID$(a$, b - 4, 5)
          RETURN


Tropical: sym$ = "@": REM symbol for a Hurricane
          b = INSTR(a$, "ADVISORY NUMBER")
          IF b > 0 THEN  ' Get the storm NAME
             Num$ = MID$(a$, b + 17)
             c = INSTR(a + 18, a$, " ")' Find ending space of name
             Name$ = MID$(a$, a + 16, c - 16) + Num$
             Name$ = LEFT$(Name$ + "         ", 9)
          END IF
          b = INSTR(a$, "LOCATED NEAR") ' Get the POSIT
          IF b > 0 THEN L = b + 13: T = 0: TropStrm = 1: GOSUB ParsePos
          RETURN

ParsePos: REM Parse out LAT/LONG beginning at location L and TIME at T
          REM also find TIME if after L
    LAT = VAL(MID$(a$, L, 4)): LATd = INT(LAT): LATm = LAT - LATd
    LON = VAL(MID$(a$, L + 6, 5)): LONd = INT(LON): LONm = LON - LONd
    LAT$ = MID$(STR$(LATd), 2, 2) + MID$(STR$(INT(LATm * 60)), 2, 2) + ".00N"
    LON$ = "0" + MID$(STR$(LONd), 2, 2) + RIGHT$("0" + MID$(STR$(INT(LONm * 60)), 2), 2) + ".00W"
    c = INSTR(a$, " AT "): IF c > L THEN T = c + 4
    IF T > 0 THEN TIM$ = MID$(a$, T, 2) + MID$(a$, T + 3, 5) ELSE TIM$ = "******/"
    Pos$ = LAT$ + "/" + LON$ + sym$
    RETURN

Pressure: Pres$ = "/" + MID$(a$, a + 17, 4) + "mb "
          RETURN

Movement: b = INSTR(a$, "DEGREES")  'Get the direction
          IF b > 4 THEN CSpd$ = MID$(a$, b - 4, 3)
          c = INSTR(a$, " KT")
          IF c > b + 10 THEN CSpd$ = CSpd$ + MID$(a$, c - 3, 3)
          RETURN

Winds:    b = INSTR(a$, " KT")
          IF b > 4 THEN Cmts$ = Pres$ + MID$(a$, b - 4)
          RETURN

Forecast: b = INSTR(a$, "Z")
          IF b > 20 AND TropStrm THEN
             L = b + 2: T = b - 7: GOSUB ParsePos
             Name$ = MID$(a$, T, 8) + " "' Use the Forecast TIME as the NAME
             CSpd$ = "MaxWind "
             TIM$ = DTG$' Insert Date/Time of the message
          END IF
          RETURN


BuildPOS: REM Assemble the pieces into a complete OBJECT report and
          REM add this completed POSIT to the PACKET array for transmission
   P$ = LEFT$(Name$ + "*" + TIM$ + Pos$ + CSpd$ + Cmts$, 72)
   
   Dupe = 0: REM First check to see if the posit is already in the queue
   FOR i = 1 TO NumP
       IF P$(i) = P$ THEN Dupe = 1
   NEXT i
   IF Dupe = 0 THEN
      IF NumP < MaxNum THEN
         NumP = NumP + 1
      ELSE
         FOR i = 1 TO NumP   ' Throw away oldest one...
             P$(i) = P$(i + 1): Count(i) = Count(i + 1)
         NEXT
      END IF
      
      P$(NumP) = P$
      Count(NumP) = 10 ' initialize to number of times to xmt
   END IF
   Pos$ = "": CSpd$ = "": Cmts$ = "": REM Clear out the data
   RETURN

SendNext: REM send the next available packet
   NxtP = NxtP + 1: IF NxtP > NumP THEN NxtP = 1
   PRINT #1, P$(NxtP) 'OUTPORT. Set to #2 if two ports used...
   REM PRINT P$(NxtP)
   Count(NxtP) = Count(NxtP) - 1
   IF Count(NxtP) < 1 THEN 'remove this item from the list
      FOR i = NxtP TO NumP
          P$(i) = P$(i + 1)
          Count(i) = Count(i + 1)
      NEXT i
   END IF
   LastPkt = TIMER: SOUND 3000, 3
   LOCATE 6, 1
   FOR i = 1 TO MaxNum
       PRINT Count(i); TAB(5); LEFT$(P$(i) + SPACE$(79), 74)
   NEXT i
   RETURN
 
Pause: LOCATE 25, 1: PRINT "Hit ENTER to continue...";
       INPUT a$
       RETURN

SendMyPos: PRINT #1, MyPOS$; CHR$(13); 'OUTPORT. Set to #2 if two ports used
           LastPOS = TIMER
           RETURN

Getmore: Tsec = 1
         j = 1: a = 0: Strtime = TIMER
   
    TEST$ = "FORECAST VALID 19/0600Z 17.6N  51.9W": sym$ = "@": Cmts$ = "comments!"
    a$ = TEST$: TropStrm = 1: RETURN  '******* REM OUT THIS LINE for REAL DATA

    DO WHILE j > 0 AND a = 0
       IF ABS(TIMER - Strtime) >= Tsec THEN j = 0: a$ = Astr$: Astr$ = "": EXIT DO
       a = INSTR(Astr$, CHR$(13))
       IF a > 0 THEN a$ = LEFT$(Astr$, a - 1): Astr$ = MID$(Astr$, a + 1): EXIT DO
       IF LOC(1) > 0 THEN Astr$ = Astr$ + INPUT$(LOC(1), 1)
       LOOP
    WHILE LEFT$(a$, 1) < " " AND LEN(a$) > 0
       LET a$ = MID$(a$, 2)
       WEND
    RETURN

