home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 24
/
CD_ASCQ_24_0995.iso
/
vrac
/
aprs72a.zip
/
NWSPARSE.BAS
< prev
next >
Wrap
BASIC Source File
|
1995-01-17
|
10KB
|
222 lines
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