(* gcc -o sondemod Lib.o aprspos.o aprsstr.o filesize.o flush.o geodesy.o gps.o gpspos.o libsrtm.o navigation.o osi.o ptty.o rinex.o sem.o sondeaprs.o sondemod.o soundctl.o symlink.o tcp.o time_conversion.o timec.o udp.o yuma.o /usr/local/xds/lib/x86/libts.a /usr/local/xds/lib/x86/libxds.a -lm -lrt *) <*+M2EXTENSIONS *> <*-CHECKDIV *> <*-CHECKRANGE *> <*-COVERFLOW *> <*-IOVERFLOW*> <*+NOPTRALIAS*> <*CPU="PENTIUM"*> <*-DOREORDER *> <*-PROCINLINE*> <* IF __GEN_C__ THEN *> <*-GENCTYPES*> <*+COMMENT*> <*-GENHISTORY*> <*-GENDEBUG*> <*-GENDATE*> <*-LINENO*> <*-CHECKINDEX*> <*+GENCDIV*> <*-CHECKNIL *> <*-CHECKSET*> <*-GENKRC*> <*+NOOPTIMIZE*> <*-GENSIZE*> <*-ASSERT*> <* ELSE *> <*+GENHISTORY*> <*+GENDEBUG*> <*+LINENO*> <*+CHECKINDEX*> <*+CHECKNIL *> <*-CHECKSET*> <* END *> <*NEW WITHSOUND*> <*-WITHSOUND*> MODULE sondemod; (* decode RS92, RS41, SRS-C34, DFM, M10, iMET Radiosonde by OE5DXL *) IMPORT soundctl, udp; <* IF WITHSOUND THEN *> FROM fcntl IMPORT creat, open; <* END *> FROM osi IMPORT WrLn, WrStr, WrStrLn, WrInt, WrHex, Close, RdBin, WrBin, WrFixed, OpenRW, openudp, OpenRead, OpenWrite, File, time, pi, ALLOCATE, DEALLOCATE, NextArg, usleep, realcard, WrCard; FROM math IMPORT log, atan, exp, sqrt, sin, cos; FROM aprsstr IMPORT StrToCard, StrToInt, TimeToStr, Append, Assign, DateToStr, Length, IPNUM, UDPPORT, ipv4tostr, StrCmp, IntToStr, CardToStr, loctopos, StrToFix, Delstr, FixToStr, StrToTime; FROM SYSTEM IMPORT ADR, INT8, INT16, CARD16, CAST, SHIFT, CARD8, ADDRESS, FILL; FROM gpspos IMPORT readalmanach, getposit, SATS, SAT; FROM sondeaprs IMPORT senddata, GetIp, sendmon, udpsock, pUDPDESTS, axudpdests, via, beacontimes, verb, verb2, nofilter, commentfn, dao, VERSION, csvfilename, SDRBLOCK, json, jsondests, XDATA, mypos, myalt, maxsenddistance, expire, minusP, minusE , minusG, minusa, rectfence, LASTSECONDS, BEFOREBURST, SATSIG, pSATSIG; FROM libsrtm IMPORT srtmdir; FROM aprspos IMPORT posvalid; FROM signal IMPORT signal, SIGPIPE; TYPE TIME=CARDINAL; CONST CONTEXTLIFE=3600; (* seconds till forget context after last heared *) DAYSEC=60*60*24; GPSTIMECORR=18; (* leap seconds *) ADCBUFLEN=4096; BAUDSAMP=65536; PLLSHIFT=BAUDSAMP DIV 64; AFIRLEN=512; AOVERSAMP=16; (*16*) ASYNBITS=10; CALIBFRAME=CHR(65H); GPSFRAME=CHR(67H); AUXILLARY=CHR(68H); DATAFRAME=CHR(69H); EMPTYAUX=CHR(3); PI=3.1415926535897932384626433832795; RAD=PI/180; EARTH=6370.0; MYLAT=48.0*RAD; (* only for show sat elevations if no pos decode *) MYLONG=13.0*RAD; NEWALMAGE=30; (* every s reread almanach *) FASTALM=4; (* reread almanach if old *) DEFAULTSUBTYP=255; (* dfm subtype wild card *) TYPE SET8=SET OF [0..7]; SET16=SET OF [0..15]; SET32=SET OF [0..31]; SET51=SET OF [0..50]; FILENAME=ARRAY[0..1023] OF CHAR; ADCWORD=INT16; OBJNAME=ARRAY[0..8] OF CHAR; CALLSSID=ARRAY[0..10] OF CHAR; CHANNELS=(LEFT, RIGHT); <* IF WITHSOUND THEN *> AFIRTAB=ARRAY[0..AFIRLEN*AOVERSAMP-1] OF REAL; <* END *> CHAN=RECORD <* IF WITHSOUND THEN *> adcmax : INTEGER; afir : ARRAY[0..AFIRLEN-1] OF REAL; configequalizer : INTEGER; baudfine, pllshift, manchestd : INTEGER; tcnt: REAL; noise : REAL; sqmed : ARRAY[FALSE..TRUE] OF REAL; fin : CARDINAL; cbit, oldd, plld, data1, lastmanch : BOOLEAN; <* END *> rxbyte, rxbitc, rxp : CARDINAL; rxbuf : ARRAY[0..520-1+40] OF CHAR; <* IF WITHSOUND THEN *> afirtab : AFIRTAB; asynst : ARRAY[0..ASYNBITS-1] OF INTEGER; <* END *> END; DFNAMES=RECORD start:CARD8; dat:ARRAY[0..1] OF CARD16; cnt:ARRAY[0..1] OF CARD8; errcnt:CARD8; END; CONTEXTR9=RECORD calibdata : ARRAY[0..511] OF CHAR; calibok : SET32; mesok, posok, framesent : BOOLEAN; lat, long, heig, speed, dir, climb, lastlat, laslong, lastalt, lastspeed, lastdir, lastclb : LONGREAL; hrmsc, vrmsc : REAL; hp, hyg, temp:LONGREAL; ozontemp, ozon:LONGREAL; goodsats, timems, framenum : CARDINAL; END; pCONTEXTC34=POINTER TO CONTEXTC34; CONTEXTC34=RECORD next : pCONTEXTC34; name : OBJNAME; clmb, lat, lon, lat1, lon1, latv1, lonv1, alt, vlon, vlat, speed, dir, temp, hum : LONGREAL; lastsent, gpsdate, gpstime, tgpstime, tlat, tlon, tlat1, tlon1, tlatv1, tlonv1, talt, tspeed, tdir, ttemp, thum, tused : TIME; END; pCONTEXTDFM6=POINTER TO CONTEXTDFM6; CONTEXTDFM6=RECORD next : pCONTEXTDFM6; name : OBJNAME; clmb, lat, lon, lat1, lon1, alt, speed, dir : LONGREAL; gpsdate, lastsent, tlat, tlon, tlat1, tlon1, talt, tspeed, tdir, actrt, tused : TIME; d9, posok : BOOLEAN; poserr : CARDINAL; (* count down after position jump *) (* new df serial *) lastfrid, nameregtop : CARDINAL; namereg : ARRAY[0..49] OF DFNAMES; (* new df serial *) END; pCONTEXTR4=POINTER TO CONTEXTR4; CONTEXTR4=RECORD next : pCONTEXTR4; name : OBJNAME; flightstate : CHAR; bk, posok, framesent : BOOLEAN; mhz : REAL; encrcnt, gpssecond, framenum : CARDINAL; tused : TIME; hp : LONGREAL; ozonInstType, ozonInstNum : CARDINAL; ozonTemp, ozonuA : LONGREAL; ozonBatVolt, ozonPumpMA, ozonExtVolt : LONGREAL; txtime : INTEGER; calibdata : ARRAY[0..16*51-1] OF CHAR; calibok : SET51; (* ozon_id_ser : ARRAY[0..8] OF CHAR; ozon_id_diag : INT16; ozon_id_version : REAL; *) END; pCONTEXTM10=POINTER TO CONTEXTM10; CONTEXTM10=RECORD next : pCONTEXTM10; name : OBJNAME; posok, framesent : BOOLEAN; mhz : REAL; gpssecond, framenum : CARDINAL; tused : TIME; END; pCONTEXTIMET=POINTER TO CONTEXTIMET; CONTEXTIMET=RECORD next : pCONTEXTIMET; name : OBJNAME; posok, framesent : BOOLEAN; mhz : REAL; gpssecond, framenum : CARDINAL; talt, tused : TIME; pumpmA, frnum : CARDINAL; lat, long : LONGREAL; speed, clb, dir, alt, otemp, ozoneuA, pumpV, hpa, rtok, hum, vbatt : REAL; END; pCONTEXTMP3=POINTER TO CONTEXTMP3; CONTEXTMP3=RECORD next : pCONTEXTMP3; name : OBJNAME; ser : ARRAY[0..20] OF CHAR; id1ok, id2ok, posok, framesent : BOOLEAN; id1, id2 : CARDINAL; lastgpstime, gpstime, tused : TIME; lat, long : LONGREAL; speed, clb, dir, alt : REAL; END; pCONTEXTMEISEI=POINTER TO CONTEXTMEISEI; CONTEXTMEISEI=RECORD next : pCONTEXTMEISEI; name : OBJNAME; ser : ARRAY[0..20] OF CHAR; posok, framesent : BOOLEAN; lastgpstime, gpstime, tused : TIME; lat, long : LONGREAL; mhz, speed, clb, dir, alt : REAL; gpssum, fnum, subtype : CARDINAL; END; pDFMTYPES=POINTER TO DFMTYPES; DFMTYPES=RECORD next:pDFMTYPES; n:CARDINAL; t:ARRAY[0..8] OF CHAR; END; VAR <* IF WITHSOUND THEN *> soundfd, debfd : INTEGER; afin : CARDINAL; <* END *> semfile, yumafile, rinexfile, encryptmsgfn:FILENAME; maxsoundbufs, adcrate, adcbuflen, adcbytes, fragmentsize, sendquick, (* 0 send if full calibrated, 1 with mhz, 2 always *) clock : CARDINAL; leapseconds:INTEGER; almread, (* time last almanach read *) almrequest, (* seconds rinex age to request new *) almage:TIME; systime:TIME; soundfn:FILENAME; chan : ARRAY[LEFT..RIGHT] OF CHAN; <* IF WITHSOUND THEN *> maxchannels : CHANNELS; demodbaud, configbaud : CARDINAL; <* END *> lastsat : SATS; coeff : ARRAY[0..255] OF REAL; mhz : REAL; objname : OBJNAME; rxsock : INTEGER; maxalmage : TIME; lastip : IPNUM; lastport : UDPPORT; mycall : ARRAY[0..99] OF CHAR; contextr9 : CONTEXTR9; pcontextc : pCONTEXTC34; pcontextdfm6 : pCONTEXTDFM6; pcontextr4 : pCONTEXTR4; pcontextm10 : pCONTEXTM10; pcontextimet : pCONTEXTIMET; pcontextmp3 : pCONTEXTMP3; pcontextmeisei : pCONTEXTMEISEI; sdrblock : SDRBLOCK; dftypes : pDFMTYPES; sendmhzfromsdr : BOOLEAN; xdatablock : XDATA; CRCTAB : ARRAY[0..255] OF SET16; PROCEDURE Error(text:ARRAY OF CHAR); BEGIN WrStr(text); WrStrLn(" error abort"); HALT END Error; PROCEDURE hex(n:CARDINAL):CHAR; BEGIN n:=n MOD 16; IF n<10 THEN RETURN CHR(n+ORD("0")) ELSE RETURN CHR(n+(ORD("A")-10)) END; END hex; PROCEDURE pow(x:REAL; y:CARDINAL):REAL; VAR z:REAL; BEGIN z:=x; WHILE y>1 DO z:=z*x; DEC(y) END; RETURN z END pow; PROCEDURE atang2(x, y:LONGREAL):LONGREAL; VAR w:LONGREAL; BEGIN IF ABS(x)>ABS(y) THEN w:=atan(y/x); IF x<0.0 THEN IF y>0.0 THEN w:=pi+w ELSE w:=w-pi END; END; ELSIF y<>0.0 THEN w:=(pi*0.5-atan(x/y)); IF y<0.0 THEN w:=w-pi END; ELSE w:=0.0 END; RETURN w END atang2; PROCEDURE SaveReal(c:CARDINAL):REAL; VAR e:CARDINAL; BEGIN e:=c DIV 1000000H; IF e=07FH THEN RETURN MAX(REAL) ELSIF e=0FFH THEN RETURN MIN(REAL) END; RETURN CAST(REAL, c); END SaveReal; <* IF WITHSOUND THEN *> PROCEDURE Hamming(VAR f:ARRAY OF REAL); VAR i:CARDINAL; BEGIN FOR i:=0 TO HIGH(f) DO f[i]:=f[i]*(0.54+0.46*cos(pi*(FLOAT(i)/FLOAT(1+HIGH(f))))) END; END Hamming; PROCEDURE initafir(VAR atab:AFIRTAB; F0, F1:CARDINAL; eq:REAL); VAR i,f:CARDINAL; t:ARRAY[0..AFIRLEN*AOVERSAMP DIV 2-1] OF REAL; e,f0,f1:REAL; BEGIN f0:=FLOAT(F0*AFIRLEN)/FLOAT(adcrate); f1:=FLOAT(F1*AFIRLEN)/FLOAT(adcrate); FOR i:=0 TO HIGH(t) DO t[i]:=0.0 END; FOR f:=TRUNC(f0) TO TRUNC(f1)+1 DO e:=1.0 + eq*(FLOAT(f)/(FLOAT((F0+F1)*AFIRLEN)/FLOAT(adcrate))*2.0-1.0); (* e:=1.0 + eq*(FLOAT(f)/FLOAT((F0+F1)*AFIRLEN DIV adcrate)*2.0-1.0); *) IF e<0.0 THEN e:=0.0 END; IF f=TRUNC(f0) THEN e:=e*(1.0-(f0-FLOAT(TRUNC(f0)))) END; IF f=TRUNC(f1)+1 THEN e:=e*(f1-FLOAT(TRUNC(f1))) END; (* IF eq<>0 THEN IO.WrFixed(e,2,2);IO.WrLn; END; *) IF f=0 THEN FOR i:=0 TO HIGH(t) DO t[i]:=t[i]+e*0.5 END; ELSE FOR i:=0 TO HIGH(t) DO t[i]:=t[i] + e*cos(pi*FLOAT(i*f)/FLOAT(HIGH(t)+1)) END; END; END; Hamming(t); FOR i:=0 TO HIGH(t) DO atab[HIGH(t)+i]:=t[i]; atab[HIGH(t)-i]:=t[i]; END; IF F0>0 THEN (* make dc level zero *) e:=0.0; FOR i:=0 TO HIGH(atab) DO e:=e+atab[i] END; e:=e/FLOAT(HIGH(atab)+1); FOR i:=0 TO HIGH(atab) DO atab[i]:=atab[i]-e END; END; (* IO.WrLn; FOR i:=0 TO HIGH(atab) DO IO.WrFixed(atab[i], 2,8) END; IO.WrLn; *) (* IF eq<>0.0 THEN debfd:=FIO.Create("/tmp/ta.raw"); FOR i:=0 TO HIGH(atab) DO f:=VAL(INTEGER, atab[i]*1000.0); FIO.WrBin(debfd,f,2) END; FIO.Close(debfd); END; *) END initafir; PROCEDURE SetMixer(mixfn:ARRAY OF CHAR; chan, left, right:CARDINAL); VAR fd:INTEGER; BEGIN fd:=OpenRW(mixfn); IF fd>=0 THEN IF chan=255 THEN chan:=soundctl.recnum() END; soundctl.setmixer(fd, chan, ASH(right, 8) + left); ELSE WrStr(mixfn); Error(" open") END END SetMixer; PROCEDURE OpenSound; VAR i,s:INTEGER; BEGIN soundfd:=OpenRW(soundfn); IF soundfd>=0 THEN i:=soundctl.samplesize(soundfd, 16); (* 8, 16 *) i:=soundctl.channels(soundfd, ORD(maxchannels)+1); (* 1, 2 *) i:=soundctl.setfragment(soundfd, fragmentsize); (* 2^bufsize * 65536*bufs*) IF i<>0 THEN WrStr("sound setfragment returns "); WrInt(i,1); WrLn END; i:=soundctl.sampelrate(soundfd, adcrate); (* 8000..48000 *) s:=soundctl.getsampelrate(soundfd); IF s<>VAL(INTEGER, adcrate) THEN WrStr("sound device returns "); WrInt(s,1); WrStrLn("Hz!"); END; END; END OpenSound; <* END *> PROCEDURE WrSemaFile(fn-, name-:ARRAY OF CHAR; sdr-:SDRBLOCK); VAR f:INTEGER; s,h:ARRAY[0..999] OF CHAR; BEGIN Assign(s, name); IF sdr.valid & (sdr.freq<>0) THEN Append(s, " "); FixToStr(FLOAT(VAL(INTEGER, sdr.freq DIV 100)+sdr.afc)*0.001, 4, h); Append(s, h); Append(s, "MHz"); END; f:=OpenWrite(fn); IF f>=0 THEN WrBin(f, s, Length(s)) END; Close(f); END WrSemaFile; PROCEDURE GetNum(h-:ARRAY OF CHAR; eot:CHAR; VAR p,n:CARDINAL):BOOLEAN; BEGIN n:=0; WHILE (h[p]>="0") & (h[p]<="9") DO n:=n*10+ORD(h[p])-ORD("0"); INC(p); END; RETURN (h[p]=0C) OR (h[p]=eot) END GetNum; PROCEDURE ExtractWord(VAR w,s:ARRAY OF CHAR); VAR i,j:CARDINAL; BEGIN w[0]:=0C; i:=0; WHILE (i<=HIGH(s)) & (s[i]<>0C) & (s[i]<>":") DO IF i<=HIGH(w) THEN w[i]:=s[i] END; INC(i); END; IF i<=HIGH(w) THEN w[i]:=0C END; j:=0; IF (i<=HIGH(s)) & (s[i]<>0C) THEN INC(i); WHILE (i<=HIGH(s)) & (s[i]<>0C) DO s[j]:=s[i]; INC(i); INC(j); END; END; s[j]:=0C; END ExtractWord; PROCEDURE crcrs(frame-:ARRAY OF CHAR; from,to:INTEGER):BOOLEAN; VAR crc:SET16; i:INTEGER; BEGIN crc:=SET16{0..15}; FOR i:=from TO to-3 DO crc:=SHIFT(crc, -8)/CRCTAB[CAST(CARDINAL, (crc/(CAST(SET16,frame[i])))*SET16{0..7})]; END; RETURN (frame[to-1]=CAST(CHAR, crc)) & (frame[to-2]=CAST(CHAR, SHIFT(crc,-8))) END crcrs; <* IF WITHSOUND THEN *> PROCEDURE Config; VAR i:CARDINAL; c:CHANNELS; BEGIN FOR c:=LEFT TO RIGHT DO WITH chan[c] DO configbaud:=4800; demodbaud:=2*configbaud*BAUDSAMP DIV adcrate; initafir(afirtab, 300, 3600, VAL(REAL, configequalizer)/100.0); baudfine:=0; tcnt:=0.0; cbit:=FALSE; rxp:=0; rxbitc:=0; manchestd:=0; lastmanch:=FALSE; rxbyte:=0; FOR i:=0 TO HIGH(asynst) DO asynst[i]:=0 END; END; END; END Config; <* END *> PROCEDURE getdfhex(h-:ARRAY OF CHAR; VAR i:CARDINAL):CARDINAL; VAR n:CARDINAL; ok:BOOLEAN; BEGIN n:=0; ok:=FALSE; LOOP IF (i>HIGH(h)) THEN EXIT END; IF h[i]<"0" THEN EXIT END; IF h[i]<="9" THEN n:=n*16+ORD(h[i])-ORD("0"); ok:=TRUE; ELSIF (h[i]<"A") OR (h[i]>"F") THEN EXIT ELSE n:=n*16+ORD(h[i])-(ORD("A")-10); ok:=TRUE END; INC(i); END; IF ok THEN RETURN n END; RETURN 256 END getdfhex; PROCEDURE Parms; VAR err:BOOLEAN; h, h1, mixfn, pipefn:FILENAME; i, n, cnum, left, right: CARDINAL; modem, inum : INTEGER; channel:CHANNELS; dftyp : pDFMTYPES; udest:pUDPDESTS; BEGIN mycall[0]:=0C; semfile:=""; yumafile:=""; rinexfile:=""; encryptmsgfn:=""; err:=FALSE; rectfence.leftdown.lat:=0.0; <* IF WITHSOUND THEN *> adcrate:=16000; adcbytes:=2; adcbuflen:=1024; fragmentsize:=12; maxchannels:=LEFT; debfd:=-1; <* END *> rxsock:=-1; dao:=FALSE; FILL(ADR(beacontimes), 0C, SIZE(beacontimes)); beacontimes[0].beacontime:=30; beacontimes[0].below:=MAX(CARDINAL); beacontimes[1].beacontime:=10; beacontimes[1].below:=1000; maxalmage:=6*3600; almrequest:=4*3600; verb:=FALSE; verb2:=FALSE; json:=FALSE; sendquick:=2; myalt:=-500000.0; mypos.lat:=0.0; mypos.long:=0.0; maxsenddistance:=0; expire:=0; sendmhzfromsdr:=FALSE; leapseconds:=GPSTIMECORR; axudpdests:=NIL; jsondests:=NIL; udpsock:=-1; <* IF WITHSOUND THEN *> FOR channel:=LEFT TO RIGHT DO WITH chan[channel] DO configequalizer:=0; pllshift:=PLLSHIFT; END; END; channel:=LEFT; COPY("/dev/dsp", soundfn); COPY("/dev/mixer", mixfn); <* END *> LOOP NextArg(h); IF h[0]=0C THEN EXIT END; IF (h[0]="-") & (h[1]<>0C) & (h[2]=0C) THEN IF h[1]="d" THEN dao:=TRUE; ELSIF h[1]=minusa THEN NextArg(h); loctopos(rectfence.leftdown, h); IF NOT posvalid(rectfence.leftdown) THEN IF NOT StrToFix(rectfence.leftdown.lat, h) OR (ABS(rectfence.leftdown.lat)>=90) THEN Error("-"+minusa+" or or ") END; NextArg(h); IF NOT StrToFix(rectfence.leftdown.long, h) OR (ABS(rectfence.leftdown.long)>180) THEN Error("-"+minusa+" or or ") END; END; NextArg(h); loctopos(rectfence.rightup, h); IF NOT posvalid(rectfence.rightup) THEN IF NOT StrToFix(rectfence.rightup.lat, h) OR (ABS(rectfence.rightup.lat)>=90) THEN Error("-"+minusa+" or or ") END; NextArg(h); IF NOT StrToFix(rectfence.rightup.long, h) OR (ABS(rectfence.rightup.long)>180) THEN Error("-"+minusa+" or or ") END; END; <* IF WITHSOUND THEN *> ELSIF h[1]="c" THEN NextArg(h); IF NOT StrToCard(h, cnum) THEN err:=TRUE END; IF (cnum<1) OR (cnum>2) THEN Error("maxchannels 1..2") END; maxchannels:=VAL(CHANNELS, cnum-1); ELSIF h[1]="D" THEN NextArg(h1); debfd:=creat(h1, 644B); ELSIF h[1]="e" THEN NextArg(h); IF NOT StrToInt(h, inum) THEN err:=TRUE END; IF ABS(inum)>999 THEN Error("equalizer -999..999") END; chan[channel].configequalizer:=inum; ELSIF h[1]="f" THEN NextArg(h); IF NOT StrToCard(h, cnum) THEN err:=TRUE END; IF (cnum<8000) OR (cnum>96000) THEN Error("sampelrate 8000..96000") END; adcrate:=cnum; ELSIF h[1]="l" THEN NextArg(h); IF NOT StrToCard(h, cnum) THEN err:=TRUE END; IF (cnum>=16) & (cnum<=ADCBUFLEN) THEN adcbuflen:=cnum ELSE Error("sound buffer out of range") END; <* END *> ELSIF h[1]="F" THEN nofilter:=TRUE; ELSIF h[1]="g" THEN NextArg(h); IF NOT StrToInt(h, leapseconds) THEN Error("-g [-]seconds") END; ELSIF h[1]="o" THEN NextArg(soundfn); IF StrToCard(soundfn, cnum) THEN (* listen on UDP instead of soundcard *) soundfn:=""; rxsock:=openudp(); IF rxsock<0 THEN Error("cannot open rx udp socket") END; IF udp.bindudp(rxsock, cnum)<0 THEN Error("cannot bind inport") END; END; ELSIF h[1]="T" THEN NextArg(h); IF NOT StrToCard(h, cnum) THEN err:=TRUE END; maxalmage:=cnum*60; ELSIF h[1]="R" THEN NextArg(h); IF NOT StrToCard(h, cnum) THEN err:=TRUE END; almrequest:=cnum*60; ELSIF h[1]="p" THEN NextArg(h); IF NOT StrToCard(h, cnum) THEN err:=TRUE END; sendquick:=cnum; ELSIF h[1]=minusE THEN NextArg(h); IF NOT StrToCard(h, expire) THEN err:=TRUE END; ELSIF h[1]="t" THEN NextArg(commentfn); ELSIF h[1]="S" THEN NextArg(srtmdir); ELSIF h[1]="C" THEN NextArg(csvfilename); ELSIF h[1]="j" THEN NextArg(csvfilename); json:=TRUE; ELSIF h[1]="J" THEN (* send json udp *) json:=TRUE; NextArg(h); ALLOCATE(udest, SIZE(udest^)); IF udest=NIL THEN Error("out of memory") END; udest^.next:=jsondests; jsondests:=udest; i:=0; IF GetIp(h, i, udest^.ipnum, udest^.port)<0 THEN Error("-J ip:port number") END; IF udpsock<0 THEN udpsock:=openudp(); IF udpsock<0 THEN Error("cannot open udp socket") END; END; ELSIF (h[1]="m") OR (h[1]="r") THEN sendmon:=(h[1]<>"r"); NextArg(h); ALLOCATE(udest, SIZE(udest^)); IF udest=NIL THEN Error("out of memory") END; udest^.next:=axudpdests; axudpdests:=udest; i:=0; IF GetIp(h, i, udest^.ipnum, udest^.port)<0 THEN Error("-m or -r ip:port number") END; IF udpsock<0 THEN udpsock:=openudp(); IF udpsock<0 THEN Error("cannot open udp socket") END; END; ELSIF h[1]="w" THEN NextArg(via); IF via[0]<=" " THEN Error("-m vias like RELAY,WIDE1-1") END; ELSIF h[1]="b" THEN NextArg(h); n:=0; i:=0; LOOP IF n>HIGH(beacontimes) THEN Error("-b timetable full") END; IF NOT GetNum(h, ":", i, beacontimes[n].beacontime) THEN Error("-b [:]...") END; IF h[i]=0C THEN EXIT END; IF h[i]<>":" THEN Error("-b [:]...") END; INC(i); INC(n); END; ELSIF h[1]="B" THEN (* obsolete *) NextArg(h); i:=0; IF NOT GetNum(h, 0C, i, beacontimes[1].beacontime) THEN Error("-B ") END; ELSIF h[1]=minusG THEN NextArg(h); i:=0; IF NOT GetNum(h, 0C, i, maxsenddistance) THEN Error(minusG+" ") END; ELSIF h[1]="A" THEN NextArg(h); n:=1; i:=0; LOOP IF n>HIGH(beacontimes) THEN Error("-A altitude table full") END; IF NOT GetNum(h, ":", i, beacontimes[n].below) THEN Error("-A [:]...") END; IF h[i]=0C THEN EXIT END; IF h[i]<>":" THEN Error("-A [:]...") END; INC(i); INC(n); END; ELSIF h[1]="I" THEN NextArg(mycall); IF mycall[0]<" " THEN Error("-I ") END; ELSIF h[1]="s" THEN NextArg(semfile); IF semfile[0]<" " THEN Error("-s ") END; ELSIF h[1]="x" THEN NextArg(rinexfile); IF rinexfile[0]<" " THEN Error("-x ") END; ELSIF h[1]="y" THEN NextArg(yumafile); IF yumafile[0]<" " THEN Error("-y ") END; ELSIF h[1]="X" THEN NextArg(encryptmsgfn); IF encryptmsgfn[0]<" " THEN Error("-X ") END; ELSIF h[1]=minusP THEN NextArg(h); loctopos(mypos, h); IF NOT posvalid(mypos) THEN IF NOT StrToFix(mypos.lat, h) OR (ABS(mypos.lat)>=90) THEN Error("-"+minusP+" or ") END; NextArg(h); IF NOT StrToFix(mypos.long, h) OR (ABS(mypos.long)>180) THEN Error("-"+minusP+" or ") END; mypos.lat :=mypos.lat*RAD; mypos.long:=mypos.long*RAD; END; ELSIF h[1]="N" THEN NextArg(h); IF NOT StrToFix(myalt, h) THEN Error("-N ") END; ELSIF h[1]="v" THEN verb:=TRUE; ELSIF h[1]="V" THEN verb:=TRUE; verb2:=TRUE; ELSIF h[1]="M" THEN sendmhzfromsdr:=TRUE; ELSIF h[1]="L" THEN NextArg(h); i:=0; LOOP ALLOCATE(dftyp, SIZE(dftyp^)); IF dftyp=NIL THEN Error("out of memory") END; dftyp^.n:=getdfhex(h,i); IF (dftyp^.n>255) OR (h[i]<>"=") THEN Error("-L =") END; dftyp^.t[0]:=0C; LOOP INC(i); IF (i>HIGH(h)) OR (h[i]=0C) OR (h[i]=",") THEN EXIT END; IF (h[i]<" ") OR (h[i]>="~") THEN Error("-L =") END; Append(dftyp^.t, h[i]); END; dftyp^.next:=dftypes; dftypes:=dftyp; IF h[i]<>"," THEN EXIT END; INC(i); END; ELSIF h[1]="h" THEN WrStr(VERSION); WrStrLn(" multichannel decoder RS92, RS41, SRS-C34/50, DFM, M10, iMET Radiosondes"); WrStrLn(" -A [:] at lower altitude use -b beacon time (meter) -A 3000:1000:200"); WrStrLn(" if SRTM/EGM-data available, Overground will be used"); WrStrLn(" -"+minusa+" or send beacons from inside leftdown"); WrStrLn(" to rightup, swap corners to send only outside the rectangle"); WrStrLn(" -B obsolete, use -b :"); WrStrLn(" -b [:]... minimum send intervall or 0 for never send -b 30:20:6:2"); WrStrLn(" first for high altitude, next below (descending) altitudes as given in -A"); WrStrLn(" -C write decoded data in csv-format to this file"); <* IF WITHSOUND THEN *> WrStrLn(" -c (internal demod only) maxchannels (1) (1=mono, 2=stereo)"); WrStrLn(" -D (internal demod only) copy raw sound data to file or pipe"); <* END *> WrStrLn(" -d dao extension for 20cm APRS resolution instead of 18m"); <* IF WITHSOUND THEN *> WrStrLn(" -e (internal demod only) demod equalizer (0) 100=6db/oct highpass)"); <* END *> WrStrLn(" -"+minusE+" stop sending if more difference gps-time to computer-clock (0=off)"); WrStrLn(" (-"+minusE+" 4) use to keep Tracks clean if system time is set to UTC"); WrStrLn(" -F trackfilter off, DO NOT USE THIS SENDING TO THE WORLD!"); WrStrLn(" -"+minusG+" send only if Ground-distance to Sonde not more, 0=off (needs -"+minusP+") (-"+minusG+" 15)"); WrStrLn(" -g GPS to utc correction (leapseconds) (if not from sonde) (18)"); WrStrLn(" -h help"); WrStrLn(" -I Sender of Object Callsign -I OE0AAA if not sent by 'sondeudp'"); WrStrLn(" -J send decoded data in (ld)json-format via UDP"); WrStrLn(" may be repeated to send to more destinations"); WrStrLn(" -j write decoded data in (ld)json-format to this file or (unbreakable) pipe"); WrStrLn(" -L =[,=]..."); WrStrLn(" IF there is a dependency, assign DFM-Subtype to highest first 4 bit in"); WrStrLn(' serial number frame (in hex), FF=wildcard if nothing else fits '); WrStrLn(' eg. -L 6=DFM06,7=PS-15,A=DFM09,B=DFM17,C=DFM09P,D=DFM17,FF=DFMx'); WrStrLn(' -M Send "MHz" in APRS (if not received in Data) from SDR-parameter +afc'); WrStrLn(" do only with calibrated SDR, accept wrong data from alias receptions"); WrStrLn(' -m same as -r but send as text instead of axudp'); WrStrLn(" -N my altitude over NN for Distance/Elevation to sonde output"); WrStrLn(" -o receive demodulated data via UDP port from 'sondeudp -u ...'"); <* IF WITHSOUND THEN *> WrStrLn(" -o oss devicename (/dev/dsp) or wav/raw file, prefer external"); WrStrLn(" demodulator with 'sondeudp' because GPS decode time may cause"); WrStrLn(" bad decoding on sound overruns"); <* END *> WrStrLn(" -"+minusP+" or my Position for Distance/Azimuth/Elevation"); WrStrLn(" eg. -P JQ50AB12CD or -P 70.0506 10.0092"); WrStrLn(" -p 0 send if weather data ready, 1 if MHz known, 2 send immediatly (2)"); WrStrLn(" -R request new rinex almanach after minutes if receiving gps (-R 240)"); WrStrLn(" use somewhat like 'getalmd'-script to download"); WrStrLn(" -r : send AXUDP -r 127.0.0.1:9001 use udpgate4 or aprsmap as receiver"); WrStrLn(" udp stream maybe duplicated with udpbox to more destinations"); WrStrLn(" may be repeated to send to more destinations"); WrStrLn(" -S directory with SRTM(1/3/30) Data and WW15MGH.DAC file (egm96-Geoid)"); WrStrLn(" for Overground Calculation below -A "); WrStrLn(" example with: -S /home/pi"); WrStrLn(" /home/pi/WW15MGH.DAC (2076480Byte, covers whole World)"); WrStrLn(" /home/pi/srtm1/N48E014.hgt (25934402Byte, not SRTM3!)"); WrStrLn(" /home/pi/srtm1/N48E015.hgt"); WrStrLn(" -s gps almanach sem format (DO NOT USE, not exact)"); WrStrLn(" -T stop sending data after almanach age (-T 360)"); WrStrLn(' -t append comment lines from this file at start of line eg "%f%d%v text..."'); WrStrLn(" %A Azimuth from sonde-rx, (-"+minusP+" needed too)"); WrStrLn(" %d rssi if received with sdrtst -e"); WrStrLn(" %D Distance to sonde-rx, (-"+minusP+" -S needed too with EGM96)"); WrStrLn(" %E Elevation to sonde, (-"+minusP+" -S needed too with EGM96)"); WrStrLn(' %F same as "f" but send even if MHz got from sonde data'); WrStrLn(" %f sdr freq+AFC from sdrtst with -e and not (yet) got MHz from sonde"); WrStrLn(' %l label given in sondeudp -L eg. "omni" "west" "rx1"'); WrStrLn(" %n frame number if available"); WrStrLn(" %r hdil if available, gps horizontal noise in meter"); WrStrLn(" %s gps sat count if available"); WrStrLn(" %t tx power dBm"); WrStrLn(" %u sonde uptime if available"); WrStrLn(" %v sondemod version"); WrStrLn(" # or empty line(s) for comment-free beacons"); WrStrLn(" -V more verbous"); WrStrLn(" -v verbous"); WrStrLn(" -X if seen encrypted frame, write a file with sonde number"); WrStrLn(" -x gps almanach rinexnavigation format (prefered)"); WrStrLn(" -y gps almanach yuma format (DO NOT USE, not exact)"); WrStrLn(""); WrStrLn("example: sondemod -o 18000 -d -A 1500 -b 30:15 -I OE0AAA -r 127.0.0.1:9001"); WrStrLn('example with srtm and WW15MGH.DAC and faster beacon near ground:'); WrStrLn('sondemod -o 18000 -I OE0AAA -r 127.0.0.1:18100 -b 30:20:6:2 -A 2000:1000:200 -t sondecom.txt -x /tmp/alm.txt -T 360 -R 240 -d -p 2 -S osm -P 48.000 13.000 -N 365 -E 7 -M -L 6=DFM06,7=PS-15,A=DFM09,B=DFM17,C=DFM09P,D=DFM17,FF=DFMx -v'); WrStrLn(""); WrStrLn("python3 json import example: (-J 127.0.0.1:18600"); WrStrLn("----------------------------"); WrStrLn('import json, socket'); WrStrLn('PORT=18600'); WrStrLn('IP=("0.0.0.0",PORT)'); WrStrLn('sock=socket.socket(socket.AF_INET,socket.SOCK_DGRAM)'); WrStrLn('sock.bind(IP)'); WrStrLn('while True:'); WrStrLn(' data, addr=sock.recvfrom(1500)'); WrStrLn(' try:'); WrStrLn(' obj = json.loads(data.decode())'); WrStrLn(' print(obj)'); WrStrLn(' print("lat:",obj["lat"],"long:",obj["long"])'); WrStrLn(' except: print("json decode error")'); WrStrLn(""); HALT ELSE err:=TRUE END; ELSE err:=TRUE END; IF err THEN EXIT END; END; IF err THEN WrStr(">"); WrStr(h); WrStrLn("< use -h"); HALT END; IF (maxsenddistance>0) & (mypos.lat=0.0) & (mypos.long=0.0) THEN WrStrLn("Warning: -G needs Your -"+minusP+" ") END; <* IF WITHSOUND THEN *> Config; IF soundfn[0]<>0C THEN OpenSound END; <* END *> END Parms; <* IF WITHSOUND THEN *> PROCEDURE Fir(in, sub, step:CARDINAL; VAR fir, firtab:ARRAY OF REAL):REAL; VAR s:REAL; i:CARDINAL; BEGIN s:=0.0; i:=sub; REPEAT s:=s + fir[in]*firtab[i]; INC(in); IF in>HIGH(fir) THEN in:=0 END; INC(i, step); UNTIL i>HIGH(firtab); RETURN s END Fir; <* END *> PROCEDURE wrdate(t:CARDINAL); VAR s:ARRAY[0..30] OF CHAR; BEGIN DateToStr(t, s); WrStr(s); END wrdate; PROCEDURE wrsdr; VAR i:CARDINAL; v,w:INTEGER; BEGIN WITH sdrblock DO IF valid THEN IF freq<>0 THEN WrStr(" "); WrFixed(FLOAT(freq)*0.00001,3,1) END; IF maxafc<>0 THEN WrStr("("); IF afc>=0 THEN WrStr("+") END; WrInt(afc, 1); WrStr("/"); WrInt(maxafc, 1); WrStr(")"); END; IF db<>0 THEN WrStr(" "); WrFixed(FLOAT(db)*0.1, 1, 1); WrStr("dB") END; IF name[0]<>0C THEN WrStr(" "); WrStr(name) END; END; END; END wrsdr; PROCEDURE unixdate(yyyy,mm,dd:TIME):TIME; (* make unix time *) CONST MON=ARRAY OF TIME {0,0,31,59,90,120,151,181,212,243,273,304,334}; VAR tt:TIME; BEGIN IF (yyyy>2000) & (yyyy<2100) THEN tt:=((yyyy-1970)*365 + (yyyy-1969) DIV 4); (* days since 1970 *) IF mm<=12 THEN INC(tt, MON[mm]); IF (yyyy MOD 4=0) & (mm>2) THEN INC(tt) END; END; tt:=(tt + dd-1)*DAYSEC; ELSE tt:=0 END; RETURN tt END unixdate; PROCEDURE WrInt24(s-:ARRAY OF CHAR; p:CARDINAL); VAR n:INTEGER; BEGIN n:=ORD(s[p]) + ORD(s[p+1])*256 + ORD(s[p+2])*65536; IF n>=800000H THEN DEC(n, 1000000H) END; WrInt(n, 9); -- WrStr(" "); WrHex(n DIV 01000000H MOD 256, 2); WrHex(n DIV 010000H MOD 256, 2); WrHex(n DIV 0100H MOD 256, 2); WrHex(n MOD 256, 2); END WrInt24; PROCEDURE degtostr(d:REAL; lat:BOOLEAN; form:CHAR; VAR s:ARRAY OF CHAR); CONST Z=ORD("0"); VAR n,i:CARDINAL; BEGIN IF HIGH(s)<11 THEN s[0]:=0C; RETURN END; IF form="2" THEN i:=7 ELSIF form="3" THEN i:=8 ELSE i:=9 END; IF d<0.0 THEN d:=-d; IF lat THEN s[i]:="S" ELSE s[i+1]:="W" END; ELSIF lat THEN s[i]:="N" ELSE s[i+1]:="E" END; IF form="2" THEN (* DDMM.MMNDDMM.MME *) n:=realcard(d*(6000*180/PI)+0.5); s[0]:=CHR(n DIV 600000 MOD 10+Z); i:=ORD(NOT lat); s[i]:=CHR(n DIV 60000 MOD 10+Z); INC(i); s[i]:=CHR(n DIV 6000 MOD 10+Z); INC(i); s[i]:=CHR(n DIV 1000 MOD 6+Z); INC(i); s[i]:=CHR(n DIV 100 MOD 10+Z); INC(i); s[i]:="."; INC(i); s[i]:=CHR(n DIV 10 MOD 10+Z); INC(i); s[i]:=CHR(n MOD 10+Z); INC(i); ELSIF form="3" THEN (* DDMM.MMMNDDMM.MMME *) n:=realcard(d*(60000*180/PI)+0.5); s[0]:=CHR(n DIV 6000000 MOD 10+Z); i:=ORD(NOT lat); s[i]:=CHR(n DIV 600000 MOD 10+Z); INC(i); s[i]:=CHR(n DIV 60000 MOD 10+Z); INC(i); s[i]:=CHR(n DIV 10000 MOD 6+Z); INC(i); s[i]:=CHR(n DIV 1000 MOD 10+Z); INC(i); s[i]:="."; INC(i); s[i]:=CHR(n DIV 100 MOD 10+Z); INC(i); s[i]:=CHR(n DIV 10 MOD 10+Z); INC(i); s[i]:=CHR(n MOD 10+Z); INC(i); ELSE (* DDMMSS *) n:=realcard(d*(60*60*180/PI)+0.5); s[0]:=CHR(n DIV (60*6000) MOD 10+Z); i:=ORD(NOT lat); s[i]:=CHR(n DIV (60*600) MOD 10+Z); INC(i); s[i]:=CHR(n DIV (60*60) MOD 10+Z); INC(i); s[i]:="d"; INC(i); s[i]:=CHR(n DIV 600 MOD 6+Z); INC(i); s[i]:=CHR(n DIV 60 MOD 10+Z); INC(i); s[i]:="'"; INC(i); s[i]:=CHR(n DIV 10 MOD 6+Z); INC(i); s[i]:=CHR(n MOD 10+Z); INC(i); s[i]:='"'; INC(i); END; INC(i); s[i]:=0C; END degtostr; PROCEDURE storexdata(VAR x:XDATA; b:ARRAY OF CHAR; from, l:CARDINAL); VAR i:CARDINAL; BEGIN IF x.cnt<=HIGH(x.xdata) THEN i:=0; x.xdata[x.cnt].len:=l; WHILE (i0) & (P[i] 3.5 ml/s => 100 ml in 28,57 s Default ozone formula from ftp://ftp.cpc.ncep.noaa.gov/ndacc/meta/sonde/cv_payerne_snd.txt POZ(nb) = 0.004307 * i * Tp * t * E(p) => POZ(mPa) = 0.0004307 * i * Tp * t * E(p) where: i is the current from the sensor in uA t is the time in seconds to pump 0.100 liters of air through the pump E(p) is the pump efficiency correction Tp is the pump temperature *) END calcOzone; PROCEDURE dogps(sf-:ARRAY OF CHAR; VAR cont:CONTEXTR9; VAR timems, gpstime:CARDINAL); VAR i,j:CARDINAL; sats:SATS; d, d1, res:INTEGER; h:ARRAY[0..99] OF CHAR; BEGIN cont.lat:=0.0; cont.long:=0.0; cont.heig:=0.0; cont.speed:=0.0; cont.dir:=0.0; --WrStrLn("gps:"); --FOR i:=0 TO 121 DO WrHex(ORD(sf[i]), 3) END; WrStrLn(""); timems:=ORD(sf[0]) + ORD(sf[1])*100H + ORD(sf[2])*10000H +ORD(sf[3])*1000000H; IF verb2 THEN TimeToStr(timems DIV 1000 MOD DAYSEC, h); WrStr("time ms day: "); WrStr(h); WrInt(timems MOD 1000, 4); WrInt(timems DIV (DAYSEC*1000), 2); WrStrLn(""); END; -- WrInt(ORD(sf[4]), 4); WrInt(ORD(sf[5]), 4); WrStrLn(""); -- FILL(ADR(sats), 0C, SIZE(sats)); FOR i:=0 TO 3 DO sats[i*3].prn:=ORD(sf[i*2+6]) MOD 32; sats[i*3+1].prn:=(ORD(sf[i*2+6]) DIV 32 + ORD(sf[i*2+7])*8) MOD 32; sats[i*3+2].prn:=ORD(sf[i*2+7]) DIV 4 MOD 32; END; IF verb2 THEN WrStr("prn:"); FOR i:=0 TO 11 DO WrInt(sats[i].prn, 3) END; WrStrLn(""); WrStr("sig: "); FOR i:=0 TO 11 DO WrHex(ORD(sf[i+14]), 3) END; WrStrLn(""); WrStrLn("rang:"); END; FOR i:=0 TO 11 DO IF sats[i].prn>0 THEN sats[i].rang:=ORD(sf[i*8+26])+ORD(sf[i*8+27])*100H+ORD(sf[i*8+28])*10000H+ORD(sf[i*8+29])*1000000H; sats[i].rang1:=ORD(sf[i*8+30]) + ORD(sf[i*8+31])*100H + ORD(sf[i*8+32])*10000H; sats[i].rang1:=sats[i].rang1 MOD 800000H; sats[i].rang3:=VAL(INT8, sf[i*8+33]); d:=sats[i].rang-lastsat[i].rang; d1:=sats[i].rang1-lastsat[i].rang1; IF verb2 THEN WrInt(sats[i].prn ,3); WrInt(sats[i].rang, 12); WrInt(sats[i].rang1, 12); WrInt(sats[i].rang3, 5); WrInt(d, 12); WrInt(d-lastsat[i].lastd, 12); WrStrLn(""); END; sats[i].lastd:=d; sats[i].lastd1:=d1; END; END; lastsat:=sats; WITH cont DO systime:=time(); IF almread>systime THEN almread:=0 END; (* system clock jumped backward *) IF almread+NEWALMAGE*2>systime THEN gpstime:=systime; res:=getposit(timems, gpstime, sats, lastlat, laslong, lastalt, lat, long, heig, speed, dir, climb, hrmsc, vrmsc, goodsats); ELSE res:=-2 END; IF res>=0 THEN lastlat:=lat; laslong:=long; lastalt:=heig; lastspeed:=speed; lastdir:=dir; lastclb:=climb; ELSE gpstime:=0 END; END; IF verb & (res>=0) THEN degtostr(cont.lat, TRUE, "3", h); WrStr(h); WrStr(" "); degtostr(cont.long, FALSE, "3", h); WrStr(h); -- WrStr("pos: "); WrFixed(lat/RAD, 5, 12); WrFixed(long/RAD, 5, 12); WrFixed(cont.heig, 0, 10); WrStr("m "); WrFixed(cont.speed*3.6, 1, 6); WrStr("km/h "); WrFixed(cont.dir, 0, 5); WrStr("deg "); WrFixed(cont.climb, 1, 7); WrStr("m/s"); WrStr(" h/vrms:"); WrFixed(cont.hrmsc, 1, 0); WrStr(" "); WrFixed(cont.vrmsc, 1, 0); WrStrLn(""); END; END dogps; PROCEDURE decodecalib(cd-:ARRAY OF CHAR); VAR i,n:CARDINAL; cr:CARDINAL; BEGIN FILL(ADR(coeff), 0C, SIZE(coeff)); FOR i:=64 TO 511-4 BY 5 DO n:=ORD(cd[i]); cr:=ORD(cd[i+1]) + ORD(cd[i+2])*0100H + ORD(cd[i+3])*010000H + ORD(cd[i+4])*01000000H; coeff[n]:=SaveReal(cr); END; END decodecalib; PROCEDURE domes(md-:ARRAY OF CHAR; VAR hp, hyg, temp:LONGREAL); VAR i:CARDINAL; m:ARRAY[0..7] OF INTEGER; hr1, hr2, p, x1,d1,d3,d4,d5,d33,d34,d42,d43,x6,x7,x8:REAL; PROCEDURE coef(ref, u, c:REAL):REAL; VAR v,x:REAL; BEGIN v:=ref/u; x:=1.0-v*(1.0-c); IF x<>0.0 THEN RETURN v/x END; RETURN 0.0 END coef; PROCEDURE extr(hi, lo, u, idx:CARDINAL):REAL; VAR v,x,f:REAL; i:CARDINAL; BEGIN IF (hi<=lo) OR (u<=lo) THEN RETURN 0.0 END; v:=coef(FLOAT(hi-lo), FLOAT(u-lo), coeff[idx+7]); x:=0.0; f:=1.0; FOR i:=idx TO idx+5 DO (* sum(x^n * k[n] *) x:=x + coeff[i]*f; f:=f*v; END; RETURN x END extr; BEGIN FOR i:=0 TO HIGH(m) DO m[i]:=ORD(md[i*3]) + ORD(md[i*3+1])*0100H + ORD(md[i*3+2])*010000H END; -- hygro 1 -- IF verb THEN WrStr(" ") END; hr1:=extr(m[3], m[7], m[1], 40); hr2:=extr(m[3], m[7], m[2], 50); IF hr2>hr1 THEN hr1:=hr2 END; IF hr1<2.0 THEN hr1:=0.0 ELSIF hr1>100.0 THEN hr1:=100.0 END; hyg:=hr1; -- temp temp:=extr(m[3], m[7], m[0], 30); -- baro d3:=FLOAT(m[3]-m[7]); d4:=FLOAT(m[4]-m[7]); d5:=FLOAT(m[5]-m[7]); p:= extr(m[3], m[7], m[5], 10) + coeff[60]*extr(m[3], m[7], m[4], 20) + coeff[61]*coeff[20]*d3/d5 + coeff[61]*coeff[21]*coef(d3, d4, coeff[27])*d3/d5 + coeff[61]*coeff[22]*pow(coef(d3, d4, coeff[27]),2)*d3/d5 + coeff[61]*coeff[23]*pow(coef(d3, d4, coeff[27]),3)*d3/d5 + coeff[62]*coeff[20]*d3*d3/(d5*d5) + coeff[62]*coeff[21]*coef(d3, d4, coeff[27])*d3*d3/(d5*d5) + coeff[62]*coeff[22]*pow(coef(d3, d4, coeff[27]),2)*d3*d3/(d5*d5) + coeff[62]*coeff[23]*pow(coef(d3, d4, coeff[27]),3)*d3*d3/(d5*d5) + coeff[63]*coeff[20]*pow(d3,3)/pow(d5,3) + coeff[63]*coeff[21]*coef(d3, d4, coeff[27])*pow(d3,3)/pow(d5,3) + coeff[63]*coeff[22]*pow(coef(d3, d4, coeff[27]),2)*pow(d3,3)/pow(d5,3) + coeff[63]*coeff[23]*pow(coef(d3, d4, coeff[27]),3)*pow(d3,3)/pow(d5,3) (* + coeff[70]*pow(coeff[20],2) + coeff[70]*pow(coeff[21],2)*pow(coef(d3, d4, coeff[27]),2) + coeff[70]*pow(coeff[22],2)*pow(coef(d3, d4, coeff[27]),4) + coeff[70]*pow(coeff[23],2)*pow(coef(d3, d4, coeff[27]),6) + coeff[71]*pow(coeff[20],2)*d3/d5 + coeff[71]*pow(coeff[21],2)*pow(coef(d3, d4, coeff[27]),2)*d3/d5 + coeff[71]*pow(coeff[22],2)*pow(coef(d3, d4, coeff[27]),4)*d3/d5 + coeff[71]*pow(coeff[23],2)*pow(coef(d3, d4, coeff[27]),6)*d3/d5 + coeff[72]*pow(coeff[20],2)*pow(d3,2)/pow(d5,2) + coeff[72]*pow(coeff[21],2)*pow(coef(d3, d4, coeff[27]),2)*pow(d3,2)/pow(d5,2) + coeff[72]*pow(coeff[22],2)*pow(coef(d3, d4, coeff[27]),4)*pow(d3,2)/pow(d5,2) + coeff[72]*pow(coeff[23],2)*pow(coef(d3, d4, coeff[27]),6)*pow(d3,2)/pow(d5,2) + coeff[73]*pow(coeff[20],2)*pow(d3,3)/pow(d5,3) + coeff[73]*pow(coeff[21],2)*pow(coef(d3, d4, coeff[27]),2)*pow(d3,3)/pow(d5,3) + coeff[73]*pow(coeff[22],2)*pow(coef(d3, d4, coeff[27]),4)*pow(d3,3)/pow(d5,3) + coeff[73]*pow(coeff[23],2)*pow(coef(d3, d4, coeff[27]),6)*pow(d3,3)/pow(d5,3) + coeff[80]*pow(coeff[20],3) + coeff[80]*pow(coeff[21],3)*pow(coef(d3, d4, coeff[27]),3) + coeff[80]*pow(coeff[22],3)*pow(coef(d3, d4, coeff[27]),6) + coeff[80]*pow(coeff[23],3)*pow(coef(d3, d4, coeff[27]),9) + coeff[81]*pow(coeff[20],3)*d3/d5 + coeff[81]*pow(coeff[21],3)*pow(coef(d3, d4, coeff[27]),3)*d3/d5 + coeff[81]*pow(coeff[22],3)*pow(coef(d3, d4, coeff[27]),6)*d3/d5 + coeff[81]*pow(coeff[23],3)*pow(coef(d3, d4, coeff[27]),9)*d3/d5 + coeff[82]*pow(coeff[20],3)*pow(d3,2)/pow(d5,2) + coeff[82]*pow(coeff[21],3)*pow(coef(d3, d4, coeff[27]),3)*pow(d3,2)/pow(d5,2) + coeff[82]*pow(coeff[22],3)*pow(coef(d3, d4, coeff[27]),6)*pow(d3,2)/pow(d5,2) + coeff[82]*pow(coeff[23],3)*pow(coef(d3, d4, coeff[27]),9)*pow(d3,2)/pow(d5,2) *) ; hp:=p; (* x10:=c[10] + .... x20:=c[20] + c[21]*v(m4) + c[22]*v(m4)^2 ... x60:=-c[60]*x20 + 10*c[61]*x20 - 100*c[62]*x20 + 1000*c[63]*x20 x70:=c[70]*x20^2 - 10*c[71]*x20^2 + 100*c[72]*x20^2 - 1000*c[72]*x20^2 x80:=-c[80]*x20^3 + 10*c[81]*x20^3 - 100*c[82]*x20^3 p:=x10 + x20 + x60 + x70 + x80 *) IF verb THEN WrStr("mes:"); IF verb2 THEN FOR i:=0 TO 7 DO WrInt(m[i], 7); WrStr(" ") END; WrStrLn(""); END; WrFixed(temp, 3,7); WrStr(" ");WrFixed(hr1, 3,7); --WrStr(" ");WrFixed(hr2, 3,7); WrStr(" ");WrFixed(p, 2,8); --WrStr(" ");WrFixed(x2, 2,8); --WrStrLn(""); END; END domes; PROCEDURE doozon(s-:ARRAY OF CHAR; airpres-:LONGREAL; VAR otemp, ozon:LONGREAL); (* 03 03 00 00 00 00 00 00 00 00 B2 7D no aux 00 03 21 02 5C 5F 00 00 78 1C D4 C9 open input 00 03 00 00 54 5F 00 00 20 1C D8 1F ozon zero 544 0.35nA/step volt 0.13mV/step 220cm3/min mPa=0.043085*i*flow*temp(kelvin) flow=time(s)/100cm3 (27.27) ground 1..7mPa, stratosphere <25mPa *) CONST T20=25000.0; (* adc 20C *) TM7=65535.0; (* adc fullrange - temp *) OZON0=550.0; (* adc zero level ozon *) OZONADC=0.31; (* nA per step *) MPAUA=4; (* mPa per uA *) BEGIN otemp:=FLOAT(ORD(s[4])+ORD(s[5])*256); ozon :=FLOAT(ORD(s[2])+ORD(s[3])*256); otemp:=(TM7-otemp)*(55.0/(TM7-T20))-35.0; ozon:=(ozon-OZON0)*(MPAUA*OZONADC*0.001); ozon:=ozon*((otemp+273.15)*(1.0/325.0)*getOzoneCorr(airpres)); (* temp and pressure correction *) IF ozon<=0.0 THEN ozon:=0.0 END; IF verb THEN WrStr("ozon:");WrFixed(ozon, 1,5); WrStr("mPa temp:"); WrFixed(otemp, 1,5); WrStrLn("C"); --WrStr(" ");WrFixed(FLOAT(ORD(s[8])+ORD(s[9])*256), 0,8); END; END doozon; PROCEDURE calibfn(obj:ARRAY OF CHAR; VAR fn:ARRAY OF CHAR); VAR i:CARDINAL; BEGIN Assign(fn, obj); i:=0; WHILE (i<=HIGH(fn)) & (fn[i]<>0C) DO IF ((fn[i]<"0") OR (fn[i]>"9")) & ((fn[i]<"A") OR (fn[i]>"Z")) THEN fn[0]:=0C; RETURN END; INC(i); END; Append(fn, ".cal"); END calibfn; PROCEDURE readcontext(VAR cont:CONTEXTR9; objname:ARRAY OF CHAR); VAR fn:ARRAY[0..1023] OF CHAR; fd:File; BEGIN initcontext(cont); calibfn(objname, fn); fd:=OpenRead(fn); IF fd>=0 THEN IF (RdBin(fd, cont, SIZE(cont))<>VAL(INTEGER, SIZE(cont))) THEN initcontext(cont) END; Close(fd); END; END readcontext; PROCEDURE wrcontext(VAR cont:CONTEXTR9; objname:ARRAY OF CHAR); VAR fn:ARRAY[0..1023] OF CHAR; fd:File; BEGIN calibfn(objname, fn); IF fn[0]<>0C THEN fd:=OpenWrite(fn); IF fd>=0 THEN WrBin(fd, cont, SIZE(cont)); Close(fd); ELSE WrLn; WrStr("can not write "); WrStr(fn); WrStrLn(" calibration file"); END; END; END wrcontext; PROCEDURE docalib(sf-:ARRAY OF CHAR; VAR objname:ARRAY OF CHAR; VAR cont:CONTEXTR9; VAR mhz:REAL; VAR frameno:CARDINAL); VAR i,j, idx:CARDINAL; len:INTEGER; new:BOOLEAN; BEGIN mhz:=0.0; new:=FALSE; i:=0; FOR j:=2 TO 11 DO (* object name *) -- IF (1 IN cont.calibok) & (sf[j]<>cont.calibdata[j+20]) THEN cont.calibok:=SET32{} END; IF (i<=HIGH(objname)) & (sf[j]>" ") THEN IF objname[i]<>sf[j] THEN new:=TRUE END; objname[i]:=sf[j]; INC(i); END; END; IF i<=HIGH(objname) THEN objname[i]:=0C END; IF new THEN readcontext(cont, objname) END; frameno:=ORD(sf[0])+ORD(sf[1])*256; IF verb THEN IF new THEN WrStr("new ") END; WrInt(frameno, 1); WrStr(" "); (* frame no *) WrStr(objname); (*WrStr(" bat:"); WrHex(ORD(sf[12]), 2);*) END; idx:=ORD(sf[15]); IF idx<32 THEN j:=idx*16; FOR i:=16 TO 31 DO IF j<=HIGH(cont.calibdata) THEN -- IF (idx IN cont.calibok) & (cont.calibdata[j]<>sf[i]) THEN cont.calibok:=SET32{} END; cont.calibdata[j]:=sf[i]; END; INC(j); END; IF NOT (idx IN cont.calibok) THEN (* got more new info *) INCL(cont.calibok, idx); wrcontext(cont, objname); END; -- INCL(cont.calibok, idx); IF 0 IN cont.calibok THEN mhz:=FLOAT(400000+(ORD(cont.calibdata[2])+ORD(cont.calibdata[3])*256)*10)*0.001; IF verb THEN WrStr(" "); WrFixed(mhz, 2,6); WrStr("MHz "); END; END; IF verb THEN WrStr(" calib: "); FOR i:=0 TO 31 DO IF i=idx THEN WrStr("!") ELSIF i IN cont.calibok THEN WrStr("+") ELSE WrStr("-") END; END; END; IF cont.calibok=SET32{0..31} THEN (* calibration ready now *) decodecalib(cont.calibdata); END; END; END docalib; PROCEDURE calperc91(cs:SET32):CARDINAL; VAR i,n:CARDINAL; BEGIN n:=0; FOR i:=0 TO 31 DO IF i IN cs THEN INC(n) END; END; RETURN n*100 DIV 32 END calperc91; PROCEDURE WrRinexfn(t:TIME); VAR fn:ARRAY[0..30] OF CHAR; d, y:TIME; f:File; BEGIN --DateToStr(t, fn); WrStrLn(fn); d:=25568+t DIV (60*60*24); y:=d*4 DIV 1461; d:=1 + d*4 MOD 1461 DIV 4; fn:="brdc0000.00n"; fn[4]:=CHR(d DIV 100+ORD("0")); fn[5]:=CHR(d DIV 10 MOD 10+ORD("0")); fn[6]:=CHR(d MOD 10+ORD("0")); fn[9]:=CHR(y DIV 10 MOD 10+ORD("0")); fn[10]:=CHR(y MOD 10+ORD("0")); IF verb THEN WrStrLn(fn) END; f:=OpenWrite("getalmanach"); IF f>=0 THEN WrBin(f, fn, Length(fn)); Close(f); ELSE WrStrLn("can not write getalmanach file") END; END WrRinexfn; PROCEDURE getcall(b-:ARRAY OF CHAR; VAR call:ARRAY OF CHAR); VAR i, n, c:CARDINAL; BEGIN call[0]:=0C; n:=ORD(b[0])*(256*256*256) + ORD(b[1])*(256*256) + ORD(b[2])*(256) + ORD(b[3]); IF (n>0) & (ORD(b[4])<=15) THEN FOR i:=5 TO 0 BY -1 DO c:=n MOD 37; IF c=0 THEN call[i]:=0C ELSIF c<27 THEN call[i]:=CHR(c+ORD("A")-1) ELSE call[i]:=CHR(c+ORD("0")-27) END; n:=n DIV 37; END; call[6]:=0C; c:=ORD(b[4]); IF c>0 THEN Append(call, "-"); IF c>=10 THEN Append(call, "1"); c:=c MOD 10 END; Append(call, CHR(c+ORD("0"))); END; END; --WrStr("usercall:");WrStrLn(call); END getcall; PROCEDURE decodeframe(m:CHANNELS; ip:IPNUM; fromport:UDPPORT); VAR i,j,p,ic, len, try, idx, frameno, gpstime:CARDINAL; almanachage:TIME; res:INTEGER; typ:CHAR; b, bb, ecc, sf:ARRAY[0..255] OF CHAR; eraspos:ARRAY[0..23] OF CARDINAL; calok, crdone:BOOLEAN; usercall:CALLSSID; BEGIN (* -- reedsolomon is done by sondeudp FOR i:=0 TO HIGH(b) DO b[i]:=0C END; FOR i:=0 TO 240-6-24-1 DO b[(255-24-1)-i]:=chan[m].rxbuf[i+6] END; FOR i:=0 TO 24-1 DO b[(255-1)-i]:=chan[m].rxbuf[i+(240-24)] END; -- WrStrLn(" ecco: "); -- FOR i:=216 TO 239 DO WrHex(ORD(chan[m].rxbuf[i]), 4) END; WrStrLn(""); WrStrLn(""); --bb:=b; res:=decodersc(b, eraspos, 0); IF res>0 THEN FOR i:=0 TO 240-6-24-1 DO chan[m].rxbuf[i+6]:=b[(255-24-1)-i] END; FOR i:=0 TO 24-1 DO chan[m].rxbuf[i+(240-24)]:=b[(255-1)-i] END; IF verb THEN WrInt(res, 1); WrStr(" bytes corrected "); END; END; *) (* WrInt(res, 1); WrStrLn("=rs"); FOR i:=0 TO 254 DO IF b[i]<>bb[i] THEN WrInt(i, 4); WrStr(":");WrHex(ORD(bb[i]), 2); WrStr("-"); WrHex(ORD(b[i]), 2); END; END; WrStrLn(" diffs"); *) FOR i:=0 TO 255 DO b[i]:=chan[m].rxbuf[i] END; calok:=FALSE; getcall(b, usercall); IF usercall[0]=0C THEN Assign(usercall, mycall) END; IF verb & (fromport>0) THEN WrStr("UDP:"); ipv4tostr(ip, bb); WrStr(bb); WrStr(":"); WrInt(fromport, 1); IF usercall[0]<>0C THEN WrStr(" ("); WrStr(usercall); WrStr(")"); END; WrStrLn(""); END; p:=6; crdone:=TRUE; contextr9.posok:=FALSE; contextr9.ozontemp:=0.0; contextr9.ozon:=0.0; mhz:=0.0; xdatablock.cnt:=0; LOOP typ:=b[p]; IF typ=CALIBFRAME THEN IF verb THEN WrStr("cal "); crdone:=FALSE END; ELSIF typ=GPSFRAME THEN IF verb THEN WrStr("gps "); crdone:=FALSE END; ELSIF typ=AUXILLARY THEN IF (b[p+2]<>EMPTYAUX) & verb THEN WrStr("aux "); crdone:=FALSE END; ELSIF typ=DATAFRAME THEN IF verb THEN WrStr("data "); crdone:=FALSE END; ELSIF typ=CHR(0FFH) THEN EXIT ELSE WrStr("R92 end "); IF verb THEN WrHex(ORD(typ), 4); crdone:=FALSE END; EXIT END; INC(p); len:=ORD(b[p])*2+2; (* +crc *) IF len>=240 THEN IF verb THEN WrStr("RS92 Frame too long "); WrInt(len, 1); crdone:=FALSE END; EXIT END; INC(p); j:=0; --WrInt(len 3);WrStrLn("=len"); WHILE j240 THEN WrStr("eof"); crdone:=FALSE; EXIT END; (* error *) END; crdone:=FALSE; IF NOT crcrs(sf, 0, len) THEN IF verb THEN WrStrLn("********* crc error") END; ELSE IF typ=CALIBFRAME THEN docalib(sf, objname, contextr9, mhz, frameno); IF frameno>contextr9.framenum THEN (* new frame number *) contextr9.mesok:=FALSE; contextr9.posok:=FALSE; contextr9.framesent:=FALSE; calok:=TRUE; contextr9.framenum:=frameno; IF verb THEN wrsdr; WrStrLn(""); END; ELSIF (contextr9.framenum=frameno) & NOT contextr9.framesent THEN calok:=TRUE ELSIF (frameno0C) & ((almage=0) OR (gpstime>almage) & (gpstime-almage>almrequest)) THEN (* request a new almanach *) IF gpstime=0 THEN WrRinexfn(systime) ELSE WrRinexfn(gpstime) END; END; crdone:=FALSE; END; IF (gpstime>0) & (gpstime>=almage) THEN almanachage:=gpstime-almage ELSE almanachage:=0 END; IF almage+maxalmage>gpstime THEN posok:=TRUE ELSIF almanachage>0 THEN WrInt(almanachage DIV 60, 10); WrStrLn(" Min (almanach too old)"); IF almread+FASTALM<=systime THEN almread:=systime-NEWALMAGE END; (* look often for new almanach *) END; END; crdone:=TRUE; END; ELSIF typ=AUXILLARY THEN IF sf[0]<>EMPTYAUX THEN IF verb2 THEN FOR j:=0 TO len-1 DO WrHex(ORD(sf[j]), 3) END; WrStrLn(""); crdone:=TRUE; END; IF sf[0]=0C THEN doozon(sf, contextr9.hp, contextr9.ozontemp, contextr9.ozon); crdone:=TRUE; END; storexdata(xdatablock, sf, 0, len-2); END; ELSIF verb2 THEN FOR j:=0 TO len-1 DO WrHex(ORD(sf[j]), 3) END; crdone:=FALSE; END; IF verb & NOT crdone THEN WrStrLn(""); crdone:=TRUE END; END; END; IF contextr9.posok & calok & (almread+NEWALMAGE*2>systime) & ((sendquick=2) OR nofilter OR (contextr9.calibok=SET32{0..31}) OR (contextr9.calibok*SET32{0}<>SET32{}) & (sendquick=1)) & (contextr9.lat<>0.0) & (contextr9.long<>0.0) THEN WITH contextr9 DO IF NOT mesok OR (calibok<>SET32{0..31}) THEN hp:=0.0; hyg:=0.0; temp:=MAX(REAL) END; senddata(lat, long, heig, speed, dir, climb, 0.0, hyg, temp, ozon, ozontemp, 0.0, 0.0, mhz, VAL(LONGREAL, hrmsc), VAL(LONGREAL, vrmsc), VAL(INTEGER,gpstime)-leapseconds, frameno, objname, almanachage, goodsats, 0, 0.0, usercall, calperc91(calibok), hp, nofilter, FALSE, 0, "RS92", "", NIL, sdrblock, leapseconds, xdatablock); framesent:=TRUE; END; crdone:=TRUE; END; IF verb THEN IF NOT crdone THEN WrStrLn("") END; WrStrLn("------------"); END; END decodeframe; -------------------------------- C34 C50 PROCEDURE latlong(val:CARDINAL; c50:BOOLEAN):LONGREAL; VAR hr,hf:LONGREAL; BEGIN hr:=FLOAT(val MOD 80000000H); IF c50 THEN hr:=hr/10000000.0 ELSE hr:=hr/1000000.0 END; hf:=FLOAT(TRUNC(hr)); hr:=hf + (hr-hf)/0.6; IF val>=80000000H THEN hr:=-hr END; RETURN hr END latlong; PROCEDURE dist(a,b:LONGREAL):LONGREAL; VAR d:LONGREAL; BEGIN d:=a-b; IF d>PI THEN d:=d-PI*2.0 ELSIF d<-PI THEN d:=d+PI*2.0 END; RETURN d END dist; PROCEDURE extrapolate(yold, y:LONGREAL; told, t, systime:TIME; VAR good:BOOLEAN):LONGREAL; CONST MAXEXTEND=3.0; (* limit extrapolation range *) MAXTIMESPAN=10; MAXRANGE=MAXTIMESPAN*300.0/40000000.0*2.0*pi; (* max jump in rad *) VAR k, dy, maxr, maxex:LONGREAL; maxt: TIME; BEGIN maxr:=MAXRANGE; maxt:=MAXTIMESPAN; maxex:=MAXEXTEND; IF nofilter THEN maxr:=maxr*4.0; maxt:=maxt*4; maxex:=maxex*4.0; END; good:=TRUE; IF t>=systime THEN RETURN y END; (* point is just in time *) IF toldmaxex) OR (told+maxtmaxr THEN good:=FALSE END; RETURN yold + dy*k; END; good:=FALSE; RETURN y END extrapolate; PROCEDURE decodec34(rxb-:ARRAY OF CHAR; ip:IPNUM; fromport:UDPPORT); CONST MINTV=8; (* min seconds for speed out of positions *) VLIM=600.0/3.6/(EARTH*1000); (* max speed *) VAR res:INTEGER; nam:OBJNAME; cb:ARRAY[0..9] OF CHAR; s:ARRAY[0..1000] OF CHAR; tstr:ARRAY[0..50] OF CHAR; usercall:CALLSSID; i,j, sum1, sum2, val:CARDINAL; hr, exlon, exlat, ve:LONGREAL; pc, pc1, pc0:pCONTEXTC34; stemp, shum:LONGREAL; posok, lonok, latok, c50:BOOLEAN; BEGIN IF (rxb[0]<>"S") OR (rxb[1]<>"C") THEN RETURN END; (* no srsc34 frame *) c50:=rxb[2]="5"; (* is a sc50 *) i:=0; REPEAT nam[i]:=rxb[i]; INC(i) UNTIL i>HIGH(nam); IF nam[0]=0C THEN RETURN END; (* wait for id *) INC(i); j:=0; REPEAT cb[j]:=rxb[i]; INC(i); INC(j) UNTIL j>4; getcall(cb, usercall); IF usercall[0]=0C THEN Assign(usercall, mycall) END; j:=0; REPEAT cb[j]:=rxb[i]; INC(i); INC(j) UNTIL j>HIGH(cb); sum1:=0; sum2:=0100FFH; FOR i:=0 TO 4 DO INC(sum1, ORD(cb[i])); DEC(sum2, ORD(cb[i])*(5-i)); END; sum1:=sum1 MOD 256; sum2:=sum2 MOD 256; IF (sum1<>ORD(cb[5])) OR (sum2<>ORD(cb[6])) THEN RETURN END; (* checksum error *) IF verb & (fromport>0) THEN WrStr("UDP:"); ipv4tostr(ip, s); WrStr(s); WrStr(":"); WrInt(fromport, 1); IF usercall[0]<>0C THEN WrStr(" ("); WrStr(usercall); WrStr(")"); END; WrStr(" "); END; WrStr(nam); WrStr(" "); pc:=pcontextc; pc0:=NIL; LOOP IF pc=NIL THEN EXIT END; pc1:=pc^.next; IF pc^.tused+CONTEXTLIFE-99.9) THEN IF verb THEN WrStr("tair "); WrFixed(hr, 1, 0); WrStr("oC"); END; pc^.temp:=hr; pc^.ttemp:=systime; END; |CHR(10H): IF (hr<=100.0) & (hr>0.1) THEN IF verb THEN WrStr("hum "); WrFixed(hr, 1, 0); WrStr("%"); END; pc^.hum:=hr; pc^.thum:=systime; END; |CHR(14H): pc^.gpsdate:=unixdate(2000+val MOD 100, val DIV 100 MOD 100, val DIV 10000 MOD 100); IF verb THEN WrStr("date"); IntToStr(val MOD 1000000 + 1000000, 1, s); s[0]:=" "; WrStr(s); END; |CHR(15H): pc^.gpstime:=val DIV 10000 * 3600 + val MOD 10000 DIV 100 * 60 + val MOD 100; pc^.tgpstime:=systime; IF verb THEN TimeToStr(pc^.gpstime, s); WrStr("time "); WrStr(s); END; |CHR(16H): hr:=latlong(val, c50); IF (hr<89.9) & (hr>-89.9) THEN IF verb THEN WrStr("lat "); WrFixed(hr, 5, 0); END; IF pc^.tlat<>systime THEN WITH pc^ DO lat1 :=lat; tlat1:=tlat; lat :=hr*RAD; tlat :=systime; IF tlattlatv1+MINTV THEN (* south-north speed *) ve:=dist(lat, latv1)/LFLOAT(tlat-tlatv1); --WrStr(" ");WrFixed(ve*(EARTH*1000), 1, 9); WrStr("VTn"); IF ABS(ve)<=VLIM THEN vlat:=vlat + (ve-vlat)*0.5 END; latv1 :=lat; tlatv1:=tlat; END; END; posok:=TRUE; END; END; |CHR(17H): hr:=latlong(val, c50); IF (hr<180.0) & (hr>-180.0) THEN IF verb THEN WrStr("long "); WrFixed(hr, 5, 0); END; IF pc^.tlon<>systime THEN WITH pc^ DO lon1 :=lon; (* save 2 values for extrapolating *) tlon1:=tlon; lon :=hr*RAD; tlon :=systime; IF tlon0) & (tlon>tlonv1+MINTV) THEN (* east-west speed *) ve:=dist(lon, lonv1)*cos(lat)/LFLOAT(tlon-tlonv1); --WrStr(" ");WrFixed(ve*(EARTH*1000), 1, 9); WrStr("VTe"); IF ABS(ve)<=VLIM THEN vlon:=vlon + (ve-vlon)*0.5 END; lonv1 :=lon; tlonv1:=tlon; END; END; posok:=TRUE; END; END; |CHR(18H): hr:=FLOAT(val)*0.1; IF hr<50000.0 THEN IF verb THEN WrStr("alti "); WrFixed(hr, 1, 0); WrStr("m") END; IF pc^.talt-99.9) THEN IF verb THEN WrStr("temp "); WrFixed(hr, 1, 0); WrStr("oC"); END; pc^.temp:=hr; pc^.ttemp:=systime; END; (* |CHR(07H): IF (hr<99.9) & (hr>-99.9) THEN IF verb THEN WrStr("dewp "); WrFixed(hr, 1, 0); WrStr("oC"); END; pc^.dewp:=hr; pc^.tdewp:=systime; END; *) |CHR(14H): pc^.gpsdate:=unixdate(2000+val MOD 100, val DIV 100 MOD 100, val DIV 10000 MOD 100); IF verb THEN WrStr("date"); IntToStr(val MOD 1000000 + 1000000, 1, s); s[0]:=" "; WrStr(s); END; |CHR(15H): pc^.gpstime:=val DIV 10000 * 3600 + val MOD 10000 DIV 100 * 60 + val MOD 100; pc^.tgpstime:=systime; IF verb THEN TimeToStr(pc^.gpstime, s); WrStr("time "); WrStr(s); END; |CHR(16H): hr:=latlong(val, c50); IF (hr<89.9) & (hr>-89.9) THEN IF verb THEN WrStr("lati "); WrFixed(hr, 5, 0); END; IF pc^.tlat<>systime THEN pc^.lat1 :=pc^.lat; pc^.tlat1:=pc^.tlat; pc^.lat :=hr*RAD; pc^.tlat :=systime; posok:=TRUE; END; END; |CHR(17H): hr:=latlong(val, c50); IF (hr<180.0) & (hr>-180.0) THEN IF verb THEN WrStr("long "); WrFixed(hr, 5, 0); END; IF pc^.tlon<>systime THEN pc^.lon1 :=pc^.lon; (* save 2 values for extrapolating *) pc^.tlon1:=pc^.tlon; pc^.lon :=hr*RAD; pc^.tlon :=systime; posok:=TRUE; END; END; |CHR(18H): hr:=FLOAT(val)*0.1; IF hr<50000.0 THEN IF verb THEN WrStr("alti "); WrFixed(hr, 1, 0); WrStr("m") END; IF pc^.talt=0.0) & (hr<1000.0) THEN IF verb THEN WrStr("wind "); WrFixed(hr, 1, 0); WrStr("km/h") END; pc^.speed:=hr*(1.0/3.6); pc^.tspeed:=systime; END; |CHR(1AH): hr:=FLOAT(val)*0.1; IF (hr>=0.0) & (hr<=360.0) THEN IF verb THEN WrStr("wdir "); WrFixed(hr, 1, 0); WrStr("deg") END; pc^.dir:=hr; pc^.tdir:=systime; END; ELSE IF verb THEN WrHex(ORD(cb[0]),0); WrStr(" "); WrHex(ORD(cb[1]),0);WrHex(ORD(cb[2]),0); WrHex(ORD(cb[3]),0); WrHex(ORD(cb[4]),0); WrFixed(hr, 2, 10); END; END; END; WITH pc^ DO IF posok & (nofilter OR (lastsent<>systime) & (tlon+8>systime) & (tlat+8>systime) & (talt+20>systime) & (tspeed+120>systime) & (tdir+120>systime) & (tgpstime+120>systime)) THEN IF ttemp+30>systime THEN stemp:=temp ELSE stemp:=MAX(REAL) END; IF thum+30>systime THEN shum:=hum ELSE shum:=MAX(REAL) END; exlon:=extrapolate(lon1, lon, tlon1, tlon, systime, lonok); exlat:=extrapolate(lat1, lat, tlat1, tlat, systime, latok); (* IF lonok THEN WrStrLn("--good ") ELSE WrStrLn("--bad ") END; WrInt(systime-tlon1, 10); WrInt(systime-tlon, 10); WrFixed(lon1/RAD, 5,0); WrStr(" ");WrFixed(lon/RAD, 5,0); WrStr(" "); WrFixed(exlon/RAD, 5,0); WrStrLn("t1 t x1 x xext"); *) IF lonok & latok THEN IF c50 THEN tstr:="SRSC50" ELSE tstr:="SRSC34" END; xdatablock.cnt:=0; senddata(exlat, exlon, alt, speed, dir, clmb, 0.0, shum, stemp, 0.0, 0.0, 0.0, 0.0, -FLOAT(ORD(sendmhzfromsdr)), 0.0, 0.0, (systime-tgpstime+gpstime) MOD DAYSEC + gpsdate, 0, name, 0, 0, 0, 0.0, usercall, 0, 0.0, nofilter, FALSE, 0, tstr, "", NIL, sdrblock, 0, xdatablock); lastsent:=systime; END; END; END; IF verb THEN wrsdr; WrStrLn("") END; END decodec34; -------------------------------- DFM PROCEDURE bits2val(b-:ARRAY OF BOOLEAN; from, len:CARDINAL):CARDINAL; VAR n:CARDINAL; BEGIN n:=0; WHILE len>0 DO n:=n*2 + ORD(b[from]); INC(from); DEC(len); END; RETURN n END bits2val; PROCEDURE wh(x:CARDINAL); BEGIN x:=x MOD 16; IF x<10 THEN WrStr(CHR(x+ORD("0"))) ELSE WrStr(CHR(x+(ORD("A")-10))) END; END wh; PROCEDURE jumpcheck(p1, p2:REAL; VAR cnt:CARDINAL); CONST DIST=10; (*km*) BEGIN IF (p1<>0.0) & (p2<>0.0) & (ABS(p1-p2)>(DIST*pi/20000.0)) THEN INC(cnt, cnt+1); IF cnt>60 THEN cnt:=60 END; ELSIF cnt>0 THEN DEC(cnt) END; END jumpcheck; PROCEDURE checkdf69(alti:REAL; VAR df9:BOOLEAN); BEGIN df9:=alti=0.0; (* if alti<1 we have swapped values *) END checkdf69; PROCEDURE decodesub(b-:ARRAY OF BOOLEAN; pc:pCONTEXTDFM6; subnum:CARDINAL); CONST MON=ARRAY OF TIME {0,0,31,59,90,120,151,181,212,243,273,304,334}; VAR v,u:CARDINAL; vi:INTEGER; s:ARRAY[0..100] OF CHAR; tmin,thour,tday,tmon,tyear,tt:CARDINAL; vr:LONGREAL; BEGIN CASE bits2val(b, 48, 4) OF 0: IF pc^.d9 THEN (* dfm09 speed *) u:=bits2val(b, 32, 16); vr:=VAL(LONGREAL, u)*(0.01); IF vr<999.0 THEN pc^.speed:=vr; pc^.tspeed:=systime; END; IF verb THEN WrStr(" "); WrFixed(FLOAT(u)*(0.01*3.6), 1,0); WrStr("km/h"); END; END; |1: IF pc^.d9 THEN (* dfm09 lat, dir *) vi:=bits2val(b, 0, 32); u:=bits2val(b, 32, 16); vr:=VAL(LONGREAL, vi)*0.0000001; IF (vr<>0.0) & (vr<89.9) & (vr>-89.9) THEN pc^.lat1 :=pc^.lat; pc^.tlat1:=pc^.tlat; pc^.lat:=vr*RAD; pc^.tlat:=systime; pc^.posok:=TRUE; jumpcheck(pc^.lat, pc^.lat1, pc^.poserr); END; vr:=VAL(LONGREAL, u)*0.01; IF vr<=360.0 THEN pc^.dir:=vr; pc^.tdir:=systime; END; IF verb THEN WrStr(" Lat: ");WrFixed(pc^.lat/RAD, 5,0); WrStr(" "); WrFixed(FLOAT(u)*0.01, 1,0); WrStr(" deg"); END; END; |2: vi:=bits2val(b, 0, 32); vr:=VAL(LONGREAL, vi)*0.0000001; IF pc^.d9 THEN (* dfm09 long clb *) IF (vr<>0.0) & (vr<180.0) & (vr>-180.0) THEN pc^.lon1 :=pc^.lon; (* save 2 values for extrapolating *) pc^.tlon1:=pc^.tlon; pc^.lon:=vr*RAD; pc^.tlon:=systime; pc^.posok:=TRUE; jumpcheck(pc^.lon, pc^.lon1, pc^.poserr); END; vi:=bits2val(b, 32, 16); IF vi>=8000H THEN DEC(vi, 10000H) END; (* signed 16 *) vr:=VAL(LONGREAL, vi)*0.01; IF (vr<50.0) & (vr>-500.0) THEN pc^.clmb:=vr END; IF verb THEN WrStr(" Long:"); WrFixed(pc^.lon/RAD, 5,0); WrFixed(pc^.clmb, 1,0); WrStr(" m/s"); END; ELSE (* dfm06 lat speed *) u:=bits2val(b, 32, 16); IF (vr<>0.0) & (vr<89.9) & (vr>-89.9) THEN pc^.lat1 :=pc^.lat; pc^.tlat1:=pc^.tlat; pc^.lat:=vr*RAD; pc^.tlat:=systime; pc^.posok:=TRUE; jumpcheck(pc^.lat, pc^.lat1, pc^.poserr); END; vr:=VAL(LONGREAL, u)*(0.01); IF vr<999.0 THEN pc^.speed:=vr; pc^.tspeed:=systime; END; IF verb THEN WrStr(" Lat: ");WrFixed(pc^.lat/RAD, 5,0); WrStr(" "); WrFixed(FLOAT(u)*(0.01*3.6), 1,0); WrStr("km/h"); END; END; |3: IF pc^.d9 THEN (* dfm09 alt *) v:=bits2val(b, 0, 32); vr:=VAL(LONGREAL, v)*0.01; IF vr<50000.0 THEN pc^.alt:=vr; pc^.talt:=systime; END; IF verb THEN WrStr(" alti:");WrFixed(pc^.alt, 1,0); WrStr("m "); END; ELSE (* dfm06 long, dir *) vi:=bits2val(b, 0, 32); u:=bits2val(b, 32, 16); vr:=VAL(LONGREAL, vi)*0.0000001; IF (vr<>0.0) & (vr<180.0) & (vr>-180.0) THEN pc^.lon1 :=pc^.lon; (* save 2 values for extrapolating *) pc^.tlon1:=pc^.tlon; pc^.lon:=vr*RAD; pc^.tlon:=systime; pc^.posok:=TRUE; jumpcheck(pc^.lon, pc^.lon1, pc^.poserr); END; vr:=VAL(LONGREAL, u)*0.01; IF vr<=360.0 THEN pc^.dir:=vr; pc^.tdir:=systime; END; IF verb THEN WrStr(" Long:"); WrFixed(pc^.lon/RAD, 5,0); WrStr(" "); WrFixed(FLOAT(u)*0.01, 1,0); WrStr(" deg"); END; END; |4: IF pc^.d9 THEN ELSE (* dfm06 alt, speed *) v:=bits2val(b, 0, 32); vi:=bits2val(b, 32, 16); vr:=VAL(LONGREAL, v)*0.01; checkdf69(vr, pc^.d9); (* test if dfm6 or dfm9 *) IF vr<50000.0 THEN pc^.alt:=vr; pc^.talt:=systime; END; IF vi>=8000H THEN DEC(vi, 10000H) END; (* signed 16 *) vr:=VAL(LONGREAL, vi)*0.01; IF (vr<50.0) & (vr>-500.0) THEN pc^.clmb:=vr; END; IF verb THEN WrStr(" alti:");WrFixed(pc^.alt, 1,0); WrStr("m "); WrFixed(pc^.clmb, 1,0); WrStr(" m/s"); END; END; |8: pc^.gpsdate:=unixdate(bits2val(b, 0, 12), bits2val(b, 12, 4), bits2val(b, 16, 5)); ELSE END; END decodesub; PROCEDURE getdfserial(rxb-:ARRAY OF CHAR; p:CARDINAL; pc:pCONTEXTDFM6; VAR ser, typstr:ARRAY OF CHAR); VAR st, min, max:CARD8; ix,i,v : CARDINAL; d : CARD16; s : ARRAY[0..100] OF CHAR; dftyp, defaulttyp : pDFMTYPES; BEGIN ser[0]:=0C; typstr[0]:=0C; WITH pc^ DO st:=ORD(rxb[p]); (* frame start byte *) ix:=ORD(rxb[p+3]) DIV 16; (* hi/lo part of ser *) d:=ORD(rxb[p+1])*256 + ORD(rxb[p+2]); (* data bytes *) IF st>lastfrid THEN lastfrid:=st END; i:=0; WHILE (ist) DO INC(i) END; IF i10) & (cnt[1]>10) THEN (* first checksum error on stable ser *) INC(errcnt); (* break transmitting ser *) IF verb THEN WrStr(" ser checksum ") END; ELSE (* data changed second time kill ser *) cnt[0]:=0; cnt[1]:=0; END; END; ELSIF ix<=1 THEN (* make new entry *) WITH namereg[nameregtop] DO start:=st; cnt[0]:=0; cnt[1]:=0; errcnt:=0; dat[ix]:=d; cnt[ix]:=1; END; IF nameregtopcnt[1] THEN min:=cnt[1] END; IF min>max THEN max:=min; v:=i END; END; INC(i); END; IF (max>2) & (namereg[v].errcnt=0) THEN (* may be good enough *) Assign(ser,"[ ]"); ser[1]:=hex(namereg[v].start DIV 16); ser[2]:=hex(namereg[v].start); CardToStr(VAL(CARDINAL, namereg[v].dat[0])*10000H + VAL(CARDINAL, namereg[v].dat[1]), 1, s); Append(ser, s); dftyp:=dftypes; defaulttyp:=NIL; LOOP (* find type string *) IF dftyp=NIL THEN EXIT END; (* safe version same es serial source *) IF namereg[v].start DIV 16=dftyp^.n THEN Assign(typstr, dftyp^.t); EXIT END; (* propagated version simple highest number *) -- IF lastfrid DIV 16=dftyp^.n THEN Assign(typstr, dftyp^.t); EXIT END; IF dftyp^.n=DEFAULTSUBTYP THEN defaulttyp:=dftyp END; (* if no fitting typ found *) dftyp:=dftyp^.next; END; IF (dftyp=NIL) & (defaulttyp<>NIL) THEN Assign(typstr, defaulttyp^.t) END; END; END; IF typstr[0]=0C THEN Assign(typstr, "DFM") END; END getdfserial; PROCEDURE decodedfm6(rxb-:ARRAY OF CHAR; ip:IPNUM; fromport:UDPPORT); VAR rt : TIME; db : ARRAY[0..7*8-1] OF BOOLEAN; pc, pc1, pc0 : pCONTEXTDFM6; nam : OBJNAME; res : INTEGER; cb : ARRAY[0..9] OF CHAR; s : ARRAY[0..1000] OF CHAR; ser : ARRAY[0..15] OF CHAR; typstr : ARRAY[0..8] OF CHAR; usercall: CALLSSID; i,j, ib, sum1, sum2, val:CARDINAL; hr, exlon, exlat:LONGREAL; stemp:LONGREAL; lonok, latok:BOOLEAN; BEGIN IF rxb[0]<>"D" THEN RETURN END; (* no dfm06 frame *) i:=0; REPEAT nam[i]:=rxb[i]; INC(i) UNTIL i>HIGH(nam); IF nam[0]=0C THEN RETURN END; (* wait for id *) INC(i); j:=0; REPEAT cb[j]:=rxb[i]; INC(i); INC(j) UNTIL j>4; (* call *) getcall(cb, usercall); IF usercall[0]=0C THEN Assign(usercall, mycall) END; rt:=0; FOR j:=0 TO 3 DO rt:=rt*256+ORD(rxb[i]); INC(i); END; (* realtime *) IF verb & (fromport>0) THEN WrStr("UDP:"); ipv4tostr(ip, s); WrStr(s); WrStr(":"); WrInt(fromport, 1); IF usercall[0]<>0C THEN WrStr(" ("); WrStr(usercall); WrStr(")"); END; WrStr(" "); IF rt>0 THEN wrdate(rt); WrStr(" "); END; END; IF verb THEN WrStr(nam); WrStr(" ") END; pc:=pcontextdfm6; pc0:=NIL; LOOP IF pc=NIL THEN EXIT END; pc1:=pc^.next; IF pc^.tused+CONTEXTLIFE=pc^.actrt THEN (* not an older frame *) pc^.tused:=systime; pc^.actrt:=rt; pc^.posok:=FALSE; getdfserial(rxb, i, pc, ser, typstr); INC(i, 4); FOR j:=0 TO 6 DO FOR ib:=0 TO 7 DO db[ib+8*j]:=7-ib IN CAST(SET8, rxb[i]) END; INC(i); END; decodesub(db, pc, 0); FOR j:=0 TO 6 DO FOR ib:=0 TO 7 DO db[ib+8*j]:=7-ib IN CAST(SET8, rxb[i]) END; INC(i); END; decodesub(db, pc, 1); WITH pc^ DO IF posok & (lastsent<>systime) & (tlon+8>systime) & (tlat+8>systime) & (talt+15>systime) & (tspeed+15>systime) & (tdir+15>systime) THEN exlon:=extrapolate(lon1, lon, tlon1, tlon, systime, lonok); exlat:=extrapolate(lat1, lat, tlat1, tlat, systime, latok); (* IF lonok THEN WrStrLn("--lon good ") ELSE WrStrLn("--lon bad ") END; IF latok THEN WrStrLn("--lat good ") ELSE WrStrLn("--lat bad ") END; WrInt(systime-tlon1, 10); WrInt(systime-tlon, 10); WrFixed(lon1/RAD, 5,0); WrStr(" ");WrFixed(lon/RAD, 5,0); WrStr(" "); WrFixed(exlon/RAD, 5,0); WrStrLn("t1 t x1 x xext"); *) IF verb & NOT nofilter & (pc^.poserr>0) THEN WrStr(" Pos jump delay("); WrInt(pc^.poserr,1); WrStrLn(")"); END; IF lonok & latok & ((pc^.poserr=0) OR nofilter) THEN xdatablock.cnt:=0; senddata(exlat, exlon, alt, speed, dir, clmb, 0.0, 0.0, MAX(REAL), 0.0, 0.0, 0.0, 0.0, -FLOAT(ORD(sendmhzfromsdr)), 0.0, 0.0, actrt, 0, name, 0, 0, 0, 0.0, usercall, 0, 0.0, nofilter, FALSE, 0, typstr, ser, NIL, sdrblock, 0, xdatablock); lastsent:=systime; END; END; END; ELSIF verb THEN IF rt=0 THEN WrStr(" got no date") ELSE WrStr(" frame delayed "); WrInt(pc^.actrt-rt, 1); WrStr("s") END; END; IF verb THEN wrsdr; WrStrLn("") END; END decodedfm6; -------------------------------- RS41 CONST FULLID=536; PROCEDURE WrChChk(ch:CHAR); BEGIN IF (ch>=" ") & (ch0.0 THEN rh:=sqrt(h); xh:=x+rh; long:=atang2(xh, y)*2.0; IF long>pi THEN long:=long-pi*2 END; t:=atan(z*(EARTHA/EARTHB)/rh); st:=sin(t); ct:=cos(t); lat:=atan((z + EARTHAB*st*st*st)/(rh - (E2*EARTHA)*ct*ct*ct)); sl:=sin(lat); heig:=rh/cos(lat) - (EARTHA/sqrt(1 - E2*sl*sl)); ELSE lat:=0.0; long:=0.0; heig:=0.0 END; END wgs84r; PROCEDURE getint32(frame-:ARRAY OF CHAR; p:CARDINAL):INTEGER; VAR n:CARDINAL; i:CARDINAL; BEGIN n:=0; FOR i:=3 TO 0 BY -1 DO n:=n*256+ORD(frame[p+i]) END; RETURN n END getint32; PROCEDURE getcard16(frame-:ARRAY OF CHAR; p:CARDINAL):CARDINAL; BEGIN RETURN ORD(frame[p])+256*ORD(frame[p+1]); END getcard16; PROCEDURE getint16(frame-:ARRAY OF CHAR; p:CARDINAL):INTEGER; VAR n:CARDINAL; BEGIN n:=ORD(frame[p])+256*ORD(frame[p+1]); IF n>=32768 THEN RETURN n-65536 END; RETURN n END getint16; PROCEDURE gethex(frame-:ARRAY OF CHAR; p, nibb:CARDINAL):CARDINAL; VAR n, c:CARDINAL; BEGIN n:=0; WHILE nibb>0 DO n:=n*16; c:=ORD(frame[p]); IF (c>=ORD("0")) & (c<=ORD("9")) THEN INC(n, c-ORD("0")) ELSIF (c>=ORD("A")) & (c<=ORD("F")) THEN INC(n, c-(ORD("A")-10)) ELSE RETURN 0 END; INC(p); DEC(nibb); END; RETURN n END gethex; PROCEDURE posrs41(b-:ARRAY OF CHAR; p:CARDINAL; VAR lat, long, heig, speed, dir, clmb:LONGREAL); VAR i:CARDINAL; x, y, z, vx, vy, vz, vn, ve, vu:LONGREAL; BEGIN x:=VAL(LONGREAL, getint32(b, p))*0.01; y:=VAL(LONGREAL, getint32(b, p+4))*0.01; z:=VAL(LONGREAL, getint32(b, p+8))*0.01; wgs84r(x,y,z, lat, long, heig); IF verb THEN WrStr(" "); WrFixed(lat/RAD, 5,1); WrStr(" "); WrFixed(long/RAD, 5,1); WrStr(" "); WrFixed(heig, 1,1); WrStr("m "); END; IF (heig<-500.0) OR (heig>50000.0) THEN lat:=0.0; long:=0.0; heig:=0.0 END; --speed vx:=VAL(LONGREAL, getint16(b, p+12))*0.01; vy:=VAL(LONGREAL, getint16(b, p+14))*0.01; vz:=VAL(LONGREAL, getint16(b, p+16))*0.01; vn:=-vx*sin(lat)*cos(long) - vy*sin(lat)*sin(long) + vz*cos(lat); ve:=-vx*sin(long) + vy*cos(long); vu:= vx*cos(lat)*cos(long) + vy*cos(lat)*sin(long) + vz*sin(lat); dir:=atang2(vn, ve)/RAD; IF dir<0.0 THEN dir:=360.0+dir END; speed:=sqrt(vn*vn + ve*ve); clmb:=vu; -- hdop:=ORD(b[p+20]); IF verb THEN WrStr(" "); WrFixed(speed*3.6, 2,1); WrStr("km/h "); WrFixed(dir, 1,1); WrStr("deg "); WrFixed(vu, 1,1); WrStr("m/s "); END; END posrs41; PROCEDURE altToPres(a:LONGREAL):LONGREAL; (* meter to hPa *) BEGIN IF a<=0.0 THEN RETURN 1010.0 ELSIF a>40000.0 THEN RETURN 0.0 ELSIF a>15000.0 THEN RETURN exp(a*(-1.0/6300.0)+0.2629)*1000.0 ELSE RETURN 1010.0*exp(log((293.0-0.0065*a)*(1.0/293.0))*5.26) END; END altToPres; PROCEDURE calperc41(cs:SET51):CARDINAL; VAR i,n:CARDINAL; BEGIN n:=0; FOR i:=0 TO 50 DO IF i IN cs THEN INC(n) END; END; RETURN n*100 DIV 51 END calperc41; <* IF __GEN_C__ THEN *> PROCEDURE setinset(a-,b-:SET51; n:CARDINAL):BOOLEAN; (* c language workaround *) VAR i:CARDINAL; BEGIN FOR i:=0 TO n-1 DO IF (i IN b) & NOT (i IN a) THEN RETURN FALSE END; END; RETURN TRUE END setinset; <* END *> PROCEDURE ptu41(pc:pCONTEXTR4; pb, len:CARDINAL; rxb-:ARRAY OF CHAR; VAR tmp, pres, humid, tmphum:LONGREAL); PROCEDURE waterVaporSaturationPressure(temp:REAL):REAL; VAR p:REAL; BEGIN temp:=temp+273.15; (* kelvin *) temp:=0.0-0.4931358+(1.0+4.61E-3)*temp-1.3746454E-5*temp*temp+1.2743214E-8*temp*temp*temp; IF temp<=0.0 THEN RETURN 0.0 END; p:=exp(-5800.2206/temp+1.3914993+6.5459673*log(temp)-4.8640239E-2*temp +4.1764768E-5*temp*temp-1.4452093E-8*temp*temp*temp); RETURN p*0.01; (* hPa *) END waterVaporSaturationPressure; CONST CALT10=77; CALT11=81; CALT12=85; CALT13=89; POLYT=93; CALT20=293; CALT21=293+4; CALT22=293+8; CALT23=293+12; POLYTH=309; CALRf1=61; CALRf2=65; CALC1=69; CALC2=73; CALHUM1=117; CALHUM2=121; HUMMATRIX=125; TEMP1CAL=SET51{CALT10 DIV 16, CALT11 DIV 16,CALT12 DIV 16, CALT13 DIV 16, CALRf1 DIV 16, CALRf2 DIV 16, POLYT DIV 16..(POLYT+4*4) DIV 16}; TEMP2HUMCAL=SET51{CALT20 DIV 16, CALT21 DIV 16, CALT22 DIV 16, CALT23 DIV 16, CALRf1 DIV 16, CALRf2 DIV 16, POLYTH DIV 16..(POLYTH+4*4) DIV 16, CALC1 DIV 16, CALC2 DIV 16, CALHUM1 DIV 16, CALHUM2 DIV 16, HUMMATRIX DIV 16..(HUMMATRIX+41*4) DIV 16}; PRESSPOLY=606; (* 18 float *) PRESSCAL=SET51{PRESSPOLY DIV 16..(PRESSPOLY+4*18-1) DIV 16, FULLID DIV 16}; PROCEDURE getcal(p:CARDINAL):REAL; VAR n,i:CARDINAL; BEGIN n:=0; FOR i:=3 TO 0 BY -1 DO n:=n*256; INC(n, ORD(pc^.calibdata[p+i])); END; RETURN SaveReal(n) END getcal; PROCEDURE getcard(p,bytes:CARDINAL):CARDINAL; VAR n,i:CARDINAL; BEGIN n:=0; FOR i:=bytes-1 TO 0 BY -1 DO n:=n*256; INC(n, ORD(rxb[p+i])); END; RETURN n END getcard; VAR i,j:CARDINAL; Rf1, Rf2, f, f1, f2, r, pt, xx, psum, hum, th, hc:REAL; pw:ARRAY[0..5] OF REAL; meas:ARRAY[0..11] OF CARDINAL; BEGIN (* data positions and calculations https://github.com/einergehtnochrein *) FOR i:=0 TO HIGH(meas) DO meas[i]:=getcard(pb+i*3, 3) END; --- temp 1 <* IF __GEN_C__ THEN *> IF setinset(pc^.calibok, TEMP1CAL, 52) THEN (* needed calibs valid temperature 1 *) <* ELSE *> IF pc^.calibok*TEMP1CAL=TEMP1CAL THEN (* needed calibs valid temperature 1 *) <* END *> f:= FLOAT(meas[0]); f1:=FLOAT(meas[1]); f2:=FLOAT(meas[2]); Rf1:=getcal(CALRf1); Rf2:=getcal(CALRf2); r:=f2-f1; IF r<>0.0 THEN r:=(Rf1+(Rf2-Rf1)*(f-f1)/r)*getcal(CALT13); r:=getcal(CALT10) + r*getcal(CALT11) + r*r*getcal(CALT12); f:=r; f1:=1.0; FOR i:=0 TO 5 DO r:=r + f1*getcal(POLYT+i*4); f1:=f1*f; END; IF ABS(r)<99.0 THEN tmp:=r END; END; END; --- pres <* IF __GEN_C__ THEN *> IF setinset(pc^.calibok, PRESSCAL, 52) & (pc^.calibdata[FULLID+7]="P") & (len>39) THEN (* needed calibs valid pressure and type=SGP *) <* ELSE *> IF (pc^.calibok*PRESSCAL=PRESSCAL) & (pc^.calibdata[FULLID+7]="P") & (len>39) THEN (* needed calibs valid pressure and type=SGP *) <* END *> pt:=VAL(REAL, CAST(INT16, getcard(pb+38, 2)))*0.01; pw[0]:=getcal(PRESSPOLY+4*0) + pt*getcal(PRESSPOLY+4*7) + pt*pt*getcal(PRESSPOLY+4*11) + pt*pt*pt*getcal(PRESSPOLY+4*15); pw[1]:=getcal(PRESSPOLY+4*1) + pt*getcal(PRESSPOLY+4*8) + pt*pt*getcal(PRESSPOLY+4*12) + pt*pt*pt*getcal(PRESSPOLY+4*16); pw[2]:=getcal(PRESSPOLY+4*2) + pt*getcal(PRESSPOLY+4*9) + pt*pt*getcal(PRESSPOLY+4*13) + pt*pt*pt*getcal(PRESSPOLY+4*17); pw[3]:=getcal(PRESSPOLY+4*3) + pt*getcal(PRESSPOLY+4*10) + pt*pt*getcal(PRESSPOLY+4*14); pw[4]:=getcal(PRESSPOLY+4*4); pw[5]:=getcal(PRESSPOLY+4*5); f:= FLOAT(meas[0+3*3]); f1:=FLOAT(meas[1+3*3]); f2:=FLOAT(meas[2+3*3]); r:=f-f1; IF r<>0.0 THEN r:=(f2-f1)*getcal(PRESSPOLY+4*6)/r; xx:=1.0; psum:=0.0; FOR i:=0 TO HIGH(pw) DO psum:=psum + pw[i]*xx; xx:=xx*r END; pres:=psum; END; END; --- temp 2 on hum sensor tmphum:=MAX(REAL); <* IF __GEN_C__ THEN *> IF setinset(pc^.calibok, TEMP2HUMCAL, 52) THEN (* needed calibs valid temperature 2 *) <* ELSE *> IF pc^.calibok*TEMP2HUMCAL=TEMP2HUMCAL THEN (* needed calibs valid temperature 2 *) <* END *> f:= FLOAT(meas[0+2*3]); f1:=FLOAT(meas[1+2*3]); f2:=FLOAT(meas[2+2*3]); Rf1:=getcal(CALRf1); Rf2:=getcal(CALRf2); r:=f2-f1; IF r<>0.0 THEN r:=(Rf1+(Rf2-Rf1)*(f-f1)/r)*getcal(CALT23); r:=getcal(CALT20) + r*getcal(CALT21) + r*r*getcal(CALT22); IF ABS(r)<99.0 THEN tmphum:=r END; --WrStrLn("");WrFixed(r, 2, 10); WrStrLn(" tmphum"); (* a bit too hot *) ELSE tmphum:=MAX(REAL) END; --- hum IF (ABS(tmphum)<100.0) & (ABS(tmp)<100.0) THEN th:=tmphum; f:=th; f1:=1.0; FOR i:=0 TO 5 DO th:=th + f1*getcal(POLYTH+i*4); f1:=f1*f; END; (* modify hum sensor tmp *) f:= FLOAT(meas[0+1*3]); f1:=FLOAT(meas[1+1*3]); f2:=FLOAT(meas[2+1*3]); r:=f2-f1; IF r<>0.0 THEN r:=(f-f1)/r; hc:=getcal(CALC1)+(getcal(CALC2)-getcal(CALC1))*r; r:=getcal(CALHUM1); IF r<>0.0 THEN hc:=(hc/r - 1.0)*getcal(CALHUM2); --WrStrLn("");WrFixed(hc, 4, 14); WrStrLn(" hc"); hum:=0.0; f1:=1.0; FOR i:=0 TO 6 DO f2:=1.0; FOR j:=0 TO 5 DO hum:=hum + f1*f2*getcal(HUMMATRIX + (i*6+j)*4); f2:=f2*(th-20.0)*(1.0/180.0); END; f1:=f1*hc; END; r:=waterVaporSaturationPressure(tmp); IF r>0.0 THEN humid:=hum*waterVaporSaturationPressure(tmphum)/r END; END; END; END; --WrStrLn("");WrFixed(humid, 2, 10); WrStrLn(" hum"); END; END ptu41; PROCEDURE rs41date(f-:ARRAY OF CHAR; p:CARDINAL):TIME; VAR s:ARRAY[0..20] OF CHAR; n:CARDINAL; BEGIN s:="....-..-.. 00:00:00"; n:=ORD(f[p])+256*ORD(f[p+1]); s[0]:=CHR(n DIV 1000+ORD("0")); s[1]:=CHR(n DIV 100 MOD 10+ORD("0")); s[2]:=CHR(n DIV 10 MOD 10+ORD("0")); s[3]:=CHR(n MOD 10+ORD("0")); n:=ORD(f[p+2]); s[5]:=CHR(n DIV 10+ORD("0")); s[6]:=CHR(n MOD 10+ORD("0")); n:=ORD(f[p+3]); s[8]:=CHR(n DIV 10+ORD("0")); s[9]:=CHR(n MOD 10+ORD("0")); IF StrToTime(s, n) THEN INC(n, ORD(f[p+4])*3600); INC(n, ORD(f[p+5])*60); INC(n, ORD(f[p+6])); ELSE n:=0 END; RETURN n END rs41date; PROCEDURE decoders41(rxb-:ARRAY OF CHAR; ip:IPNUM; fromport:UDPPORT); CONST POWERTAB=ARRAY OF CARD8 {1,2,5,8,11,14,17,20}; BURSTKILL=43; TXTIME=800; (* remainin tx time position *) BURSTTXTIME=790; TXFRAMES=39; (* good calibration and ptu data description: https://github.com/einergehtnochrein *) VAR nam : OBJNAME; txtime, txoff, res : INTEGER; s : ARRAY[0..1000] OF CHAR; usercall : CALLSSID; fullid : ARRAY[0..11] OF CHAR; i,j, ic, p, sats, txpower, len, frameno : CARDINAL; calok, nameok: BOOLEAN; typ : CHAR; pc, pc1, pc0 : pCONTEXTR4; lat, long, heig, speed, dir, climb, ozonval, temperature, pressure, humidity, tmphum, vBatt : LONGREAL; satsigs : SATSIG; psatsigs : pSATSIG; BEGIN calok:=FALSE; nameok:=FALSE; nam[0]:=0C; fullid[0]:=0C; pc:=NIL; lat:=0.0; long:=0.0; ozonval:=0.0; temperature:=MAX(REAL); pressure:=MAX(REAL); humidity:=MAX(REAL); sats:=0; txpower:=0; vBatt:=0.0; frameno:=0; txoff:=MAX(INTEGER); getcall(rxb, usercall); txtime:=MAX(INTEGER); psatsigs:=NIL; IF usercall[0]=0C THEN Assign(usercall, mycall) END; IF verb & (fromport>0) THEN WrStr("UDP:"); ipv4tostr(ip, s); WrStr(s); WrStr(":"); WrInt(fromport, 1); IF usercall[0]<>0C THEN WrStr(" ("); WrStr(usercall); WrStr(")"); END; WrStrLn(""); END; xdatablock.cnt:=0; p:=039H; IF verb THEN WrStr("R41 ") END; LOOP IF p+4>=HIGH(rxb) THEN EXIT END; typ:=rxb[p]; --WrStr("TYP============="); WrHex(ORD(typ), 3); WrStr(" "); INC(p); len:=ORD(rxb[p])+2; INC(p); IF p+len>=HIGH(rxb) THEN EXIT END; IF NOT crcrs(rxb, p, p+len) THEN IF verb THEN WrStr(" ---- crc err ") END; EXIT ELSE IF typ=CHR(79H) THEN IF p>HIGH(rxb)-9 THEN EXIT END; nameok:=TRUE; FOR i:=0 TO 7 DO nam[i]:=rxb[p+2+i]; IF (nam[i]<=" ") OR (nam[i]>"Z") THEN nameok:=FALSE END; END; IF 8<=HIGH(nam) THEN nam[8]:=0C END; j:=ORD(rxb[p+(2+19)]); (* txpow 0..7 *) IF j<=HIGH(POWERTAB) THEN txpower:=POWERTAB[j] END; vBatt:=FLOAT(ORD(rxb[p+(2+8)]))*0.1; (* battery voltage *) pc:=pcontextr4; pc0:=NIL; LOOP IF pc=NIL THEN EXIT END; pc1:=pc^.next; IF pc^.tused+CONTEXTLIFEpc^.framenum THEN (* new frame number *) pc^.framesent:=FALSE; calok:=TRUE; pc^.framenum:=frameno; pc^.tused:=systime; ELSIF (pc^.framenum=frameno) & NOT pc^.framesent THEN calok:=TRUE ELSIF (frameno=0 THEN INC(pc^.txtime, frameno) (* descending countdown *) ELSIF BURSTTXTIME DIV 16 IN pc^.calibok THEN pc^.txtime:=BEFOREBURST+getint16(pc^.calibdata, BURSTTXTIME); (* show default time *) END; ELSIF j=BURSTKILL DIV 16 THEN pc^.bk:=rxb[p+24+BURSTKILL MOD 16]=1C; txtime:=getint16(rxb, p+24+TXFRAMES MOD 16); END; END; IF verb THEN WrStr(pc^.name); WrStr(" "); WrInt(pc^.framenum, 1); IF txoff<=MAX(INT16) THEN WrStr(" TxOff="); WrInt(txoff, 1); END; IF txtime<=MAX(INT16) THEN IF pc^.bk THEN WrStr(" TxTime(BK)=") ELSE WrStr(" TxTime=") END; WrInt(txtime, 1); END; END; IF FULLID DIV 16 IN pc^.calibok THEN FOR i:=0 TO 7 DO fullid[i]:=pc^.calibdata[i+FULLID] END; fullid[8]:=0C; IF verb THEN WrStr(" ["); WrStr(fullid); WrStr("]") END; END; ELSIF typ=CHR(7AH) THEN IF (pc<>NIL) & (p0.1) & (pressure<1500.0) THEN WrStr(" p="); WrFixed(pressure, 2, 1); WrStr("hPa"); END; IF ABS(humidity)<1000.0 THEN WrStr(" h="); WrFixed(humidity, 1, 1); WrStr("%"); IF ABS(humidity)<1000.0 THEN WrStr(" th="); WrFixed(tmphum, 1, 1); WrStr("C"); END; END; END; END; ELSIF typ=CHR(7CH) THEN IF pc<>NIL THEN pc^.gpssecond:=VAL(CARDINAL,getint32(rxb, p+2) DIV 1000) + (VAL(CARDINAL,DAYSEC-leapseconds) MOD DAYSEC) + getcard16(rxb, p)*(7*3600*24) + 3656*DAYSEC; (* gps TOW *) FOR i:=0 TO HIGH(satsigs) DO satsigs[i].num:=ORD(rxb[p+6+i*2]); satsigs[i].level:=ORD(rxb[p+7+i*2]); END; psatsigs:=ADR(satsigs); END; ELSIF typ=CHR(7DH) THEN -- WrStrLn("7D frame"); ELSIF typ=CHR(7BH) THEN IF (pc<>NIL) & (pNIL) & (pNIL THEN -- pc^.ozonInstType:=gethex(rxb, p+1, 2); -- pc^.ozonInstNum:=gethex(rxb, p+3, 2); res:=gethex(rxb, p+5, 4); IF res>=32768 THEN res:=32768-res END; pc^.ozonTemp:=VAL(LONGREAL, res)*0.01; pc^.ozonuA:=LFLOAT(gethex(rxb, p+9, 5))*0.0001; pc^.ozonBatVolt:=LFLOAT(gethex(rxb, p+14, 2))*0.1; pc^.ozonPumpMA:=LFLOAT(gethex(rxb, p+16, 3)); pc^.ozonExtVolt:=LFLOAT(gethex(rxb, p+19, 2))*0.1; ozonval:=calcOzone(pc^.ozonuA, pc^.ozonTemp, pc^.hp); IF verb THEN WrStr(" OZON:("); WrFixed(pc^.ozonTemp, 2, 1); WrStr("oC "); WrFixed(pc^.ozonuA, 4, 1); WrStr("uA "); WrFixed(ozonval, 3, 1); WrStr("mPa "); WrFixed(pc^.ozonBatVolt,1,1); WrStr("BatV "); WrFixed(pc^.ozonPumpMA, 0, 1); WrStr("mA "); WrFixed(pc^.ozonExtVolt, 1, 1); WrStr("ExtV"); WrStr(")"); END; END; ELSIF len=24 THEN (* Ozon id-data *) IF verb THEN WrStr(" OZONID:("); FOR i:=p+5 TO p+12 DO WrChChk(rxb[i]) END; IF ODD(ORD(rxb[17])) THEN WrStr(" NotCal") END; WrStr(" V:"); WrFixed(FLOAT(gethex(rxb, p+18, 2))*0.1, 1, 1); WrStr(")"); END; END; storexdata(xdatablock, rxb, p, len-2); ELSIF typ=CHR(76H) THEN -- WrStrLn("76 frame"); ELSIF typ=CHR(80H) THEN IF verb THEN WrStr(" Encryption frame") END; IF (encryptmsgfn[0]<>0C) & (pc<>NIL) THEN INC(pc^.encrcnt); IF pc^.encrcnt=2 THEN WrSemaFile(encryptmsgfn, pc^.name, sdrblock) END; (* write semaphore file for alarm email *) END; END; -- ELSE EXIT END; END; IF typ=CHR(76H) THEN EXIT END; (* looks like last subframe *) INC(p, len); END; IF verb THEN wrsdr; WrStrLn("") END; IF (pc<>NIL) & nameok & calok & (lat<>0.0) & (long<>0.0) & (sats>0) THEN res:=pc^.txtime; IF res0) THEN WrStr("UDP:"); ipv4tostr(ip, s); WrStr(s); WrStr(":"); WrInt(fromport, 1); IF usercall[0]<>0C THEN WrStr(" ("); WrStr(usercall); WrStr(")"); END; WrStrLn(""); END; IF rxb[FH]=ISM20 THEN (* M20 *) wid:="M20"; i:=CRCPOS20; ELSE wid:="M10"; i:=CRCPOS10; END; IF verb THEN WrStr(wid); WrStr(" ") END; cs:=crcm10(FH, i, rxb); IF cs=m10card(rxb, FH+i, 2) THEN (* crc ok *) nameok:=TRUE; FOR i:=0 TO 8 DO nam[i]:=rxb[7+i]; IF (nam[i]<=" ") OR (nam[i]>"Z") THEN nameok:=FALSE END; END; pc:=pcontextm10; pc0:=NIL; LOOP IF pc=NIL THEN EXIT END; pc1:=pc^.next; IF pc^.tused+CONTEXTLIFEpc^.framenum THEN (* new frame number *) pc^.framesent:=FALSE; calok:=TRUE; pc^.framenum:=frameno; pc^.tused:=systime; ELSIF pc^.framenum=frameno THEN IF NOT pc^.framesent THEN calok:=TRUE END; ELSIF verb THEN WrStr(" got old frame "); WrInt(frameno, 1); WrStr(" expected> "); WrInt(pc^.framenum, 1); WrStr(" "); END; IF rxb[FH]=ISM20 THEN (* M20 *) fnum:=m10card(rxb, FH+21, 1); lat:=VAL(LONGREAL, CAST(INTEGER, m10card(rxb, FH+28, 4)))*DEGMUL20; lon:=VAL(LONGREAL, CAST(INTEGER, m10card(rxb, FH+32, 4)))*DEGMUL20; alt:=VAL(LONGREAL, m10card(rxb, FH+8, 3))*0.01; ci:=m10card(rxb, FH+11, 2); IF ci>32767 THEN DEC(ci, 65536) END; ve:=VAL(LONGREAL, ci)*VMUL20; ci:=m10card(rxb, FH+13, 2); IF ci>32767 THEN DEC(ci, 65536) END; vn:=VAL(LONGREAL, ci)*VMUL20; ci:=m10card(rxb, FH+24, 2); IF ci>32767 THEN DEC(ci, 65536) END; vv:=VAL(LONGREAL, ci)*VMUL20; v:=sqrt(ve*ve + vn*vn); (* hor speed *) dir:=atang2(vn, ve)*(1.0/RAD); IF dir<0.0 THEN dir:=360.0+dir END; nameok:=TRUE; FILL(ADR(fullid), 0C, SIZE(fullid)); (* FOR i:=0 TO 8 DO fullid[i]:=rxb[7+i]; IF ((i<8) OR (nam[i]<>0C)) & ((nam[i]<=" ") OR (nam[i]>"Z")) THEN nameok:=FALSE END; END; *) i:=m10card(rxb, FH+18, 1); (* 002-2-xxxxx 911-2-xxxxx *) ii:=m10rcard(rxb, FH+19, 2); fullid[0]:=CHR(i MOD 128 DIV 12+ORD("0")); fullid[1]:=CHR((i MOD 128 MOD 12 +1) DIV 10+ORD("0")); fullid[2]:=CHR((i MOD 128 MOD 12 +1) MOD 10+ORD("0")); fullid[3]:="-"; fullid[4]:=CHR(i DIV 128 + (ii MOD 4)*2 + (1+ORD("0"))); fullid[5]:="-"; i:=ii DIV 4; fullid[6]:=CHR(i DIV 10000 MOD 10+ORD("0")); fullid[7]:=CHR(i DIV 1000 MOD 10+ORD("0")); fullid[8]:=CHR(i DIV 100 MOD 10+ORD("0")); fullid[9]:=CHR(i DIV 10 MOD 10+ORD("0")); fullid[10]:=CHR(i MOD 10+ORD("0")); fullid[11]:=0C; IF fnum MOD 8=0 THEN (* time by time show all 3 id bytes for debug *) cb[0]:="["; cb[1]:=hex(ORD(rxb[FH+18]) DIV 16); cb[2]:=hex(ORD(rxb[FH+18])); cb[3]:=hex(ORD(rxb[FH+19]) DIV 16); cb[4]:=hex(ORD(rxb[FH+19])); cb[5]:=hex(ORD(rxb[FH+20]) DIV 16); cb[6]:=hex(ORD(rxb[FH+20])); cb[7]:="]"; cb[8]:=0C; Append(fullid, cb); END; ELSE lat:=VAL(LONGREAL, CAST(INTEGER, m10card(rxb, FH+14, 4)))*DEGMUL10; lon:=VAL(LONGREAL, CAST(INTEGER, m10card(rxb, FH+18, 4)))*DEGMUL10; alt:=VAL(LONGREAL, CAST(INTEGER, m10card(rxb, FH+22, 4)))*0.001; ci:=m10card(rxb, FH+4, 2); IF ci>32767 THEN DEC(ci, 65536) END; ve:=VAL(LONGREAL, ci)*VMUL10; ci:=m10card(rxb, FH+6, 2); IF ci>32767 THEN DEC(ci, 65536) END; vn:=VAL(LONGREAL, ci)*VMUL10; ci:=m10card(rxb, FH+8, 2); IF ci>32767 THEN DEC(ci, 65536) END; vv:=VAL(LONGREAL, ci)*VMUL10; v:=sqrt(ve*ve + vn*vn); (* hor speed *) dir:=atang2(vn, ve)*(1.0/RAD); IF dir<0.0 THEN dir:=360.0+dir END; -- full id i:=ORD(rxb[FH+93+2]); fullid[0]:="0"; i:=i MOD 16; fullid[1]:=CHR(i DIV 10+ORD("0")); fullid[2]:=CHR(i MOD 10+ORD("0")); fullid[3]:="-"; -- fullid[0]:=CHR(ORD(rxb[FH+93+2]) DIV 16+ORD("0")); -- fullid[1]:="0"; -- fullid[2]:=hex(ORD(rxb[FH+93+2])); fullid[4]:=hex(ORD(rxb[FH+93+0])); i:=ORD(rxb[FH+93+3])+ORD(rxb[FH+93+4])*256; fullid[5]:="-"; fullid[6]:=CHR(i DIV 8192 MOD 8+ORD("0")); i:=i MOD 8192; fullid[7]:=CHR(i DIV 1000 MOD 10+ORD("0")); fullid[8]:=CHR(i DIV 100 MOD 10+ORD("0")); fullid[9]:=CHR(i DIV 10 MOD 10+ORD("0")); fullid[10]:=CHR(i MOD 10+ORD("0")); fullid[11]:=0C; --- m10 temp sct:=m10rcard(rxb, FH+62, 1); rt:=VAL(REAL, m10rcard(rxb, FH+63, 2) MOD 4096); IF (rt<>0.0) & (sct<3) THEN; rt:=(4095.0-rt)/rt-Rp[sct]; IF rt>0.0 THEN rt:=Rs[sct]/rt; IF rt>0.0 THEN rt:=log(rt); rt:=1.0/(1.07303516E-03 + 2.41296733E-04*rt + 2.26744154E-06*rt*rt + 6.52855181E-08*rt*rt*rt) - 273.15; IF (rt>-99.0) & (rt<50.0) THEN rtok:=rt END; END; END; END; --- m10 temp batt:=VAL(REAL, m10rcard(rxb, FH+69, 2))*0.00668; (* not checkt *) END; IF verb THEN WrStr(nam); WrStr(" "); WrInt(frameno, 1); WrStr(" "); WrFixed(lat, 5, 1); WrStr(" "); WrFixed(lon, 5, 1); WrStr(" "); WrFixed(alt, 1, 1); WrStr("m "); WrFixed(v*3.6, 1, 1); WrStr("km/h "); WrFixed(dir, 0, 1); WrStr("deg "); WrFixed(vv, 1, 1); WrStr("m/s sats "); WrInt(sats, 1); WrStr(" batt "); WrFixed(batt, 2, 1); IF rtok<100.0 THEN WrStr(" "); WrFixed(rt, 1, 1); WrStr("C") END; WrStr(" ser="); WrStr(fullid); END; ELSIF verb THEN WrStr("crc error") END; IF verb THEN wrsdr; WrStrLn("") END; IF (pc<>NIL) & nameok & calok & (lat<>0.0) & (lon<>0.0) THEN xdatablock.cnt:=0; senddata(lat*RAD, lon*RAD, alt, v, dir, vv, 0.0, 0.0, rtok, 0.0, 0.0, 0.0, 0.0, -FLOAT(ORD(sendmhzfromsdr)), 0.0, 0.0, pc^.gpssecond, 0, pc^.name, 0, sats, 0, batt, usercall, 0, 0.0, nofilter, FALSE, 0, wid, fullid, NIL, sdrblock, gpstimecorr, xdatablock); pc^.framesent:=TRUE; END; END decodem10; -------------------------------- IMET PROCEDURE sysdatetotime(VAR t:TIME); (* add system date to daytime *) CONST DT=86400; VAR st:TIME; d:INTEGER; BEGIN st:=time(); d:=VAL(INTEGER, st MOD DT)-VAL(INTEGER, t); IF d<-DT DIV 2 THEN INC(d, DT) ELSIF d>DT DIV 2 THEN DEC(d, DT) END; t:=st-VAL(CARDINAL, d); END sysdatetotime; PROCEDURE imetcard(b-:ARRAY OF CHAR; pos, len:CARDINAL):CARDINAL; VAR i, n:CARDINAL; BEGIN n:=0; FOR i:=len-1 TO 0 BY -1 DO n:=n*256 + ORD(b[pos+i]) END; RETURN n END imetcard; PROCEDURE decodeimet(rxb-:ARRAY OF CHAR; ip:IPNUM; fromport:UDPPORT); CONST FH=16; (* size of header before payload *) POLY=1021H; VAR i, j, ii:CARDINAL; lat, long, alt, ozonval:LONGREAL; time, dt, dayt:TIME; nam : OBJNAME; s : ARRAY[0..1000] OF CHAR; usercall : CALLSSID; typ : CHAR; crc : SET16; sats, len, p, gpstime : CARDINAL; oodt, vx, vy : REAL; crcok, calok, nameok : BOOLEAN; pc, pc1, pc0 : pCONTEXTIMET; BEGIN calok:=FALSE; pc:=NIL; lat:=0.0; long:=0.0; -- speed:=MAX(REAL); -- clb:=MAX(REAL); getcall(rxb, usercall); ozonval:=0.0; IF usercall[0]=0C THEN Assign(usercall, mycall) END; IF verb & (fromport>0) THEN WrStr("UDP:"); ipv4tostr(ip, s); WrStr(s); WrStr(":"); WrInt(fromport, 1); IF usercall[0]<>0C THEN WrStr(" ("); WrStr(usercall); WrStr(")"); END; WrStrLn(""); END; IF verb THEN WrStr("iMET ") END; gpstime:=0; nameok:=TRUE; FOR i:=0 TO 8 DO nam[i]:=rxb[7+i]; IF ((i<8) OR (nam[i]<>0C)) & ((nam[i]<=" ") OR (nam[i]>"Z")) THEN nameok:=FALSE END; END; pc:=pcontextimet; pc0:=NIL; LOOP IF pc=NIL THEN EXIT END; pc1:=pc^.next; IF pc^.tused+CONTEXTLIFEHIGH(rxb) THEN EXIT END; typ:=rxb[p+1]; CASE typ OF 1C: len:=12; |2C: len:=18; |3C: len:=5+ORD(rxb[p+2]); |4C: len:=20; |5C: len:=30; ELSE len:=0 END; IF len<=2 THEN EXIT END; --- crc crc:=SET16(1D0FH); FOR i:=0 TO len-3 DO crc:=crc/SHIFT(CAST(SET16, ORD(rxb[p+i])), 8); FOR j:=0 TO 7 DO IF 15 IN crc THEN crc:=SHIFT(crc,1)/SET16(POLY) ELSE crc:=SHIFT(crc,1) END; END; END; -- crc crcok:=crc=CAST(SET16, ORD(rxb[p+len-2])*256+ORD(rxb[p+len-1])); IF crcok THEN IF (typ=2C) OR (typ=5C) THEN (* gps *) IF typ=5C THEN ii:=25 ELSE ii:=13 END; gpstime:=imetcard(rxb, p+ii, 1)*3600 + imetcard(rxb, p+ii+1, 1)*60 + imetcard(rxb, p+ii+2, 1); gpstime:=VAL(CARDINAL,VAL(INTEGER,gpstime)+DAYSEC-leapseconds) MOD DAYSEC; (* seems like raw gps time with leapseconds *) dayt:=gpstime; sysdatetotime(gpstime); lat:= SaveReal(imetcard(rxb, p+2, 4)); long:=SaveReal(imetcard(rxb, p+6, 4)); alt:=VAL(REAL, VAL(INTEGER, imetcard(rxb, p+10, 2))-5000); sats:=imetcard(rxb, p+12, 1); (* always 16? *) IF typ=5C THEN (* gps with speeds *) vx:=SaveReal(imetcard(rxb, p+13, 4)); vy:=SaveReal(imetcard(rxb, p+17, 4)); pc^.dir:=atang2(vy, vx)/RAD; IF pc^.dir<0.0 THEN pc^.dir:=360.0+pc^.dir END; pc^.speed:=sqrt(vx*vx+vy*vy); pc^.clb:=SaveReal(imetcard(rxb, p+21, 4)); ELSE (* speeds out of positions *) dt:=(dayt+86400-pc^.talt) MOD 86400; (* seconds since last frame *) IF dt>0 THEN (* clb out of altitudes *) oodt:=1.0/FLOAT(dt); pc^.clb:=pc^.clb + ((alt-pc^.alt)*oodt-pc^.clb)*0.25; vx:=(long-pc^.long)*oodt*cos(lat*RAD); vy:=(lat -pc^.lat )*oodt; pc^.dir:=atang2(vy, vx)/RAD; IF pc^.dir<0.0 THEN pc^.dir:=360.0+pc^.dir END; pc^.speed:=pc^.speed + (sqrt(vx*vx+vy*vy)*(40000000/360)-pc^.speed)*0.25; (* km/h *) END; END; pc^.alt:=alt; pc^.talt:=dayt; pc^.lat:=lat; pc^.long:=long; ELSIF (typ=1C) OR (typ=4C) THEN (* ptu *) pc^.frnum:=imetcard(rxb, p+2, 2); pc^.hpa:=FLOAT(imetcard(rxb, p+4, 3))*0.01; pc^.rtok:=VAL(REAL, CAST(INT16,imetcard(rxb, p+7, 2)))*0.01; pc^.hum:=FLOAT(imetcard(rxb, p+9, 2))*0.01; pc^.vbatt:=FLOAT(imetcard(rxb, p+11, 1))*0.1; (* IF typ=4C THEN (* extended ptu *) WrStr(" ti:");WrFixed(FLOAT(imetcard(rxbuf, p+12, 2))*0.01, 2,1); WrStr(" tp:");WrFixed(FLOAT(imetcard(rxbuf, p+14, 2))*0.01, 2,1); WrStr(" tu:");WrFixed(FLOAT(imetcard(rxbuf, p+16, 2))*0.01, 2,1); END; *) ELSIF typ=3C THEN (* extensions *) IF len=13 THEN (* may be ozone *) -- WrStr(" otyp:"); WrInt(imetcard(rxbuf, p+3, 1), 1); -- WrStr(" onum:"); WrInt(imetcard(rxbuf, p+4, 1), 1); -- WrStr(" oi:"); WrFixed(FLOAT(imetcard(rxbuf, p+5, 2))*0.001); pc^.ozoneuA:=FLOAT(imetcard(rxb, p+5, 2))*0.001; pc^.otemp:=VAL(REAL, CAST(INT16,imetcard(rxb, p+7, 2)))*0.01; pc^.pumpmA:=imetcard(rxb, p+9, 1); pc^.pumpV:=FLOAT(imetcard(rxb, p+10, 1))*0.1; IF (pc^.ozoneuA>0.0) & (pc^.hpa>0.0) & (pc^.otemp>-5.0) & (pc^.otemp<50.0) THEN ozonval:=calcOzone(pc^.ozoneuA, pc^.otemp, pc^.hpa) END; (* very experimental, guess Mast/Keystone ozonsensor with unknown airflow *) ELSIF verb THEN WrStr("unknown frame"); (* unknown extension *) END; END; ELSIF verb THEN WrStr(" crc err") END; INC(p, len); END; pc^.gpssecond:=gpstime; IF pc^.frnum>pc^.framenum THEN (* new frame number *) pc^.framesent:=FALSE; pc^.framenum:=pc^.frnum; pc^.tused:=systime; calok:=TRUE; ELSIF pc^.framenum=pc^.frnum THEN IF NOT pc^.framesent THEN calok:=TRUE END; ELSIF verb THEN WrStr(" got old frame "); WrInt(pc^.frnum, 1); WrStr(" expected> "); WrInt(pc^.framenum, 1); WrStr(" "); END; IF verb THEN WrStr(nam); WrStr(" "); WrInt(pc^.frnum, 1); WrStr(" "); IF ozonval>0.0 THEN WrFixed(ozonval, 1,1); WrStr("mPa ") END; END; IF verb THEN wrsdr; WrStrLn("") END; IF (pc<>NIL) & nameok & calok & (lat<>0.0) & (long<>0.0) THEN xdatablock.cnt:=0; senddata(lat*RAD, long*RAD, alt, pc^.speed, pc^.dir, pc^.clb, 0.0, LFLOAT(pc^.hum), pc^.rtok, ozonval, pc^.otemp, LFLOAT(pc^.pumpmA), pc^.pumpV, -FLOAT(ORD(sendmhzfromsdr)), 0.0, 0.0, pc^.gpssecond, pc^.frnum, pc^.name, 0, sats, 0, pc^.vbatt, usercall, 0, pc^.hpa, nofilter, TRUE, 0, "iMET", "", NIL, sdrblock, leapseconds, xdatablock); pc^.framesent:=TRUE; END; END decodeimet; -------------------------------- MP3-H1 PROCEDURE speeddir(lat, long, vx,vy,vz:LONGREAL; VAR kmh, dir, clb:LONGREAL); VAR vn,ve,vu,sinlat,coslat,sinlong,coslong:LONGREAL; BEGIN sinlat:=sin(lat); coslat:=cos(lat); sinlong:=sin(long); coslong:=cos(long); vn:=-vx*sinlat*coslong - vy*sinlat*sinlong + vz*coslat; ve:=-vx*sinlong + vy*coslong; clb:= vx*coslat*coslong + vy*coslat*sinlong + vz*sinlat; dir:=atang2(vn, ve)/RAD; IF dir<0.0 THEN dir:=360.0+dir END; kmh:=(sqrt(vn*vn + ve*ve)*3.6); END speeddir; PROCEDURE cardmsb(b-:ARRAY OF CHAR; pos, len:CARDINAL):CARDINAL; VAR i, n:CARDINAL; BEGIN n:=0; FOR i:=len-1 TO 0 BY -1 DO n:=n*256 + ORD(b[pos+i]) END; RETURN n END cardmsb; PROCEDURE crcmp3(b-:ARRAY OF CHAR; from, to:CARDINAL):BOOLEAN; CONST POLY=0A001H; VAR i,j:CARDINAL; c:SET16; BEGIN c:=SET16(0FFFFH); FOR i:=from TO to-1 DO c:=c/CAST(SET16, ORD(b[i])); FOR j:=0 TO 7 DO IF 0 IN c THEN c:=SHIFT(c,-1)/SET16(POLY) ELSE c:=SHIFT(c,-1) END; END; END; RETURN c=CAST(SET16, cardmsb(b, to, 2)) END crcmp3; PROCEDURE cint16(v:INTEGER):INTEGER; BEGIN IF v>32767 THEN DEC(v, 65536) END; RETURN v END cint16; PROCEDURE decodemp3(rxb-:ARRAY OF CHAR; ip:IPNUM; fromport:UDPPORT); CONST FH=20; (* size of header before payload *) VAR i, j:CARDINAL; wx,wy,wz,vx,vy,vz, lat, long, alt, kmh, dir, clb:LONGREAL; s:ARRAY[0..100] OF CHAR; nam : OBJNAME; usercall : CALLSSID; sats, cnt, cfg, gpstime : CARDINAL; calok, nameok : BOOLEAN; pc, pc1, pc0 : pCONTEXTMP3; BEGIN calok:=FALSE; pc:=NIL; lat:=0.0; long:=0.0; sats:=0; getcall(rxb, usercall); IF usercall[0]=0C THEN Assign(usercall, mycall) END; IF verb & (fromport>0) THEN WrStr("UDP:"); ipv4tostr(ip, s); WrStr(s); WrStr(":"); WrInt(fromport, 1); IF usercall[0]<>0C THEN WrStr(" ("); WrStr(usercall); WrStr(")"); END; WrStrLn(""); END; nameok:=TRUE; FOR i:=0 TO 8 DO nam[i]:=rxb[7+i]; IF ((i<8) OR (nam[i]<>0C)) & ((nam[i]<=" ") OR (nam[i]>"Z")) THEN nameok:=FALSE END; END; pc:=pcontextmp3; pc0:=NIL; LOOP IF pc=NIL THEN EXIT END; pc1:=pc^.next; IF pc^.tused+CONTEXTLIFE-100000.0) THEN WrStr(" "); WrInt(VAL(INTEGER, alt), 1); WrStr("m"); END; WrStr(" "); WrFixed(kmh, 1,1); WrStr("km/h "); WrInt(VAL(INTEGER, dir), 1); WrStr("deg "); WrFixed(clb, 1,1); WrStr("m/s"); END; *) ELSIF verb THEN WrStr(" crc err") END; IF pc^.gpstime>pc^.lastgpstime THEN (* new frame number *) pc^.framesent:=FALSE; pc^.lastgpstime:=pc^.gpstime; pc^.tused:=systime; calok:=TRUE; ELSIF pc^.lastgpstime=pc^.gpstime THEN IF NOT pc^.framesent THEN calok:=TRUE END; ELSIF verb THEN WrStr(" got old frame "); WrInt(pc^.gpstime, 1); WrStr(" expected> "); WrInt(pc^.lastgpstime, 1); WrStr(" "); END; IF (pc<>NIL) & nameok & calok & (lat<>0.0) & (long<>0.0) THEN xdatablock.cnt:=0; senddata(lat, long, alt, kmh*(1.0/3.6), dir, clb, 0.0, MAX(REAL), MAX(REAL), 0.0, 0.0, 0.0, 0.0, -FLOAT(ORD(sendmhzfromsdr)), 0.0, 0.0, pc^.gpstime, 0, pc^.name, 0, sats, 0, 0.0, usercall, 0, MAX(REAL), nofilter, TRUE, 0, "MRZ", pc^.ser, NIL, sdrblock, 0, xdatablock); pc^.framesent:=TRUE; END; IF verb THEN wrsdr; WrStrLn("") END; END decodemp3; -------------------------------- MEISEI PROCEDURE decodemeisei(rxb-:ARRAY OF CHAR; ip:IPNUM; fromport:UDPPORT); CONST FH=24; (* size of header before payload *) CHKSET=20; (* checksum ok bits for subframes and frames joined bit 7 *) TYPDISC=0C0H; SYNWORDMEIS1=0049DCEH; SYNWORDMEIS2=0FB6230H; VAR i, j, frametyp, fcnt, timedif, sum:CARDINAL; lat, long, oalt, dalt, kmh, dir:LONGREAL; s : ARRAY[0..100] OF CHAR; typname : ARRAY[0..12] OF CHAR; nam : OBJNAME; ser, usercall : CALLSSID; cnt, cfg, gpstime : CARDINAL; calok, nameok : BOOLEAN; pc, pc1, pc0 : pCONTEXTMEISEI; BEGIN pc:=NIL; lat:=0.0; long:=0.0; kmh:=0.0; dir:=0.0; getcall(rxb, usercall); IF usercall[0]=0C THEN Assign(usercall, mycall) END; IF verb & (fromport>0) THEN WrStr("UDP:"); ipv4tostr(ip, s); WrStr(s); WrStr(":"); WrInt(fromport, 1); IF usercall[0]<>0C THEN WrStr(" ("); WrStr(usercall); WrStr(")"); END; WrStrLn(""); END; nameok:=TRUE; FOR i:=0 TO 8 DO nam[i]:=rxb[7+i]; IF (nam[i]<=" ") OR (nam[i]>"Z") THEN nameok:=FALSE END; END; pc:=pcontextmeisei; pc0:=NIL; LOOP IF pc=NIL THEN EXIT END; pc1:=pc^.next; IF pc^.tused+CONTEXTLIFE>");WrInt(frametyp,1);WrStr(">>"); IF frametyp=1 THEN IF fcnt=0 THEN frametyp:=3 END; ELSE pc^.fnum:=fcnt DIV 2; IF ODD(fcnt) THEN frametyp:=2 END; END; IF verb THEN WrStr(CHR(ORD("A")+frametyp)); IF 7 IN SET8(rxb[CHKSET]) THEN WrStr("*") ELSE WrStr("/") END; FOR i:=0 TO 5 DO IF i IN SET8(rxb[CHKSET]) THEN WrStr("+") ELSE WrStr("-") END; END; END; IF verb THEN WrStr(" "); WrInt(pc^.fnum, 1); END; j:=ORD(rxb[16])*1000000H + ORD(rxb[17])*10000H + ORD(rxb[18])*100H + ORD(rxb[19]); IF j<=pc^.gpstime THEN timedif:=1 ELSE timedif:=j-pc^.gpstime END; pc^.gpstime:=j; IF verb THEN WrStr(" "); wrdate(pc^.gpstime); END; ---subtype IF (SET8(rxb[CHKSET])*SET8{0,3}=SET8{0,3}) & (ORD(rxb[FH+14])=30H+ORD(frametyp=2)) THEN pc^.subtype:=1+ORD(ORD(rxb[FH+15])<=TYPDISC); IF verb THEN IF pc^.subtype=1 THEN WrStr(" ims100"); ELSE WrStr(" "); WrHex(ORD(rxb[FH+15]), 1); WrStr("=type?") END; END; END; IF (pc^.subtype=1) & (frametyp=2) & (1 IN SET8(rxb[CHKSET])) THEN (* calib *) IF fcnt MOD 64=15 THEN j:=ORD(rxb[FH+4])*100H + ORD(rxb[FH+5]) + ORD(rxb[FH+6])*1000000H + ORD(rxb[FH+7])*10000H; pc^.mhz:=400.0+SaveReal(j)*0.1; END; END; IF verb & (pc^.mhz<>0.0) THEN WrStr(" "); WrFixed(pc^.mhz,1,1); WrStr("MHz") END; IF (frametyp=1) & (SET8(rxb[CHKSET])*SET8{0..5,7}=SET8{0..5,7}) THEN FOR i:=0 TO 10 DO INC(pc^.gpssum, ORD(rxb[FH+i*2])*256+ORD(rxb[FH+1+i*2])) END; IF pc^.gpssum MOD 10000H=ORD(rxb[FH+22])*256 + ORD(rxb[FH+23]) THEN j:=0; FOR i:=0 TO 3 DO j:=j*256+ORD(rxb[FH+2+i]) END; IF pc^.subtype=1 THEN lat:=(LFLOAT(j DIV 1000000) + LFLOAT(j MOD 1000000)*(0.00001/6.0))*RAD; ELSE lat:=LFLOAT(j)*(0.0000001*RAD); END; j:=0; FOR i:=0 TO 3 DO j:=j*256+ORD(rxb[FH+6+i]) END; IF pc^.subtype=1 THEN long:=(LFLOAT(j DIV 1000000) + LFLOAT(j MOD 1000000)*(0.00001/6.0))*RAD; ELSE long:=LFLOAT(j)*(0.0000001*RAD); END; j:=0; IF pc^.subtype=1 THEN FOR i:=0 TO 2 DO j:=j*256+ORD(rxb[FH+10+i]) END; ELSE FOR i:=0 TO 3 DO j:=j*256+ORD(rxb[FH+10+i]) END; END; oalt:=LFLOAT(j)*0.01; dalt:=(oalt - pc^.alt)/LFLOAT(timedif); IF (dalt<20.0) & (dalt>-200.0) THEN pc^.clb:=pc^.clb + (dalt - pc^.clb)*0.25 END; pc^.alt:=oalt; IF pc^.subtype=1 THEN dir:=LFLOAT(ORD(rxb[FH+18])*256+ORD(rxb[FH+19]))*0.01; ELSE dir:=LFLOAT(ORD(rxb[FH+16])*256+ORD(rxb[FH+17]))*0.01; END; IF pc^.subtype=1 THEN kmh:=LFLOAT(ORD(rxb[FH+20])*256+ORD(rxb[FH+21]))*(0.01*1.851984); ELSE kmh:=LFLOAT(ORD(rxb[FH+14])*256+ORD(rxb[FH+15]))*0.01; END; ELSIF verb THEN WrStr(" checksum error") END; ELSIF frametyp=0 THEN pc^.gpssum:=ORD(rxb[FH+20])*256 + ORD(rxb[FH+21]) +ORD(rxb[FH+22])*256 + ORD(rxb[FH+23]); END; END; IF pc^.gpstime>pc^.lastgpstime THEN (* new frame number *) pc^.framesent:=FALSE; pc^.lastgpstime:=pc^.gpstime; pc^.tused:=systime; calok:=TRUE; ELSIF pc^.lastgpstime=pc^.gpstime THEN IF NOT pc^.framesent THEN calok:=TRUE END; ELSIF verb THEN WrStr(" got old frame "); WrInt(pc^.gpstime, 1); WrStr(" expected> "); WrInt(pc^.lastgpstime, 1); WrStr(" "); END; IF pc^.subtype=1 THEN typname:="IMS100" ELSE typname:="RS11" END; -- Assign(ser, pc^.name); -- Delstr(ser, 0, 3); CardToStr(gethex(pc^.name, 3, 6), 1, ser); (* serial num in decimal *) IF (pc<>NIL) & nameok & calok & (lat<>0.0) & (long<>0.0) THEN IF verb THEN WrStr(" ") END; xdatablock.cnt:=0; senddata(lat, long, pc^.alt, kmh*(1.0/3.6), dir, pc^.clb, 0.0, MAX(REAL), MAX(REAL), 0.0, 0.0, 0.0, 0.0, pc^.mhz, 0.0, 0.0, pc^.gpstime, pc^.fnum, pc^.name, 0, 0, 0, 0.0, usercall, 0, MAX(REAL), nofilter, TRUE, 0, typname, ser, NIL, sdrblock, 0, xdatablock); pc^.framesent:=TRUE; END; IF verb THEN wrsdr; WrStrLn("") END; END decodemeisei; <* IF WITHSOUND THEN *> ------------------------ local demodulator PROCEDURE stobyte(m:CHANNELS; b:CHAR); VAR i:CARDINAL; BEGIN WITH chan[m] DO rxbuf[rxp]:=b; IF (rxp>=5) OR (b=CHR(2AH)) THEN INC(rxp) ELSE rxp:=0 END; IF rxp>=240 THEN rxp:=0; decodeframe(m, 0, 0); -- FOR i:=0 TO 239 DO WrHex(ORD(rxbuf[i]), 4) END; WrStrLn(""); WrInt(maxitest, 10); WrStrLn(""); END; END; END stobyte; PROCEDURE demodbyte(m:CHANNELS; d:BOOLEAN); VAR i, maxi:CARDINAL; n, max:INTEGER; BEGIN WITH chan[m] DO rxbyte:=rxbyte DIV 2 + 256*ORD(d); max:=0; maxi:=0; FOR i:=0 TO HIGH(asynst) DO n:=asynst[i]-asynst[(i+1) MOD (HIGH(asynst)+1)]; IF ABS(n)>ABS(max) THEN max:=n; maxi:=i END; END; --maxitest:=maxi; IF rxbitc=maxi THEN IF max<0 THEN rxbyte:=CAST(CARDINAL, CAST(BITSET, rxbyte)/BITSET{0..7}) END; stobyte(m, CHR(rxbyte MOD 256)); END; IF d THEN INC(asynst[rxbitc],(32767-asynst[rxbitc]) DIV 16); ELSE DEC(asynst[rxbitc],(32767+asynst[rxbitc]) DIV 16) END; rxbitc:=(rxbitc+1) MOD (HIGH(asynst)+1); --FOR i:=0 TO HIGH(asynst) DO WrInt(asynst[i], 8) END; WrStrLn(""); END; END demodbyte; PROCEDURE demodbit(m:CHANNELS; d:BOOLEAN); BEGIN WITH chan[m] DO IF lastmanch=d THEN INC(manchestd, (32767-manchestd) DIV 16) END; lastmanch:=d; manchestd:=-manchestd; --WrInt(manchestd,8); IF manchestd>=0 THEN demodbyte(m, d); (* WrInt(ORD(d),1)*) END; END; END demodbit; PROCEDURE demod(u:REAL; m:CHANNELS); VAR d:BOOLEAN; ui:INTEGER; BEGIN (* IF debfd>=0 THEN ui:=VAL(INTEGER, u*0.002); WrBin(debfd, ui, 2); END; *) d:=u>=0.0; WITH chan[m] DO IF cbit THEN demodbit(m, d); IF d<>oldd THEN IF d=plld THEN INC(baudfine, pllshift) ELSE DEC(baudfine, pllshift) END; oldd:=d; END; (*squelch sqmed[d]:=sqmed[d] + (u-sqmed[d])*0.05; noise:=noise + (ABS(u-sqmed[d])-noise)*0.05; squelch*) ELSE plld:=d; END; cbit:=NOT cbit; END; END demod; PROCEDURE Fsk(m:CHANNELS); VAR ff:REAL; lim:INTEGER; BEGIN (* IF debfd>=0 THEN lim:=-1; WrBin(debfd, lim, 2); END; *) WITH chan[m] DO lim:=demodbaud; LOOP IF baudfine>=BAUDSAMP THEN DEC(baudfine, BAUDSAMP); ff:=Fir(afin, baudfine MOD BAUDSAMP DIV (BAUDSAMP DIV AOVERSAMP), AOVERSAMP, afir, afirtab); demod(ff, m); END; INC(baudfine, lim); lim:=0; IF baudfine=0 THEN WrBin(debfd, buf, l) END; l:=VAL(CARDINAL, l) DIV adcbytes; FOR c:=LEFT TO RIGHT DO chan[c].adcmax:=ASH(chan[c].adcmax*15, -4) END; maxl:=MIN(ADCWORD); maxr:=MIN(ADCWORD); minl:=MAX(ADCWORD); minr:=MAX(ADCWORD); i:=0; WHILE imaxl THEN maxl:=sl END; IF slchan[LEFT].adcmax THEN chan[LEFT].adcmax:=maxl-minl END; IF maxchannels>LEFT THEN sl:=buf[i+1]; chan[RIGHT].afir[afin]:=VAL(REAL, sl); IF sl>maxr THEN maxr:=sl END; IF slchan[RIGHT].adcmax THEN chan[RIGHT].adcmax:=maxr-minr END; END; afin:=(afin+1) MOD AFIRLEN; Fsk(LEFT); IF maxchannels>LEFT THEN Fsk(RIGHT) END; INC(i, ORD(maxchannels)+1); END; END getadc; <* END *> PROCEDURE readsdrdata(b:ARRAY OF CHAR; VAR len:INTEGER; VAR sdr:SDRBLOCK):BOOLEAN; VAR n, p:CARDINAL; BEGIN FILL(ADR(sdr), 0C, SIZE(sdr)); IF len<4 THEN RETURN FALSE END; n:=ORD(b[len-4])*256 + ORD(b[len-3]); IF VAL(INTEGER,n)>=len THEN RETURN FALSE END; IF n<>(255-ORD(b[len-2]))*256 + (255-ORD(b[len-1])) THEN RETURN FALSE END; p:=n; REPEAT IF b[p]="f" THEN sdr.freq:=ORD(b[p+1])*1000000H + ORD(b[p+2])*10000H + ORD(b[p+3])*100H + ORD(b[p+4]); sdr.valid:=TRUE; ELSIF b[p]="a" THEN sdr.afc:=CAST(INT16, ORD(b[p+3])*100H + ORD(b[p+4])); sdr.maxafc:=ORD(b[p+1])*100H + ORD(b[p+2]); sdr.valid:=TRUE; ELSIF b[p]="r" THEN sdr.db:=ORD(b[p+1])*1000000H + ORD(b[p+2])*10000H + ORD(b[p+3])*100H + ORD(b[p+4]); sdr.valid:=TRUE; ELSIF b[p]="n" THEN sdr.name[0]:=b[p+1]; sdr.name[1]:=b[p+2]; sdr.name[2]:=b[p+3]; sdr.name[3]:=b[p+4]; sdr.valid:=TRUE; END; INC(p, 5); UNTIL VAL(INTEGER, p)>=len; len:=n; RETURN TRUE END readsdrdata; PROCEDURE udprx; VAR fromport:UDPPORT; ip:IPNUM; len:INTEGER; s:ARRAY[0..99] OF CHAR; done:BOOLEAN; BEGIN len:=udp.udpreceive(rxsock, chan[LEFT].rxbuf, SIZE(chan[LEFT].rxbuf), fromport, ip); systime:=time(); sdrblock.valid:=FALSE; done:=FALSE; IF len>0 THEN LOOP IF len=240 THEN decodeframe(LEFT, ip, fromport); EXIT ELSIF len=22 THEN decodec34(chan[LEFT].rxbuf, ip, fromport); EXIT ELSIF len=37 THEN decodedfm6(chan[LEFT].rxbuf, ip, fromport); EXIT ELSIF len=520 THEN decoders41(chan[LEFT].rxbuf, ip, fromport); EXIT ELSIF len=117 THEN decodem10(chan[LEFT].rxbuf, ip, fromport); EXIT ELSIF len=122 THEN decodeimet(chan[LEFT].rxbuf, ip, fromport); EXIT ELSIF len=69 THEN decodemp3(chan[LEFT].rxbuf, ip, fromport); EXIT ELSIF len=48 THEN decodemeisei(chan[LEFT].rxbuf, ip, fromport); EXIT ELSE IF done OR NOT readsdrdata(chan[LEFT].rxbuf, len, sdrblock) THEN EXIT END; done:=TRUE; END; END; ELSE usleep(10000) END; END udprx; PROCEDURE Gencrctab; CONST POLY=SET16{12,5,0}; VAR i, j:CARD16; crc:SET16; BEGIN FOR i:=0 TO 255 DO crc:=CAST(SET16, i*256); FOR j:=0 TO 7 DO IF 15 IN crc THEN crc:=SHIFT(crc,1)/POLY ELSE crc:=SHIFT(crc,1) END; END; CRCTAB[i]:=SHIFT(crc, -8)+SHIFT(crc, 8); END; END Gencrctab; PROCEDURE ["C"] jsonpipebroken(signum:INTEGER); BEGIN WrStr("got signal "); WrInt(signum,0); WrStrLn("!"); END jsonpipebroken; BEGIN signal(SIGPIPE, jsonpipebroken); dftypes:=NIL; Parms; <* IF WITHSOUND THEN *> afin:=0; <* END *> -- initrsc; Gencrctab; initcontext(contextr9); pcontextc:=NIL; pcontextdfm6:=NIL; pcontextr4:=NIL; pcontextm10:=NIL; pcontextimet:=NIL; objname:=""; almread:=0; almage:=0; lastip:=0; lastport:=0; systime:=time(); --testalm; LOOP <* IF WITHSOUND THEN *> IF soundfn[0]<>0C THEN getadc; ELSIF rxsock>=0 THEN udprx END; INC(clock); IF clock MOD 64=0 THEN systime:=time(); END; <* ELSE *> udprx; <* END*> END; END sondemod.