<*+M2EXTENSIONS *> <*+STORAGE *> <*-CHECKDIV *> <*-CHECKRANGE *> <*-COVERFLOW *> <*-IOVERFLOW*> <*-PROCINLINE*> <*+NOPTRALIAS*> <*-GENHISTORY*> <*-CHECKNIL *> <*-GENDEBUG*> <*-LINENO*> <*-CHECKINDEX*> <*-CHECKDINDEX *> <*-CHECKSET*> <*CPU="PENTIUM"*> <*NEW WITHSTDOUT*> <*-WITHSTDOUT*> IMPLEMENTATION MODULE aprstext; (* aprs tracks on osm map by oe5dxl *) FROM SYSTEM IMPORT FILL, ADR, INT16; FROM maptool IMPORT MAXLAT; FROM libsrtm IMPORT getsrtm; FROM aprsdecode IMPORT DAT, TYPES, WXNIL, Decode, lums, DEGSYM, STORM, click, ERRSET, ERRFLAGS, LF, CR, MONCALL, ismultiline, pVARDAT, DRAWHINTS, pOPHIST, pFRAMEHIST, ophist, VARDAT, finddup, FRAMEHIST, CLICKTYPS, MSGREJ, realtime, trunc, DESTCALL, CLICKOBJECT; FROM aprspos IMPORT distance, azimuth, posvalid, KNOTS, WKNOTS, SKNOTS, FEET, ENCODEMICE, ENCODECOMP, EARTH, ENCODEGPSDAO, ENCODEMICEDAO, AREASYMT, AREASYM; FROM aprsstr IMPORT postoloc, POSITION, IntToStr, Append, Assign, DateToStr, FixToStr, posinval, Length, TIME, StrCmp, Delstr, InStr, TimeToStr, Extractword, StrToFix; FROM osi IMPORT ln, FdValid, File, OpenRead, Close, RdBin; --FROM osi IMPORT WrFixed, WrStr, WrStrLn, WrInt; FROM useri IMPORT localtime, confstr, fRBTYP, fRBPOSTYP, fRBPORT, fRBSPEED, fRBNAME, fMYPOS, fMYCALL, fRBALT, fRBDIR, fRBTIME, fRBPATH, fRBPOS, fRBDEST, fRBCOMMENT, fRBSYMB, fALTMIN, fMUSTBECALL, conf2int, confappend, say, wrstrlist, wrstrmon, configon; CONST PI=3.14159265358979323844; PROCEDURE strcp(from-:ARRAY OF CHAR; p, l:CARDINAL; VAR to:ARRAY OF CHAR); VAR i:CARDINAL; BEGIN i:=0; WHILE (l>0) & (i<=HIGH(to)) DO to[i]:=from[p]; INC(i); INC(p); DEC(l) END; IF i<=HIGH(to) THEN to[i]:=0C END; END strcp; PROCEDURE DateLocToStr(time:TIME; VAR s:ARRAY OF CHAR); (* append (+localtime) to time *) CONST DAY=3600*24; VAR lo:TIME; h:ARRAY[0..9] OF CHAR; BEGIN lo:=localtime(); IF time+DAY0 THEN IntToStr(VAL(INTEGER, lo) DIV 3600,0,h); Append(s, "("); Append(s, h);Append(s, ")"); END; END DateLocToStr; PROCEDURE IsBulletin(dat-:DAT):BOOLEAN; BEGIN RETURN (dat.type=MSG) & (dat.msgto[0]="B") & (dat.msgto[1]="L") & (dat.msgto[2]="N"); END IsBulletin; PROCEDURE logfndate(time:TIME; VAR fn:ARRAY OF CHAR); (* replace %d by date *) VAR p:INTEGER; s:ARRAY[0..15] OF CHAR; BEGIN p:=InStr(fn, "%d"); IF (p>=0) & (p+2=VAL(INTEGER, Length(fn))) THEN DateToStr(time, s); fn[p]:=s[0]; INC(p); fn[p]:=s[1]; INC(p); fn[p]:=s[2]; INC(p); fn[p]:=s[3]; INC(p); fn[p]:=s[5]; INC(p); fn[p]:=s[6]; INC(p); fn[p]:=s[8]; INC(p); fn[p]:=s[9]; INC(p); fn[p]:=0C; END; END logfndate; PROCEDURE FtoC(tempf:REAL):REAL; BEGIN RETURN (tempf-32.0)/1.8 END FtoC; PROCEDURE CtoF(tempc:REAL):REAL; BEGIN RETURN tempc*1.8+32.0 END CtoF; PROCEDURE isacall(s-:ARRAY OF CHAR):BOOLEAN; VAR num, lit, p:CARDINAL; c:CHAR; BEGIN p:=0; num:=0; lit:=0; LOOP c:=s[p]; IF (c>="0") & (c<="9") THEN INC(num) ELSIF (c>="A") & (c<="Z") THEN INC(lit) ELSE EXIT END; INC(p); IF p>5 THEN EXIT END; END; IF (lit<2) OR (num=0) OR (num>2) THEN RETURN FALSE END; IF s[p]="-" THEN INC(p); IF s[p]="1" THEN INC(p); IF (s[p]>="0") & (s[p]<="5") THEN INC(p) END; ELSIF (s[p]<"1") OR (s[p]>"9") THEN RETURN FALSE ELSE INC(p) END; END; RETURN (p>HIGH(s)) OR (s[p]=0C); END isacall; PROCEDURE sievert2str(v:REAL; VAR s:ARRAY OF CHAR); BEGIN IF v<0.000001 THEN FixToStr(v*1000000000.0+0.5, 0, s); Append(s, "n"); ELSIF v<0.001 THEN FixToStr(v*1000000.0+0.005, 2, s); Append(s, "u"); ELSE FixToStr(v*1000.0+0.005, 2, s); Append(s, "m") END; Append(s, "Sv/h"); END sievert2str; PROCEDURE Errtxt(VAR s:ARRAY OF CHAR; pf, frame:pFRAMEHIST); VAR h, hh:ARRAY[0..99] OF CHAR; l:CARDINAL; e:ERRSET; BEGIN IF frame<>NIL THEN e:=frame^.nodraw; IF (frame^.vardat<>NIL) & (frame^.vardat^.lastref<>NIL) & NOT posvalid(frame^.vardat^.pos) THEN INCL(e, eNOPOS) END; h[0]:=0C; IF eDIST IN e THEN Append(h, "DIST,") END; IF eSPIKE IN e THEN Append(h, "SPIKE,") END; IF eSYMB IN e THEN Append(h, "SYMBOL,") END; IF eSPEED IN e THEN Append(h, "SPEED,") END; IF eNOPOS IN e THEN Append(h, "NOPOS,") END; IF eDUPE IN e THEN Append(h, "DUPE,"); IF pf<>NIL THEN IntToStr(finddup(pf,frame), 0, hh); Append(h, hh); Append(h, "s,") END; END; IF eNODRAW IN e THEN Append(h, "SEG,") END; l:=Length(h); IF l>0 THEN h[l-1]:=0C; Append(h, ']'+TEXTCOLEND); Append(s, TEXTCOLRED+'['); Append(s, h); END; END; END Errtxt; PROCEDURE Apphex(VAR s:ARRAY OF CHAR; h-:ARRAY OF CHAR); PROCEDURE Hex(d:CARDINAL):CHAR; BEGIN d:=d MOD 16; IF d>9 THEN INC(d, ORD("A")-10-ORD("0")) END; RETURN CHR(d+ORD("0")) END Hex; VAR i, j:CARDINAL; BEGIN i:=0; j:=Length(s); WHILE (i<=HIGH(h)) & (h[i]<>0C) & (j+10CR THEN IF (h[i]<" ") OR (h[i]>=177C) THEN s[j]:=TEXTCOLBLU; INC(j); s[j]:="<"; INC(j); s[j]:=Hex(ORD(h[i]) DIV 16); INC(j); s[j]:=Hex(ORD(h[i])); INC(j); s[j]:=">"; INC(j); s[j]:=TEXTCOLEND; ELSE s[j]:=h[i] END; INC(j); END; INC(i); END; s[j]:=0C; END Apphex; PROCEDURE decode(VAR s:ARRAY OF CHAR; pf0, pf:pFRAMEHIST; oldvar:pVARDAT; odate:TIME; decoded:BOOLEAN; VAR dat:DAT); CONST TAB=LF+" "; PROCEDURE rfdist(v:pVARDAT; VAR h:ARRAY OF CHAR); VAR digi:MONCALL; ig:pOPHIST; s:ARRAY[0..31] OF CHAR; BEGIN WITH v^ DO IF (igatelen=0) OR NOT posvalid(pos) THEN RETURN END; strcp(raw, igatepos, igatelen, digi); ig:=ophist; WHILE (ig<>NIL) & (ig^.call<>digi) DO ig:=ig^.next END; IF (ig=NIL) OR NOT posvalid(ig^.lastpos) THEN RETURN END; Append(h, " Igate:"); Append(h, digi); Append(h, "("); FixToStr(distance(ig^.lastpos, pos), 4, s); Append(h, s); Append(h, "km)"); END; END rfdist; PROCEDURE objitem; BEGIN IF (dat.type=OBJ) OR (dat.type=ITEM) THEN Append(s, TAB); IF dat.objkill="1" THEN Append(s, "Killed ") END; IF (dat.type=OBJ) & (dat.areasymb.typ>="0") THEN IF dat.areasymb.typ>="5" THEN Append(s, "filled ") END; CASE (ORD(dat.areasymb.typ)-ORD("0")) MOD 5 OF 0:Append(s, "Circle"); |1:Append(s, "Line"); |2:Append(s, "Ellipse"); |3:Append(s, "Triangle"); |4:Append(s, "Box"); ELSE END; Append(s, " Area "); END; IF dat.multiline.size>0 THEN Append(s, "Multiline ") END; IF dat.type=OBJ THEN Append(s, "Object from:") ELSE Append(s, "Item from:") END; Apphex(s, dat.objectfrom); END; END objitem; VAR h:ARRAY[0..511] OF CHAR; nl, colalt:BOOLEAN; ret:INTEGER; og:INTEGER; tn:CARDINAL; resol:REAL; PROCEDURE appval(v:REAL; dez:CARDINAL; m,d:ARRAY OF CHAR); VAR h:ARRAY[0..30] OF CHAR; BEGIN IF nl THEN Append(s, TAB); nl:=FALSE END; Append(s, m); FixToStr(v, dez, h); Append(s, h); Append(s, d); END appval; BEGIN IF pf^.time>0 THEN s[0]:=TEXTCOLLGR; s[1]:=0C; DateLocToStr(pf^.time, h); Append(s, h); Append(s,":"+TEXTCOLEND); ELSE s[0]:=0C END; ret:=Decode(pf^.vardat^.raw, dat); IF decoded THEN Apphex(s, dat.symcall); og:=MAX(INTEGER); IF NOT posvalid(dat.pos) THEN dat.pos:=pf^.vardat^.pos END; IF posvalid(dat.pos) THEN postostr(dat.pos, "4", h); Append(s," "+TEXTCOLLGR); Append(s, h); Append(s, TEXTCOLEND+" ("); postoloc(h, dat.pos); Append(s, h); Append(s, ") "); og:=VAL(INTEGER, getsrtm(dat.pos, 0, resol)); END; nl:=TRUE; IF (dat.symt>" ") & (dat.sym>" ") THEN Append(s, TAB); nl:=FALSE; Append(s, TEXTINSERTSYMBOL); -- Append(s, "Sym:"); Apphex(s, dat.symt); Apphex(s, dat.sym); END; IF dat.speed0 THEN Append(s, " dir:"); IntToStr(dat.course MOD 360, 1, h); Append(s, h); Append(s, "deg"); END; END; IF dat.altitudeNIL) & posvalid(oldvar^.pos) & posvalid(dat.pos) THEN IF nl THEN Append(s, TAB); nl:=FALSE ELSE Append(s, " ") END; Append(s, "moved:"); FixToStr(distance(oldvar^.pos, dat.pos), 4, h); Append(s, h); Append(s, "km"); END; IF (odate>0) & (pf^.time>=odate) THEN IF nl THEN Append(s, TAB); nl:=FALSE ELSE Append(s, " ") END; Append(s, "since "); IntToStr(pf^.time-odate, 1, h); Append(s, h); Append(s, "s"); END; IF dat.type<>MSG THEN Errtxt(s, pf0, pf) END; nl:=TRUE; IF dat.wx.storm=WXNORMAL THEN IF (dat.type=OBJ) OR (dat.type=ITEM) THEN objitem END; IF dat.wx.gust<>WXNIL THEN nl:=FALSE; Append(s, TAB+"Gust:"); FixToStr(FLOAT(dat.wx.gust)*WKNOTS, 2, h); Append(s, h); Append(s, "km/h"); END; IF dat.wx.temp<>WXNIL THEN appval(FtoC(dat.wx.temp), 2, " Temp:", "C") END; IF dat.wx.hygro<>WXNIL THEN appval(dat.wx.hygro+0.5, 0, " Hum:", "%") END; IF dat.wx.baro<>WXNIL THEN appval(dat.wx.baro*0.1+0.05, 2, " Baro:", "hPa") END; IF dat.wx.rain1<>WXNIL THEN appval(dat.wx.rain1*0.254, 2, " Rain1h:", "mm") END; IF dat.wx.rain24<>WXNIL THEN appval(dat.wx.rain24*0.254, 2, " Rain24h:", "mm") END; IF dat.wx.raintoday<>WXNIL THEN appval(dat.wx.raintoday*0.254, 2, " Today:", "mm") END; IF dat.wx.lum<>WXNIL THEN appval(dat.wx.lum+0.5, 0, " Luminosity:", "W") END; IF dat.wx.sievert<>WXNIL THEN IF nl THEN Append(s, TAB); nl:=FALSE END; Append(s, " Gamma:"); sievert2str(dat.wx.sievert, h); Append(s, h); END; IF dat.wx.dust10>=0 THEN appval(FLOAT(dat.wx.dust10), 0, " PM10:", "ug/m3") END; IF dat.wx.dust2>=0 THEN appval(FLOAT(dat.wx.dust2), 0, " PM2.5:", "ug/m3") END; IF dat.wx.dust1>=0 THEN appval(FLOAT(dat.wx.dust1), 0, " PM1:", "ug/m3") END; IF dat.wx.dust01>=0 THEN appval(FLOAT(dat.wx.dust01), 0, " PM0.1:", "ug/m3") END; ELSIF dat.wx.storm>WXNORMAL THEN IF (dat.type=OBJ) OR (dat.type=ITEM) THEN objitem END; nl:=FALSE; Append(s, TAB); IF dat.wx.storm=WXTS THEN Append(s, "Tropical Storm"); ELSIF dat.wx.storm=WXHC THEN Append(s, "Hurricane"); ELSIF dat.wx.storm=WXTD THEN Append(s, "Tropical Depression") END; nl:=FALSE; IF dat.wx.gust<>WXNIL THEN Append(s, " Gust:"); FixToStr(FLOAT(dat.wx.gust)*SKNOTS, 2, h); Append(s, h); Append(s, "km/h"); END; IF dat.wx.sustaind<>0.0 THEN Append(s, " Sustaind Speed:"); FixToStr(FLOAT(dat.wx.sustaind)*SKNOTS, 2, h); Append(s, h); Append(s, "km/h"); END; IF dat.wx.baro<>WXNIL THEN Append(s, " Baro:"); FixToStr(dat.wx.baro, 2, h); Append(s, h); Append(s, "hPa"); END; IF dat.wx.radiushurr<>0.0 THEN Append(s, " Radius Hurricane Winds:"); FixToStr(FLOAT(dat.wx.radiushurr)*SKNOTS, 2, h); Append(s, h); Append(s, "km"); END; IF dat.wx.radiusstorm<>0.0 THEN Append(s, " Storm Winds:"); FixToStr(FLOAT(dat.wx.radiusstorm)*SKNOTS, 2, h); Append(s, h); Append(s, "km"); END; IF dat.wx.wholegale<>0.0 THEN Append(s, " Whole gale:"); FixToStr(FLOAT(dat.wx.wholegale)*SKNOTS, 2, h); Append(s, h); Append(s, "km"); END; ELSIF dat.type=MSG THEN Append(s, TAB+" Msg To:"); Apphex(s, dat.msgto); IF dat.msgtext[0]<>0C THEN Append(s, " Text:["); Apphex(s, dat.msgtext); Append(s, "]"); END; IF dat.acktext[0]<>0C THEN Append(s, " Ack:["); Apphex(s, dat.acktext); Append(s, "]"); END; IF dat.ackrej=MSGREJ THEN Append(s, " Reject") END; ELSIF (dat.type=OBJ) OR (dat.type=ITEM) THEN objitem END; IF (dat.type<>MSG) & (dat.comment[0]<>0C) THEN IF dat.type=TELE THEN Append(s, TAB+"Telemetry: [") ELSE Append(s, TAB+"Comment: [") END; Apphex(s, dat.comment); Append(s, "]"); END; IF dat.tlmvalues[0]<>0 THEN Append(s, TAB+" Mic-e Telemetry Seq:"); ret:=0; LOOP IF dat.tlmvalues[ret]<>0 THEN IF ret<>HIGH(dat.tlmvalues) THEN IntToStr(dat.tlmvalues[ret]-1, 1, h); Append(s, h); ELSE tn:=dat.tlmvalues[ret]-1; IF tn>=256 THEN tn:=tn MOD 8192+8192 ELSE tn:=tn MOD 256+256 END; WHILE tn>1 DO Append(s, CHR(ORD(ODD(tn))+ORD("0"))); tn:=tn DIV 2 END; END; END; INC(ret); IF ret>HIGH(dat.tlmvalues) THEN EXIT END; Append(s, ","); END; END; Append(s, TAB); END; Append(s, "["); Apphex(s, pf^.vardat^.raw); Append(s, "]"); IF NOT decoded THEN Errtxt(s, pf0, pf) END; END decode; PROCEDURE decodelistline(VAR s:ARRAY OF CHAR; text:ARRAY OF CHAR; time:TIME); VAR i:CARDINAL; dat:DAT; f:FRAMEHIST; vardat:VARDAT; BEGIN i:=0; WHILE (i<=HIGH(text)) & (text[i]<>0C) & (text[i]<>"[") DO INC(i) END; IF (i>HIGH(text)) OR (text[i]=0C) THEN i:=0 END; Delstr(text, 0, i+1); (* remove port/time[ *) i:=Length(text); IF i>1 THEN text[i-1]:=0C; (* remove ] *) FILL(ADR(vardat), 0C, SIZE(vardat)); Assign(vardat.raw, text); FILL(ADR(f), 0C, SIZE(f)); f.vardat:=ADR(vardat); f.time:=time; decode(s, NIL, ADR(f), NIL, 0, TRUE, dat); END; END decodelistline; PROCEDURE setmark1(pos:POSITION; overwrite:BOOLEAN; alt:INTEGER; timestamp:TIME); BEGIN IF overwrite OR NOT posvalid(click.markpos) OR (click.marktime<>0) THEN click.markpos:=pos; IF overwrite THEN click.marktime:=0 ELSE click.marktime:=realtime END; click.markalti:=alt; click.markpost:=timestamp; END; END setmark1; PROCEDURE setmarkalti(pf:pFRAMEHIST; op:pOPHIST; overwrite:BOOLEAN); VAR dat:DAT; alt:INTEGER; pos:POSITION; t:TIME; BEGIN posinval(pos); alt:=MAX(INTEGER); t:=realtime; IF (pf<>NIL) & (Decode(pf^.vardat^.raw, dat)=0) THEN IF dat.altitude>-10000 THEN alt:=dat.altitude END; pos:=dat.pos; t:=pf^.time; ELSIF (op<>NIL) & (op^.lastinftyp<100) THEN alt:=VAL(INTEGER, op^.lasttempalt)+(32768-10000) END; IF NOT posvalid(pos) & (op<>NIL) THEN pos:=op^.lastpos END; setmark1(pos, overwrite, alt, t); END setmarkalti; PROCEDURE optext(typ:CARDINAL; findword-:ARRAY OF CHAR; VAR obj:CLICKOBJECT; VAR last:BOOLEAN; VAR s:ARRAY OF CHAR); VAR op:pOPHIST; pf, pf1, pfe:pFRAMEHIST; cx, cn:CARDINAL; ss:ARRAY[0..999] OF CHAR; dat:DAT; -- islast:BOOLEAN; BEGIN op:=obj.opf; pf:=obj.pff0; IF (pf=NIL) & (op<>NIL) THEN pf:=op^.frames END; s[0]:=0C; -- islast:=last; last:=FALSE; IF (op<>NIL) & (pf<>NIL) THEN IF typ=2 THEN (* find last raw frame *) pf:=op^.frames; IF pf<>NIL THEN WHILE pf^.next<>NIL DO pf:=pf^.next END; obj.pff0:=pf; END; ELSIF typ=1 THEN (* next frame *) pf1:=pf; REPEAT IF pf^.next=NIL THEN pf:=op^.frames ELSE pf:=pf^.next END; -- UNTIL NOT lums.errorstep OR (pf1=pf) OR (pf^.nodraw-ERRSET{eNOPOS}<>ERRSET{}); UNTIL (pf1=pf) OR (NOT lums.errorstep OR (pf^.nodraw-ERRSET{eNOPOS}<>ERRSET{})) & ((findword[0]=0C) OR (InStr(pf^.vardat^.raw, findword)>=0)); IF pf<>NIL THEN obj.pff0:=pf; obj.pff:=pf; obj.typf:=tTRACK; (* set "track found" *) END; ELSIF typ=0 THEN (* back to last frame *) pf1:=pf; pfe:=pf; REPEAT IF (NOT lums.errorstep OR (pfe^.nodraw-ERRSET{eNOPOS}<>ERRSET{})) & ((findword[0]=0C) OR (InStr(pfe^.vardat^.raw, findword)>=0)) THEN pf:=pfe END; IF pfe^.next=NIL THEN pfe:=op^.frames ELSE pfe:=pfe^.next END; UNTIL pfe=pf1; obj.pff0:=pf; obj.pff:=pf; obj.typf:=tTRACK; (* set "track found" *) END; IF lums.errorstep & (pf<>NIL) & (pf^.nodraw-ERRSET{eNOPOS}=ERRSET{}) THEN Assign(s, "Show errors mode: no (more) errors found"); ELSIF (findword[0]<>0C) & (pf<>NIL) & (InStr(pf^.vardat^.raw, findword)<0) THEN Assign(s, "no frames with <"); Append(s, findword); Append(s, "> found"); ELSIF pf<>NIL THEN cn:=0; cx:=0; pfe:=NIL; pf1:=op^.frames; WHILE pf1<>NIL DO INC(cn); IF pf1=pf THEN cx:=cn END; IF pf1^.next=pf THEN pfe:=pf1 END; pf1:=pf1^.next; END; IntToStr(cx, 0, s); Append(s,"/"); IntToStr(cn, 0, ss); Append(s, ss); Append(s, " "); IF pfe=NIL THEN decode(ss, op^.frames, pf, NIL, 0, TRUE, dat); ELSE decode(ss, op^.frames, pf, pfe^.vardat, pfe^.time, TRUE, dat) END; Append(s, ss); last:=pf^.next=NIL; END; END; END optext; PROCEDURE oppo(opcall-:MONCALL):pOPHIST; (* find pointer to call *) VAR op:pOPHIST; BEGIN IF opcall[0]=0C THEN RETURN NIL END; op:=ophist; WHILE (op<>NIL) & (op^.call<>opcall) DO op:=op^.next END; RETURN op END oppo; PROCEDURE listop(decoded:BOOLEAN); VAR op:pOPHIST; pf:pFRAMEHIST; oldv:pVARDAT; oldt:TIME; s:ARRAY[0..999] OF CHAR; dat:DAT; BEGIN op:=click.table[click.selected].opf; IF op<>NIL THEN pf:=op^.frames; oldv:=NIL; oldt:=0; WHILE pf<>NIL DO decode(s, op^.frames, pf, oldv, oldt, decoded, dat); IF posvalid(pf^.vardat^.pos) THEN oldv:=pf^.vardat END; oldt:=pf^.time; Append(s, LF); IF decoded THEN Append(s, LF) END; wrstrlist(s, dat.symcall, pf^.vardat^.pos, pf^.time); <* IF WITHSTDOUT THEN *> WrStr(s); <* END *> pf:=pf^.next; END; END; END listop; PROCEDURE listin(r-:ARRAY OF CHAR; port, dir:CHAR; decoded:BOOLEAN; quali, txd, level:INTEGER); VAR s, s1,s2:ARRAY[0..999] OF CHAR; vard:VARDAT; pf:FRAMEHIST; i,j:CARDINAL; dat:DAT; BEGIN FILL(ADR(vard), 0C, SIZE(vard)); i:=0; j:=0; WHILE (i0C) DO IF (r[i]<>CR) & (r[i]<>LF) THEN j:=i END; vard.raw[i]:=r[i]; INC(i); END; vard.raw[j+1]:=0C; FILL(ADR(pf), 0C, SIZE(pf)); pf.vardat:=ADR(vard); decode(s, NIL, ADR(pf), NIL, 0, decoded, dat); IF decoded THEN s1[0]:=LF; s1[1]:=port; s1[2]:=0C; ELSE s1[0]:=port; s1[1]:=0C END; IF dir="<" THEN Append(s1, TEXTCOLRED+"<"+TEXTCOLEND) ELSE Append(s1, dir) END; IF (txd>0) OR (quali>0) THEN Append(s1, "("); IF txd>0 THEN IntToStr(txd, 3, s2) ELSE s2:=" " END; Append(s1, s2); Append(s1, "/"); IF level<>0 THEN IntToStr(level, 3, s2) ELSE s2:=" " END; Append(s1, s2); Append(s1, "/"); IF quali>0 THEN IntToStr(quali, 2, s2) ELSE s2:=" " END; Append(s1, s2); Append(s1, ")"); END; Append(s1, s); wrstrmon(s1, dat.pos); <* IF WITHSTDOUT THEN *> WrStr(s1); <* END *> END listin; PROCEDURE listtyps(typ:CHAR; decod:BOOLEAN; oneop:ARRAY OF CHAR); CONST TRIVIAL=0.02/(EARTH); (* 20m *) VAR op:pOPHIST; pf:pFRAMEHIST; s:ARRAY[0..999] OF CHAR; lastto, lasttext:ARRAY[0..100] OF CHAR; dat:DAT; BEGIN op:=ophist; WHILE op<>NIL DO pf:=op^.frames; IF typ="N" THEN (* no pos *) IF (pf<>NIL) & NOT posvalid(op^.lastpos) THEN WHILE pf^.next<>NIL DO pf:=pf^.next END; (* show last frame *) decode(s, NIL, pf, NIL, 0, decod, dat); IF decod THEN Append(s, LF+LF) ELSE Append(s, LF) END; wrstrlist(s, dat.symcall, pf^.vardat^.pos, pf^.time); <* IF WITHSTDOUT THEN *> WrStr(s); <* END *> END; ELSIF typ="D" THEN (* moveing stations *) IF (pf<>NIL) & ((op^.margin0.lat>op^.margin1.lat+TRIVIAL) OR (op^.margin0.long+TRIVIALNIL DO pf:=pf^.next END; (* show last frame *) decode(s, NIL, pf, NIL, 0, decod, dat); IF decod THEN Append(s, LF+LF) ELSE Append(s, LF) END; wrstrlist(s, dat.symcall, pf^.vardat^.pos, pf^.time); <* IF WITHSTDOUT THEN *> WrStr(s); <* END *> END; ELSIF typ="W" THEN IF pf<>NIL THEN WHILE pf^.next<>NIL DO pf:=pf^.next END; (* show last frame *) decode(s, NIL, pf, NIL, 0, decod, dat); -- IF (dat.symt="/") & (dat.sym="_") -- OR (op^.temptime+SHOWTEMPWIND>systime) & (op^.lastinftyp>=100) -- & (op^.lasttempalt>=-99) & (op^.lasttempalt<=99) THEN IF (dat.symt="/") & (dat.sym="_") THEN IF decod THEN Append(s, LF+LF) ELSE Append(s, LF) END; wrstrlist(s, dat.symcall, pf^.vardat^.pos, pf^.time); <* IF WITHSTDOUT THEN *> WrStr(s); <* END *> END; END; ELSIF (typ="M") OR (typ="T") OR ((typ="B") & ((oneop[0]=0C) OR (oneop=op^.call))) THEN (* bulletins messages *) lastto[0]:=0C; lasttext[0]:=0C; WHILE pf<>NIL DO IF (pf^.vardat^.lastref=pf) & (Decode(pf^.vardat^.raw, dat)>=0) -- & ((typ="M") OR (typ="B")) & (dat.type=MSG) & (dat.type=MSG) & (dat.symcall<>dat.msgto) & (dat.msgtext[0]<>0C) & ((typ="T") OR ((typ="B")=IsBulletin(dat))) & ((oneop[0]=0C) OR (oneop=op^.call) OR (oneop=dat.msgto)) THEN IF NOT (StrCmp(lastto, dat.msgto) & StrCmp(lasttext, dat.msgtext)) THEN DateLocToStr(pf^.time, s); Append(s, " "); Append(s, dat.symcall); Append(s, ">"); Append(s, dat.msgto); Append(s, ":["); Apphex(s, dat.msgtext); Append(s, "]"); IF dat.acktext[0]<>0C THEN Apphex(s, " Ack[");Append(s, dat.acktext); Append(s, "]"); END; Append(s, LF); wrstrlist(s, dat.symcall, pf^.vardat^.pos, pf^.time); <* IF WITHSTDOUT THEN *> WrStr(s); <* END *> Assign(lastto, dat.msgto); Assign(lasttext, dat.msgtext); END; END; pf:=pf^.next; END; ELSIF typ="O" THEN IF pf<>NIL THEN WHILE pf^.next<>NIL DO pf:=pf^.next END; (* show last frame *) decode(s, NIL, pf, NIL, 0, decod, dat); IF ((dat.type=OBJ) OR (dat.type=ITEM)) & ((oneop[0]=0C) OR (oneop=dat.objectfrom)) THEN IF decod THEN Append(s, LF+LF); wrstrlist(s, dat.symcall, pf^.vardat^.pos, pf^.time); ELSE Append(s, LF); wrstrlist(s, dat.objectfrom, pf^.vardat^.pos, pf^.time); END; <* IF WITHSTDOUT THEN *> WrStr(s); <* END *> END; END; END; op:=op^.next; END; END listtyps; 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="4" THEN (* D.DDDDD*) FixToStr(d*180.0/PI,6,s); ELSE 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; i:=ORD(NOT lat); IF form="2" THEN (* DDMM.MMNDDDMM.MME *) -- n:=trunc(d*(6000*180/PI)+0.5); n:=trunc(d*(6000*180/PI)); s[0]:=CHR(n DIV 600000 MOD 10+Z); 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.MMMNDDDMM.MMME *) n:=trunc(d*(60000*180/PI)+0.5); s[0]:=CHR(n DIV 6000000 MOD 10+Z); 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 n:=trunc(d*(60*60*180/PI)+0.5); s[0]:=CHR(n DIV (60*6000) MOD 10+Z); 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]:=DEGSYM; 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; END degtostr; PROCEDURE postostr(pos:POSITION; form:CHAR; VAR s:ARRAY OF CHAR); VAR h:ARRAY[0..31] OF CHAR; BEGIN degtostr(pos.lat, TRUE, form, s); IF form="4" THEN Append(s,",") ELSE Append(s,"/") END; degtostr(pos.long, FALSE, form, h); Append(s, h); END postostr; PROCEDURE myround(x:REAL):INTEGER; BEGIN IF x>=0.0 THEN x:=x+0.5 ELSE x:=x-0.5 END; RETURN VAL(INTEGER, x) END myround; PROCEDURE measure(pos0, pos1:POSITION; VAR s:ARRAY OF CHAR; sum:BOOLEAN); VAR h:ARRAY[0..31] OF CHAR; BEGIN IF posvalid(pos0) & posvalid(pos1) THEN postostr(pos1, "3", s); Append(s," ["); postoloc(h, pos1); Append(s, h); Append(s,"] "); FixToStr(distance(pos0, pos1), 4, h); Append(s, h); Append(s, "km,"); IntToStr(myround(azimuth(pos0, pos1)), 1, h); Append(s, h); Append(s, "deg to Marker"); IF sum THEN IF click.waysum=0.0 THEN click.sumpos:=pos0 END; click.waysum:=click.waysum+distance(click.sumpos, pos1); click.sumpos:=pos1; Append(s, " sum:"); FixToStr(click.waysum, 4, h); Append(s, h); Append(s, "km"); END; ELSE s[0]:=0C END; END measure; PROCEDURE degtopos(s:ARRAY OF CHAR; VAR pos:POSITION); (* DDMM.MMNDDDMM.MME *) VAR err:BOOLEAN; d:CARDINAL; PROCEDURE c(ch:CHAR):CARDINAL; VAR n:CARDINAL; BEGIN IF ch>="0" THEN n:=ORD(ch)-ORD("0") ELSE n:=0; err:=TRUE END; IF n>9 THEN err:=TRUE END; RETURN n; END c; BEGIN err:=FALSE; d:=c(s[0])*60000 + c(s[1])*6000 + c(s[2])*1000 + c(s[3])*100 + c(s[5])*10 + c(s[6]); pos.lat:=FLOAT(d)*(PI/180.0/6000.0); IF pos.lat>=PI/2.0 THEN err:=TRUE END; IF CAP(s[7])="S" THEN pos.lat:=-pos.lat ELSIF CAP(s[7])<>"N" THEN err:=TRUE END; d:=c(s[9])*600000 + c(s[10])*60000 + c(s[11])*6000 + c(s[12])*1000 + c(s[13])*100 + c(s[15])*10 + c(s[16]); pos.long:=FLOAT(d)*(PI/180.0/6000.0); IF pos.long>=PI THEN err:=TRUE END; IF CAP(s[17])="W" THEN pos.long:=-pos.long ELSIF CAP(s[17])<>"E" THEN err:=TRUE END; IF (s[2]>="6") OR (s[12]>="6") OR err THEN posinval(pos) END; END degtopos; PROCEDURE deghtopos(s:ARRAY OF CHAR; VAR pos:POSITION); (* DDMM.MMMNDDDMM.MMME *) VAR err, e:BOOLEAN; d, i:CARDINAL; PROCEDURE c(mul:CARDINAL):BOOLEAN; VAR n:CARDINAL; ch:CHAR; BEGIN ch:=s[i]; IF mul>0 THEN IF ch>="0" THEN n:=ORD(ch)-ORD("0") ELSE RETURN FALSE END; IF n>9 THEN RETURN FALSE END; INC(d, n*mul); ELSIF ch<>"." THEN RETURN FALSE END; INC(i); RETURN TRUE; END c; BEGIN err:=FALSE; d:=0; i:=0; e:=c(600000) & c(60000) & c(10000) & c(1000) & c(0) & c(100) & c(10) & c(1); pos.lat:=FLOAT(d)*(PI/180.0/60000.0); IF pos.lat>=PI/2.0 THEN err:=TRUE END; IF s[i]="S" THEN pos.lat:=-pos.lat ELSIF s[i]<>"N" THEN err:=TRUE END; INC(i, 2); d:=0; e:=c(6000000) & c(600000) & c(60000) & c(10000) & c(1000) & c(0) & c(100) & c(10) & c(1); pos.long:=FLOAT(d)*(PI/180.0/60000.0); IF pos.long>=PI THEN err:=TRUE END; IF s[i]="W" THEN pos.long:=-pos.long ELSIF s[i]<>"E" THEN err:=TRUE END; IF (s[2]>="6") OR (s[13]>="6") OR err THEN posinval(pos) END; END deghtopos; PROCEDURE cleanposstr(VAR s:ARRAY OF CHAR); VAR i:CARDINAL; BEGIN i:=0; WHILE (i<=HIGH(s)) & (s[i]<>0C) DO IF (s[i]=",") OR (s[i]="/") OR (s[i]="\") THEN s[i]:=" " END; INC(i); END; END cleanposstr; PROCEDURE degdeztopos(s:ARRAY OF CHAR; VAR pos:POSITION); (* lat long in float deg *) VAR d:REAL; h:ARRAY[0..30] OF CHAR; BEGIN cleanposstr(s); Extractword(s, h); IF StrToFix(d, h) THEN pos.lat:=d*(PI/180.0); Extractword(s, h); IF StrToFix(d, h) THEN pos.long:=d*(PI/180.0); IF (ABS(pos.long)"9")) DO INC(p) END; IF p>HIGH(s) THEN RETURN FALSE END; n:=0; REPEAT n:=n*10 + ORD(s[p])-ORD("0"); INC(p); UNTIL (p>HIGH(s)) OR (s[p]<"0") OR (s[p]>"9"); RETURN TRUE; END num; BEGIN p:=0; IF NOT num(p,n) THEN RETURN END; la:=n*3600; IF NOT num(p,n) THEN RETURN END; INC(la, n*60); IF NOT num(p,n) THEN RETURN END; INC(la, n); WHILE (p<=HIGH(s)) & (s[p]<>"N") & (s[p]<>"S") DO INC(p) END; IF p>HIGH(s) THEN RETURN END; IF s[p]<>"N" THEN IF s[p]="S" THEN la:=-la ELSE RETURN END END; INC(p); IF NOT num(p,n) THEN RETURN END; lo:=n*3600; IF NOT num(p,n) THEN RETURN END; INC(lo, n*60); IF NOT num(p,n) THEN RETURN END; INC(lo, n); WHILE (p<=HIGH(s)) & (s[p]<>"W") & (s[p]<>"E") DO INC(p) END; IF p>HIGH(s) THEN RETURN END; IF s[p]<>"E" THEN IF s[p]="W" THEN lo:=-lo ELSE RETURN END END; ph.lat:=(VAL(REAL, la)+0.5)*(PI/180.0/3600.0); ph.long:=(VAL(REAL, lo)+0.5)*(PI/180.0/3600.0); IF (ABS(ph.lat)<=MAXLAT) & (ABS(ph.long)=0) + nb DIV 100 MOD 10); s[4]:=CHR(48 + 32*ORD((nl<10) OR (nl>=100)) + nb DIV 10 MOD 10); s[5]:=CHR(48 + 32*ORD(long<0) + nb MOD 10); s[6]:=0C; END micedest; PROCEDURE micedata(lat, long:INTEGER; knots, dir:CARDINAL; alt:INTEGER; sym:ARRAY OF CHAR; VAR s:ARRAY OF CHAR); VAR nl, n:CARDINAL; BEGIN dir:=dir MOD 360; --IF dir>0 THEN DEC(dir) END; --IF dir>359 THEN dir:=359 END; IF knots>799 THEN knots:=0 END; nl:=ABS(long) DIV 6000; IF nl<10 THEN s[0]:=CHR(nl+118); ELSIF nl>=100 THEN IF nl<110 THEN s[0]:=CHR(nl+8) ELSE s[0]:=CHR(nl-72) END; ELSE s[0]:=CHR(nl+28) END; nl:=VAL(CARDINAL, ABS(long))-nl*6000; (* long min*100 *) n:=nl DIV 100; IF n<10 THEN INC(n, 60) END; s[1]:=CHR(n+28); s[2]:=CHR(nl MOD 100+28); s[3]:=CHR(knots DIV 10 + 28); s[4]:=CHR(32 + knots MOD 10*10 + dir DIV 100); s[5]:=CHR(28 + dir MOD 100); s[6]:=sym[1]; s[7]:=sym[0]; IF alt>-10000 THEN n:=alt+10000; s[8]:=CHR(33 + n DIV (91*91) MOD 91); s[9]:=CHR(33 + n DIV 91 MOD 91); s[10]:=CHR(33 + n MOD 91); s[11]:="}"; s[12]:=0C; ELSE s[8]:=0C END; END micedata; PROCEDURE alt2str(feet:INTEGER; VAR s:ARRAY OF CHAR); BEGIN IF feet>-100000 THEN s[0]:="/"; s[1]:="A"; s[2]:="="; IF feet<0 THEN feet:=-feet; s[3]:="-"; ELSE s[3]:=num(feet DIV 100000) END; (* /A=-nnnnn *) s[4]:=num(feet DIV 10000); s[5]:=num(feet DIV 1000); s[6]:=num(feet DIV 100); s[7]:=num(feet DIV 10); s[8]:=num(feet); s[9]:=0C; ELSE s[0]:=0C END; END alt2str; PROCEDURE speeddir2str(knots, dir:INTEGER; areaobj:BOOLEAN; VAR s:ARRAY OF CHAR); BEGIN IF areaobj OR (dir>0) & (dir<=360) THEN -- IF dir=0 THEN dir:=360 END; s[0]:=num(dir DIV 100); s[1]:=num(dir DIV 10); s[2]:=num(dir); ELSE s[0]:="."; s[1]:="."; s[2]:="." END; IF areaobj & (knots>=1000) THEN s[3]:=num(knots DIV 1000) ELSE s[3]:="/" END; s[4]:=num(knots DIV 100); s[5]:=num(knots DIV 10); s[6]:=num(knots); s[7]:=0C; END speeddir2str; PROCEDURE compressdata(pos:POSITION; knots, dir:CARDINAL; feet:INTEGER; sym:ARRAY OF CHAR; VAR s:ARRAY OF CHAR); VAR n:INTEGER; h:ARRAY[0..200] OF CHAR; BEGIN pos.lat :=pos.lat *(180/PI); pos.long:=pos.long*(180/PI); s[0]:=sym[0]; IF pos.lat<90.0 THEN n:=trunc((90.0-pos.lat)*380926.0) ELSE n:=0 END; s[1]:=CHR(33+n DIV (91*91*91)); s[2]:=CHR(33+n DIV (91*91) MOD 91); s[3]:=CHR(33+n DIV 91 MOD 91); s[4]:=CHR(33+n MOD 91); IF pos.long>-180.0 THEN n:=trunc((180.0+pos.long)*190463.0) ELSE n:=0 END; s[5]:=CHR(33+n DIV (91*91*91)); s[6]:=CHR(33+n DIV (91*91) MOD 91); s[7]:=CHR(33+n DIV 91 MOD 91); s[8]:=CHR(33+n MOD 91); s[9]:=sym[1]; IF knots>0 THEN IF dir>=360 THEN dir:=0 END; s[10]:=CHR(33+dir DIV 4); s[11]:=CHR(33+trunc(ln(FLOAT(knots+1))*12.9935872129)); s[12]:=CHR(33+32+24+6); ELSIF feet>0 THEN n:=trunc(ln(FLOAT(feet))*500.5 + 0.5); IF n>=91*91 THEN n:=91*91-1 END; s[10]:=CHR(33+n DIV 91); s[11]:=CHR(33+n MOD 91); s[12]:=CHR(33+32+16+6); ELSE s[10]:=" "; s[11]:=" "; s[12]:=CHR(33+32+24+6); END; s[13]:=0C; IF (knots>0) & (feet>0) THEN alt2str(feet, h); Append(s, h); END; END compressdata; PROCEDURE deg2str(lat, long:INTEGER; VAR s:ARRAY OF CHAR); (* DDMM.MMNDDDMM.MME *) CONST Z=ORD("0"); BEGIN IF lat<0 THEN lat:=-lat; s[7]:="S"; ELSE s[7]:="N" END; IF long<0 THEN long:=-long; s[17]:="W"; ELSE s[17]:="E" END; s[0]:=CHR(lat DIV 60000+Z); s[1]:=CHR(lat DIV 6000 MOD 10+Z); s[2]:=CHR(lat DIV 1000 MOD 6+Z); s[3]:=CHR(lat DIV 100 MOD 10+Z); s[4]:="."; s[5]:=CHR(lat DIV 10 MOD 10+Z); s[6]:=CHR(lat MOD 10+Z); s[9]:=CHR(long DIV 600000+Z); s[10]:=CHR(long DIV 60000 MOD 10+Z); s[11]:=CHR(long DIV 6000 MOD 10+Z); s[12]:=CHR(long DIV 1000 MOD 6+Z); s[13]:=CHR(long DIV 100 MOD 10+Z); s[14]:="."; s[15]:=CHR(long DIV 10 MOD 10+Z); s[16]:=CHR(long MOD 10+Z); s[18]:=0C; END deg2str; PROCEDURE getbeaconpos(VAR pos:POSITION; VAR err:BOOLEAN); VAR fd:File; len:INTEGER; s:ARRAY[0..1000] OF CHAR; BEGIN confstr(fRBPOS, s); IF s[0]=":" THEN (* get beacon position from file *) Delstr(s, 0, 1); fd:=OpenRead(s); s[0]:=0C; IF FdValid(fd) THEN len:=RdBin(fd, s, HIGH(s)); IF len<1 THEN len:=0; say(LF+"beacon position file not readable"+LF, 20, "e") ELSIF len>VAL(INTEGER, HIGH(s)) THEN len:=HIGH(s) END; s[len]:=0C; Close(fd); ELSE say(LF+"beacon position file not found"+LF, 20, "e") END; END; IF s[0]<>0C THEN deganytopos(s, pos); IF NOT posvalid(pos) THEN say(LF+"beacon: object/item position wrong"+LF, 4, "e"); err:=TRUE END; ELSE say(LF+"beacon: no object/item position"+LF, 4, "e"); err:=TRUE; posinval(pos); END; END getbeaconpos; PROCEDURE callwrong(s-:ARRAY OF CHAR):BOOLEAN; VAR i:CARDINAL; BEGIN i:=0; WHILE (i<=HIGH(s)) & (s[i]<>0C) DO IF (s[i]<=" ") OR (s[i]>=177C) THEN RETURN TRUE END; INC(i); END; RETURN (i<3) OR (i>9) END callwrong; PROCEDURE encbeacon(VAR s:ARRAY OF CHAR; VAR len:CARDINAL); (* assemble beacon string *) CONST RAD=180/PI*600000; VAR h:ARRAY[0..200] OF CHAR; symb:ARRAY[0..1] OF CHAR; typ, postyp:CHAR; bkn, dao, err, areaobj, mull:BOOLEAN; pos:POSITION; i:INTEGER; dir, knots, feet, alt, lat, long, latd, longd:INTEGER; datastart:CARDINAL; BEGIN err:=FALSE; len:=16; (* ax.25 address + UI + PID *) confstr(fRBTYP, s); typ:=CAP(s[0]); bkn:=(typ<>"O") & (typ<>"H") & (typ<>"P") & (typ<>"I") & (typ<>"J"); confstr(fRBPOSTYP, postyp); confstr(fRBSYMB, symb); areaobj:=(typ="O") & (symb[0]=AREASYMT) & (symb[1]=AREASYM); IF (Length(symb)<>2) OR (symb[1]<=" ") THEN say(LF+"no symbol"+LF, 4, "e"); err:=TRUE END; dao:=(postyp=ENCODEGPSDAO) OR (postyp=ENCODEMICEDAO); knots:=conf2int(fRBSPEED, 0, 0, MAX(INT16), 0); IF NOT areaobj THEN knots:=trunc(FLOAT(knots)*(1.0/KNOTS)+0.5) END; dir:=conf2int(fRBDIR, 0, 0, 1000, 1000); --WrInt(dir, 9); WrStrLn("defdir"); IF dir<1000 THEN IF NOT areaobj THEN IF dir>359 THEN say(LF+"beacon: Direction <360"+LF, 20, "e"); err:=TRUE; ELSIF knots=0 THEN say(LF+"direction needs speed>0"+LF, 20, "e") END; IF dir=0 THEN dir:=360 END; END; ELSE dir:=0 END; alt :=conf2int(fRBALT, 0, -10000, 1000000, MIN(INT16)); feet:=trunc(ABS(FLOAT(alt)/FEET+0.5)); IF alt<0 THEN feet:=-feet END; confstr(fRBPORT, s); Append(s, ":"); (* port *) IntToStr(conf2int(fRBTIME, 0, 0, MAX(INT16), 3600), 1, h); Append(s, h); (* repeat time *) Append(s, ":"); IF bkn THEN confstr(fRBNAME, h); IF h[0]<=" " THEN say(LF+"no beacon call?"+LF, 4, "e") END; IF configon(fMUSTBECALL) & NOT isacall(h) THEN say(LF+"not valid callsign as beacon sender?"+LF, 20, "e") END; Append(s, h); IF getmypos(pos) THEN IF NOT posvalid(pos) THEN say(LF+"Net beacon position wrong"+LF, 4, "e"); err:=TRUE END; ELSE getbeaconpos(pos, err) END; (* rfbeacon pos *) ELSE confstr(fMYCALL, h); IF h[0]<=" " THEN say(LF+"object/item needs a Config/Online/My Call"+LF, 4, "e") END; Append(s, h); getbeaconpos(pos, err); END; lat :=trunc(ABS(pos.lat) *RAD); long:=trunc(ABS(pos.long)*RAD); latd :=VAL(CARDINAL, lat ) MOD 100; longd:=VAL(CARDINAL, long) MOD 100; IF dao THEN lat :=lat -latd; long:=long-longd; END; lat :=lat DIV 100; long:=long DIV 100; IF pos.lat <0 THEN lat :=-lat END; IF pos.long<0 THEN long:=-long END; Append(s, ">"); IF CAP(postyp)=CAP(ENCODEMICE) THEN micedest(lat, long, h); ELSE confstr(fRBDEST, h); IF h[0]=0C THEN h:=DESTCALL END; i:=InStr(h, "-"); IF i>0 THEN Delstr(h, i, SIZE(h)) END; (* delete ssid *) END; Append(s, h); confstr(fRBPATH, h); IF h[0]>" " THEN IF h[0]<>"-" THEN Append(s, ",") END; Append(s, h); (* dest ssid + via path *) i:=0; WHILE s[i]<>0C DO IF s[i]="," THEN INC(len, 7) END; INC(i); END; END; Append(s, ":"); (* end of address *) datastart:=Length(s); (* rest of line for byte count *) IF NOT bkn THEN confstr(fRBNAME, h); IF h[0]<=" " THEN say(LF+"no object/item name?"+LF, 20, "e"); err:=TRUE END; Append(h, " "); h[9]:=0C; (* fix size *) IF (typ="O") OR (typ="H") OR (typ="P") THEN Append(s, ";"); (* object *) Append(s, h); IF typ="P" THEN Append(s, "_") ELSE Append(s, "*") END; (* delete or object *) IF typ="O" THEN Append(s, "\\Zz") ELSE Append(s, "\\Hh") END; (* time macro **) ELSE Append(s, ")"); (* item *) i:=3; WHILE h[i]>" " DO INC(i) END; h[i]:=0C; (* item size 3..9 *) Append(s, h); IF typ="J" THEN Append(s, "_") ELSE Append(s, "!") END; (* delete or item*) END; ELSE IF CAP(postyp)=CAP(ENCODEMICE) THEN h:="`" ELSE h:="=" END; Append(s, h); (* beacon protocol *) END; CASE CAP(postyp) OF CAP(ENCODEMICE): micedata(lat, long, knots, dir, alt, symb, h); Append(s, h); |CAP(ENCODECOMP): IF (feet<0) & (feet>-10000) THEN say(LF+"no negative altitude in compressed mode"+LF, 20, "e"); err:=TRUE END; IF (symb[0]>="a") & (symb[0]<="j") THEN say(LF+"overlay character a..j not in compressed mode"+LF, 20, "e"); err:=TRUE END; IF (symb[0]>="0") & (symb[0]<="9") THEN symb[0]:=CHR(ORD(symb[0])+(ORD("a")-ORD("0"))) END; compressdata(pos, knots, dir, feet, symb, h); Append(s, h); ELSE deg2str(lat, long, h); h[8]:=symb[0]; h[18]:=symb[1]; h[19]:=0C; (* symbol *) Append(s, h); IF knots>0 THEN (* dir, speed *) speeddir2str(knots, dir, areaobj, h); Append(s, h); END; IF alt>-10000 THEN alt2str(feet, h); Append(s, h); END; END; mull:=ismultiline(FALSE); -- IF mull THEN confappend(fRBCOMMENT, s) END; (* multiline: append dao at end *) confappend(fRBCOMMENT, s); IF (CAP(postyp)<>CAP(ENCODECOMP)) & (dao OR mull) THEN (* DAO *) daostr(latd, longd, h); Append(s, h); END; -- IF NOT mull THEN confappend(fRBCOMMENT, s) END; INC(len, Length(s)-datastart); IF err THEN s[0]:=0C END; END encbeacon; END aprstext.