<*+M2EXTENSIONS *>
<*-CHECKDIV *>
<*-CHECKRANGE *>
<*-COVERFLOW *>
<*-IOVERFLOW*>

<*+NOPTRALIAS*>
<*CPU="PENTIUM"*>
<*-DOREORDER *>
<*-CHECKNIL *>
<*-CHECKSET*>
<*-PROCINLINE*>
<* IF __GEN_C__ THEN *>
  <*-GENCTYPES*>
  <*+COMMENT*>
  <*-GENHISTORY*>
  <*-GENDEBUG*>
  <*-GENDATE*>
  <*-LINENO*>
  <*-CHECKINDEX*>
  <*+GENCDIV*>
  <*-GENKRC*>
<* ELSE *>
  <*+GENHISTORY*>
  <*+GENDEBUG*>
  <*+LINENO*>
  <*+CHECKINDEX*>
  <*+CHECKNIL*>
<* END *>
<*NEW SRTM*>
<*+SRTM*>
<*NEW WITHDATABASE*>
<*+WITHDATABASE*>


MODULE adsb2aprs;  (* dump1090 tcp output to aprs beacon by OE5DXL *)

FROM SYSTEM IMPORT ADR, INT8, CARD8, INT16, CARD16, CAST, FILL;
FROM osi IMPORT OpenWrite, OpenRead, RdBin, WrBin, Flush, Close, udpsend, openudp,
         WrFixed, WrStrLn, WrStr, WrInt, Werr, WerrLn, NextArg, usleep, time,
         ALLOCATE, DEALLOCATE, WrHex;
FROM aprsstr IMPORT Assign, IntToStr, StrToFix, StrToCard, StrCmp, Append, Length,
                    IPNUM, DateToStr, mon2raw, FixToStr, POSITION, loctopos;
FROM tcpb IMPORT connecttob, readsockb;
FROM tcp IMPORT sendsock;
FROM aprspos IMPORT azimuth;
FROM aprspos IMPORT posvalid,wgs84s ;
IMPORT math;
<* IF SRTM THEN *>
FROM libsrtm IMPORT srtmdir, srtmmaxmem, egm96, getsrtm;
<* END *>

CONST TIMETOL=20;                              (* max seconds between dir/speed and pos *)
      PURGETIME=120;                           (* seconds keep context *)
      DEFAULTBEACONTIME=20;
      SYMBOL="/^";
      KNOTS=1.852;                             (* nautic miles *)
      FEET=0.3048;
      PI=3.14159265358979323844;
      RAD=PI/180.0;
      LF=12C;

TYPE CSV=ARRAY[0..99] OF ARRAY[0..20] OF CHAR;
     TIME=CARDINAL;
     SET32=SET OF [0..31];

     pFLY=POINTER TO FLY;
     FLY=RECORD
       next:pFLY;
       hex:ARRAY[0..5] OF CHAR;
       name:ARRAY[0..20] OF CHAR;
       squawk:ARRAY[0..3] OF CHAR;
       lat, long, alt, speed, dir, clb:REAL;
       speedtime, postime, lasttime, lastbeacon:TIME;
       newpos:BOOLEAN;
     END;  

VAR
    url, port: ARRAY[0..1000] OF CHAR;
    reconn, verb, verb2:BOOLEAN;
    fd:INTEGER;
    dbase:pFLY;
    btime:TIME;
    mycall:ARRAY[0..9] OF CHAR; 
    symbol:ARRAY[0..2] OF CHAR;
    comment:ARRAY[0..200] OF CHAR;
    udpsock:INTEGER;
    ipnum:IPNUM;
    toport:CARDINAL;
    altcorr:REAL;
    homepos:POSITION;
    homealt:REAL;
    homealtwgs:REAL;
    titles:ARRAY[0..40] OF ARRAY[0..40] OF CHAR;

<*IF WITHDATABASE THEN*>
  csvfn:ARRAY[0..1023] OF CHAR;
<*END*>

<*IF NOT SRTM THEN*>
    srtmdir     :ARRAY[0..1023] OF CHAR;
<*END*>
    
PROCEDURE Error(text:ARRAY OF CHAR);
BEGIN
  Werr(text); WerrLn(" error abort");
  HALT
END Error;

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]=eot
END GetNum;

PROCEDURE truncc(r:LONGREAL):CARDINAL;
BEGIN
  IF r<=0.0 THEN RETURN 0 ELSIF r>=MAX(INTEGER) THEN RETURN MAX(INTEGER) ELSE RETURN TRUNC(r) END;
END truncc;

PROCEDURE truncr(r:REAL):CARDINAL;
BEGIN
  IF r<=0.0 THEN RETURN 0 ELSIF r>=MAX(INTEGER) THEN RETURN MAX(INTEGER) ELSE RETURN TRUNC(r) END;
END truncr;

PROCEDURE GetIp(h:ARRAY OF CHAR; VAR p:CARDINAL; VAR ip:CARDINAL; VAR port:CARDINAL):INTEGER;
VAR i, n:CARDINAL;
    ok:BOOLEAN;
BEGIN
  p:=0;
  h[HIGH(h)]:=0C;
  ip:=0;
  FOR i:=0 TO 4 DO
    n:=0;
    ok:=FALSE;
    WHILE (h[p]>="0") & (h[p]<="9") DO
      ok:=TRUE;
      n:=n*10+ORD(h[p])-ORD("0");
      INC(p);
    END;
    IF NOT ok THEN RETURN -1 END;
    IF i<3 THEN
      IF (h[p]<>".") OR (n>255) THEN RETURN -1 END;

      ip:=ip*256+n;
    ELSIF i=3 THEN
      ip:=ip*256+n;
      IF (h[p]<>":") OR (n>255) THEN RETURN -1 END;

    ELSIF n>65535 THEN RETURN -1 END;

    port:=n;
    INC(p);
  END;
  RETURN 0
END GetIp;


PROCEDURE Parms;
VAR s:ARRAY[0..1000] OF CHAR;
    m, n:CARDINAL;
    titlesset, ok:BOOLEAN;
BEGIN
  reconn:=FALSE;
  verb:=FALSE;
  verb2:=FALSE;
  url:="127.0.0.1";
  port:="30003";
  mycall:="";
  btime:=DEFAULTBEACONTIME;
  symbol:=SYMBOL;
  altcorr:=0.0;
  comment:="";
  homealt:=-10000.0;
  homepos.lat:=0.0;
  homepos.long:=0.0;
  titlesset:=FALSE;
  srtmdir:="";
  FILL(ADR(titles), 0C, SIZE(titles));
  LOOP
    NextArg(s);
    IF s[0]=0C THEN EXIT END;

    IF (s[0]="-") & (s[1]<>0C) & (s[2]=0C) THEN

      IF s[1]="t" THEN NextArg(s);                       (* url *)
        n:=0;
        WHILE (n<HIGH(s)) & (s[n]<>0C) & (s[n]<>":") DO
          IF n<HIGH(url) THEN url[n]:=s[n] END;
          INC(n);
        END;
        IF n>HIGH(url) THEN n:=HIGH(url) END;
        url[n]:=0C;
        IF s[n]=":" THEN
          m:=0;
          INC(n);
          WHILE (n<HIGH(s)) & (s[n]<>0C) & (m<HIGH(port)) DO port[m]:=s[n]; INC(n); INC(m) END;
          IF m>HIGH(port) THEN m:=HIGH(port) END;
          port[m]:=0C;
        END;

      ELSIF s[1]="k" THEN reconn:=TRUE;                     (* reconnect *)

      ELSIF s[1]="a" THEN
        NextArg(s);
        IF NOT StrToFix(altcorr, s) THEN Error("-a <meter>") END;    

      ELSIF s[1]="A" THEN
        NextArg(s);
        IF NOT StrToFix(homealt, s) THEN Error("-A <meter>") END;    

      ELSIF s[1]="b" THEN
        NextArg(s);
        n:=0;
        IF NOT GetNum(s, 0C, n, btime) THEN Error("-b <s>") END;

      ELSIF s[1]="I" THEN
        NextArg(mycall);
        IF (Length(mycall)<3) OR (Length(mycall)>9) THEN Error("-I <callsign>") END;

      ELSIF s[1]="s" THEN
        NextArg(symbol);
        IF (Length(symbol)<>2) OR (symbol[0]="-") THEN Error("-s <symbol>") END;

      ELSIF s[1]="c" THEN
        NextArg(comment);

      ELSIF s[1]="u" THEN
        NextArg(s);
        n:=0;
        IF GetIp(s, n, ipnum, toport)<0 THEN Error("-u ip:port number") END;
        udpsock:=openudp();
        IF udpsock<0 THEN Error("cannot open udp socket") END;

      ELSIF s[1]="v" THEN verb:=TRUE;
      ELSIF s[1]="V" THEN verb:=TRUE; verb2:=TRUE;

      ELSIF s[1]="P" THEN
        NextArg(s);
        loctopos(homepos, s);
        IF NOT posvalid(homepos) THEN
          IF NOT StrToFix(homepos.lat, s) OR (ABS(homepos.lat)>=90)
          THEN Error("-P <lat> <long> or <locator>") END;

          NextArg(s);
          IF NOT StrToFix(homepos.long, s) OR (ABS(homepos.long)>180)
          THEN Error("-P <lat> <long> or <locator>") END;
          homepos.lat :=homepos.lat*RAD;
          homepos.long:=homepos.long*RAD;
        END;
<*IF SRTM THEN*>

      ELSIF s[1]="S" THEN
        NextArg(srtmdir);
<*END*>
<*IF WITHDATABASE THEN*>
      ELSIF s[1]="f" THEN
        NextArg(s);
        m:=1;
        n:=0;
        titlesset:=TRUE;
        s[HIGH(s)]:=0C;
        WHILE (m<=HIGH(titles)) & (s[n]<>0C) DO
          IF s[n]="," THEN INC(m) ELSE Append(titles[m], s[n]) END;
          INC(n);
        END;

      ELSIF s[1]="D" THEN
        NextArg(csvfn);
<*END*>

      ELSIF s[1]="h" THEN
        WrStrLn("");
        WrStrLn("dump1090 basestation format tcp output to aprs object beacon");
        WrStrLn("");
        WrStrLn(" -A <meter>          my altitude for elevation else (if avaliable) from srtm data (egm)");
        WrStrLn(" -a <meter>          correct altitude -a 50 (0)");
        WrStrLn(" -b <seconds>        aprs minimum send intervall -b 10 (20)");
        WrStrLn(' -c <comment>        append text to beacon and enable "Clb="');
<*IF WITHDATABASE THEN*>
        WrStrLn(' -D <databasefile>   append text to beacon out of aircraft-database.csv (index is ICAO number)');
        WrStrLn(' -f <title>,<title>,... set titles according to csv database fields (index is first field ICAO)');
        WrStrLn('                        empty fields are skipped "Reg,,,Model,,Serial"');
<*END*>
        WrStrLn(" -h                  help");
        WrStrLn(" -I <mycall>         Sender of Object Callsign -I OE0AAA");
        WrStrLn(" -k                  keep tcp connection");
        WrStrLn(" -P <lat> <long> or <locator>  my Position for Distance/Azimuth/Elevation");
        WrStrLn("                       eg. -P JQ50AB12CD or -P 70.0506 10.0092");
<*IF SRTM THEN*>
        WrStrLn(" -S <pathname>       directory with SRTM(1/3/30) Data and WW15MGH.DAC file (egm96-Geoid)");
        WrStrLn("                       for Overground Calculation");
        WrStrLn("                       example with: -S /home/pi");
        WrStrLn("                       /home/pi/WW15MGH.DAC        (2076480Byte, covers whole World)");
        WrStrLn("                       /home/pi/srtm1/N48E014.hgt  (25934402Byte)");
        WrStrLn("                       /home/pi/srtm1/N48E015.hgt");
<*END*>
        WrStrLn(" -s <symbol>         aprs symbol (/^)");
        WrStrLn(' -t <url:port>       connect dump1090 tcp server (127.0.0.1:30003) "dump1090 --net"');
        WrStrLn(" -u <ip>:<port>      send AXUDP -u 127.0.0.1:9001 use udpgate4 or aprsmap as receiver");
        WrStrLn(" -V                  very verbous");
        WrStrLn(" -v                  verbous");
        WrStrLn("example: -t 127.0.0.1:30003 -I YOURCALL-11 -u 127.0.0.1:9002 -k -v -c 1090MHz");
        WrStrLn('before this start "dump1090 --net"');
        WrStrLn("");
        HALT

      ELSE Werr(">"); Werr(s); Error("< ? use -h") END;
    ELSE Error("-h") END;
  END;
  IF NOT titlesset THEN
    titles[1 ]:="Reg";
    titles[2 ]:="ManICAO";
    titles[3 ]:="ManName";
    titles[4 ]:="Model";
    titles[5 ]:="Type";
    titles[6 ]:="Ser";
    titles[7 ]:="Linenum";
--  titles[8 ]:="icaotype";
    titles[9 ]:="op";
    titles[10]:="opcall";
--  titles[11]:="opicao";
--  titles[12]:="opiata";
    titles[13]:="owner";

    titles[15]:="reg";
    titles[16]:="till";

    titles[18]:="built";
    titles[19]:="fitst";
  END;
END Parms;


PROCEDURE decodeline(line-:ARRAY OF CHAR; VAR csv:CSV);
VAR i,w,j:CARDINAL;
BEGIN
  FILL(ADR(csv), 0C, SIZE(csv));
  i:=0;
  j:=0;
  w:=0;
  WHILE (i<=HIGH(line)) & (line[i]>=" ") DO
    IF line[i]<>"," THEN
      IF (w<=HIGH(csv)) & (j<=HIGH(csv[0])) THEN csv[w][j]:=line[i]; INC(j) END;
    ELSE
      INC(w);
      j:=0;
    END;
    INC(i);  
  END;
END decodeline;


PROCEDURE sendaprs(dao:BOOLEAN; time:TIME;
                   mycall, destcall, via, sym, obj:ARRAY OF CHAR; 
                   lat, long, alt, course, speed:LONGREAL; clb:REAL; comm:ARRAY OF CHAR);

  PROCEDURE num(n:CARDINAL):CHAR;
  BEGIN RETURN CHR(n MOD 10 + ORD("0")) END num;

  PROCEDURE dao91(x:LONGREAL):CARDINAL;                  (* radix91(xx/1.1) of dddmm.mmxx *)
  VAR a:LONGREAL;
  BEGIN
    a:=ABS(x);
    RETURN (truncc((a-FLOAT(truncc(a)))*600000.0) MOD 100*20+11) DIV 22
  END dao91;

VAR b,h,ds:ARRAY[0..500] OF CHAR;
    raw:ARRAY[0..360] OF CHAR;
    rp:INTEGER; 
    i,n, nl:CARDINAL;
    a:REAL;
BEGIN
  b:="";
  Append(b, mycall);
  Append(b, ">"); Append(b, destcall);
  IF via[0]<>0C THEN Append(b, ","); Append(b, via) END;

    Append(b, ":;");
    Assign(h, obj);
    Append(h, "         ");
    h[9]:=0C;
    Append(b, h); Append(b, "*");

    DateToStr(time, ds);
    ds[0]:=ds[11]; ds[1]:=ds[12]; ds[2]:=ds[14]; ds[3]:=ds[15]; ds[4]:=ds[17]; ds[5]:=ds[18];
    ds[6]:=0C;
    Append(b, ds);
    Append(b, "h");

 
    i:=Length(b);
    a:=ABS(lat);
    n:=truncr(a);
    b[i]:=num(n DIV 10); INC(i);
    b[i]:=num(n); INC(i);
    n:=truncr((a-FLOAT(n))*6000.0);
    b[i]:=num(n DIV 1000); INC(i);
    b[i]:=num(n DIV 100); INC(i);
    b[i]:="."; INC(i);
    b[i]:=num(n DIV 10); INC(i);
    b[i]:=num(n); INC(i);
    IF lat>=0.0 THEN b[i]:="N" ELSE b[i]:="S" END; INC(i);
    b[i]:=sym[0]; INC(i);

    a:=ABS(long); 
    n:=truncr(a);
    b[i]:=num(n DIV 100); INC(i);
    b[i]:=num(n DIV 10); INC(i);
    b[i]:=num(n); INC(i);
    n:=truncr((a-FLOAT(n))*6000.0);
    b[i]:=num(n DIV 1000); INC(i);
    b[i]:=num(n DIV 100); INC(i);
    b[i]:="."; INC(i);
    b[i]:=num(n DIV 10); INC(i);
    b[i]:=num(n); INC(i);
    IF lat>=0.0 THEN b[i]:="E" ELSE b[i]:="W" END; INC(i);
    b[i]:=sym[1]; INC(i);

    IF speed>0.5 THEN
      n:=truncr(course+1.5);
      b[i]:=num(n DIV 100); INC(i);
      b[i]:=num(n DIV 10); INC(i);
      b[i]:=num(n); INC(i);
      b[i]:="/"; INC(i);

      n:=truncr(speed*(1.0/KNOTS)+0.5);
      b[i]:=num(n DIV 100); INC(i);
      b[i]:=num(n DIV 10); INC(i);
      b[i]:=num(n); INC(i);
    END;

    IF alt>0.5 THEN
      b[i]:="/"; INC(i);
      b[i]:="A"; INC(i);
      b[i]:="="; INC(i);
      n:=truncr(ABS(alt*(1.0/FEET)+0.5));
      IF alt>=0.0 THEN b[i]:=num(n DIV 100000) ELSE b[i]:="-" END; INC(i);
      b[i]:=num(n DIV 10000); INC(i);
      b[i]:=num(n DIV 1000); INC(i);
      b[i]:=num(n DIV 100); INC(i);
      b[i]:=num(n DIV 10); INC(i);
      b[i]:=num(n); INC(i);
    END;


  IF dao THEN
    b[i]:="!"; INC(i);
    b[i]:="w"; INC(i);
    b[i]:=CHR(33 + dao91(lat)); INC(i);
    b[i]:=CHR(33 + dao91(long)); INC(i);
    b[i]:="!"; INC(i);
  END;

  b[i]:=0C;
--  IF clb<>0.0 THEN
    b[i]:="C"; INC(i);
    b[i]:="l"; INC(i);
    b[i]:="b"; INC(i);
    b[i]:="="; INC(i);
    b[i]:=0C;
    FixToStr(clb*(0.3048/64.0), 2, h); Append(b, h);  (* looks like feet/s * 64 *)
--  END;
  IF comm[0]<>0C THEN
    Append(b," "); 
    Append(b, comm);
  END;
  IF verb THEN WrStrLn(b) END;
  b[254]:=0C;                     (* limit len for aprs *)
  mon2raw(b, raw, rp);
  IF rp=0 THEN WerrLn("axudp encode error (possibly call not encodable") END;  
  rp:=udpsend(udpsock, raw, rp, toport, ipnum);   
END sendaprs;

<*IF WITHDATABASE THEN*>

CONST SEP='"';
TYPE pDB=POINTER TO DB;
      DB=RECORD
            next:pDB;
            icaomsb:CARD8;
            str:ARRAY[0..65555] OF CHAR;
         END;

VAR dbidx:ARRAY[0..65535] OF pDB;

PROCEDURE ghex(s-:ARRAY OF CHAR):CARDINAL;
VAR i,n:CARDINAL;
    c:CHAR;  
BEGIN
  n:=0;
  i:=0;
  LOOP
    c:=CAP(s[i]); 
    IF (c>="0") & (c<="9") THEN n:=n*16+ORD(c)-ORD("0")
    ELSIF (c>="A") & (c<="F") THEN n:=n*16+ORD(c)-(ORD("A")-10)
    ELSE EXIT END;

    INC(i);
    IF i>HIGH(s) THEN EXIT END;
  END;
  RETURN n
END ghex;

PROCEDURE rdcsv(fn:ARRAY OF CHAR);
VAR p, len, r:INTEGER;
    i, line, cnt:CARDINAL;
    fd:INTEGER;
--    pm:pDB;
    b:ARRAY[0..4095] OF CHAR;
    s,h:ARRAY[0..1023] OF CHAR;
    f:ARRAY[0..49] OF ARRAY[0..99] OF CHAR;

  PROCEDURE getch():CHAR;
  BEGIN
    IF p>=len THEN
      len:=RdBin(fd, b, SIZE(b));
      IF len<=0 THEN RETURN 0C END;

      p:=0; 
    END;
    INC(p);
    RETURN b[p-1]
  END getch;

  PROCEDURE getword(VAR s:ARRAY OF CHAR):INTEGER;
  VAR i:CARDINAL;
      inqu:BOOLEAN;
  BEGIN
    i:=0;
    inqu:=FALSE;
    LOOP
      s[i]:=getch();
      IF s[i]=0C THEN RETURN -1 END;

      IF s[i]=LF THEN s[i]:=0C; RETURN 0 END;

      IF NOT inqu & (s[i]=",") THEN s[i]:=0C; RETURN 1 END;

      IF s[i]='"' THEN inqu:=NOT inqu
      ELSIF (i<HIGH(s)) & (s[i]>=" ") & (s[i]<200C) THEN INC(i) END;
    END;
  END getword; 

VAR pd:pDB;
    icao, wc, msb, dupes:CARDINAL;

BEGIN
 
  FILL(ADR(dbidx), 0C, SIZE(dbidx));
  cnt:=0;

  fd:=OpenRead(fn);
  IF fd<0 THEN Error("database file not readable") END;

  IF verb THEN WerrLn("importing aircraft database") END;
  line:=0;
  dupes:=0;
  p:=0;
  len:=0;
  LOOP   
    wc:=0;
    LOOP
      r:=getword(f[wc]);
      IF r<=0 THEN EXIT END;

      IF wc<HIGH(f) THEN INC(wc) END;
    END; 

    IF r>=0 THEN
      icao:=ghex(f[0]);
      msb:=icao DIV 65536;
      icao:=icao MOD 65536;
      pd:=dbidx[icao];
      WHILE (pd<>NIL) & (pd^.icaomsb<>msb) DO pd:=pd^.next END;
      IF pd=NIL THEN
        h:="";
        i:=1;
        WHILE i<wc DO
          IF i<=HIGH(titles) THEN Append(h, SEP); Append(h, f[i]) END;
          INC(i);
        END;
        ALLOCATE(pd, SIZE(pd^)-65535+Length(h));
        IF pd=NIL THEN
          IntToStr(line,1,s); Werr("in line:"); Werr(s);  
          Error(" out of memory");
        END;

        pd^.icaomsb:=msb;
        Assign(pd^.str, h);
        pd^.next:=dbidx[icao];
        dbidx[icao]:=pd;
        INC(line);
      ELSE INC(dupes) END;
    ELSE
      IF verb THEN
        IntToStr(line, 1, s); Werr(s); WerrLn(" Lines imported");
        IF dupes<>0 THEN IntToStr(dupes, 1, s); Werr(s); WerrLn(" duplicates removed") END;
      END;
      EXIT 
    END;
  END; 
  Close(fd);

END rdcsv;

PROCEDURE appenddb(icao-:ARRAY OF CHAR; VAR s:ARRAY OF CHAR);
VAR ic, col, i:CARDINAL;
    icm:CARD8;
    p:pDB;

BEGIN
  ic:=ghex(icao);
  p:=dbidx[ic MOD 65536];
  icm:=ic DIV 65536;
  WHILE (p<>NIL) & (p^.icaomsb<>icm) DO p:=p^.next END;
  IF p<>NIL THEN
--WrStr("<<<");WrStr(p^.str); WrStrLn(">>>");
    col:=0;
    i:=0;
    WHILE (p^.str[i]<>0C) & (col<=HIGH(titles)) DO
      IF p^.str[i]=SEP THEN
        INC(col);
        IF (p^.str[i+1]<>SEP) & (p^.str[i+1]>" ") & (titles[col][0]<>0C) THEN
          Append(s, " ");
          Append(s, titles[col]);
          Append(s, ":");
        END;
      ELSIF titles[col][0]<>0C THEN Append(s, p^.str[i]) END;
      INC(i);
    END;   
  END;
END appenddb;

<*END*>


PROCEDURE elevation(VAR el, c:LONGREAL; home:POSITION; homealt:LONGREAL;
                    dist:POSITION; distalt:LONGREAL);
VAR x0,y0,z0, x1,y1,z1:REAL;
    a,b,s,r,sb:LONGREAL;

BEGIN
  el:=-1000.0;
  wgs84s(home.lat, home.long, homealt*0.001, x0,y0,z0);
  wgs84s(dist.lat, dist.long, distalt*0.001, x1,y1,z1);

  a:=math.sqrt(x0*x0 + y0*y0 + z0*z0);
  b:=math.sqrt(x1*x1 + y1*y1 + z1*z1);
  x1:=x1-x0;
  y1:=y1-y0;
  z1:=z1-z0;
  c:=math.sqrt(x1*x1 + y1*y1 + z1*z1);

(* halbwinkelsatz *)
  s:=(a+b+c)*0.5;
  IF s=0.0 THEN RETURN END;

  r:=(s-a)*(s-b)*(s-c)/s;
  IF r<=0.0 THEN RETURN END;

  r:=math.sqrt(r);
  sb:=s-b;
  IF sb<>0.0 THEN el:=(360.0/PI)*math.atan(r/sb)-90.0 ELSE el:=90.0 END;
END elevation;

<*IF SRTM THEN*>

PROCEDURE getoverground(lat, long, alt:REAL):REAL;
VAR pos:POSITION;
    resolution:REAL;
    srtm:REAL;
BEGIN
  srtmmaxmem:=1000000;
  pos.lat:=lat;
  pos.long:=long;
  srtm:=getsrtm(pos, 1, resolution);
  IF (srtm<10000.0) & (srtm>-1000.0) THEN
    IF alt<=-30000.0 THEN RETURN srtm END;                     (* srtm request *)

    RETURN alt - srtm;
  END;

  RETURN -100000.0;
END getoverground;

<*END*>

<*IF SRTM THEN*>
PROCEDURE egmcorr(pos-:POSITION; invers:BOOLEAN; a:REAL):REAL;  (* correct altitude wgs84/egm *)
VAR e:REAL;
    ok:BOOLEAN;
BEGIN
  IF srtmdir[0]<>0C THEN
    ok:=TRUE;
    e:=egm96(pos, ok);
    IF ok THEN
      IF invers THEN e:=-e END;
      a:=a-e
    END;
  END;
  RETURN a
END egmcorr; 
<*END*>


PROCEDURE aprs(f-:FLY);
VAR
    obj, h:ARRAY[0..30] OF CHAR;
    ct:ARRAY[0..500] OF CHAR;
    ele, dist:LONGREAL;
    og, altegm, azi:REAL;
    pos:POSITION;
BEGIN
  Assign(obj, f.name);
  obj[9]:=0C;
  WHILE Length(obj)<9 DO Append(obj, " ") END;

  ct:="ICAO:";
  Append(ct, f.hex);
  Append(ct, " ");

  pos.lat:=f.lat*RAD;
  pos.long:=f.long*RAD;
  altegm:=f.alt;
<*IF SRTM THEN*> 
(*
  IF srtmdir[0]<>0C THEN altegm:=egmcorr(pos, FALSE, f.alt) END;
*)
<*END*>
   
  IF posvalid(homepos) THEN
    azi:=azimuth(homepos, pos);
    FixToStr(azi, 0, h); Append(ct, "az="); Append(ct, h);
    IF homealtwgs>-1000.0 THEN                 (* elevation *)
      ele:=-100.0;
      elevation(ele, dist, homepos, homealtwgs, pos, egmcorr(pos, TRUE, f.alt));
      FixToStr(dist, 4, h); Append(ct, " d="); Append(ct, h); Append(ct, "km");
      IF ABS(ele)<=90.0 THEN FixToStr(ele, 3, h); Append(ct, " el="); Append(ct, h) END;
<*IF SRTM THEN*>
      IF srtmdir[0]<>0C THEN
        og:=getoverground(pos.lat, pos.long, altegm);
        IF og>-1000.0 THEN FixToStr(og, 0, h); Append(ct, " og="); Append(ct, h); Append(ct, "m") END;
      END; 
<*END*>
    END;
  END;

  IF f.squawk[0]<>0C THEN
    Append (ct, " Sq="); 
    Append(ct, f.squawk);
    IF StrCmp(f.squawk, "7700") THEN Append (ct, "[EMERGENCY]");
    ELSIF StrCmp(f.squawk, "7600") THEN Append (ct, "[RADIO FAILURE]");
    ELSIF StrCmp(f.squawk, "7500") THEN Append (ct, "[HIJACKING]");
    END;

  END;
  appenddb(f.hex, ct);

  IF comment[0]<>0C THEN Append(ct, " "); Append(ct, comment) END;
  sendaprs(TRUE, f.postime,  mycall, "APLFR1", "", symbol, obj,
                 VAL(LONGREAL, f.lat), VAL(LONGREAL, f.long), VAL(LONGREAL, altegm),
                 VAL(LONGREAL, f.dir), VAL(LONGREAL, f.speed*KNOTS), f.clb, ct);
END aprs;


PROCEDURE store(csv-:CSV);
VAR f, f1, f0:pFLY;
    msg:CARDINAL;
    ok:BOOLEAN;
    t:TIME;
    olat, olong, oalt:REAL;
BEGIN
  t:=time();
  IF (csv[0][0]="M") & (csv[0][1]="S") & (csv[0][2]="G") & StrToCard(csv[1], msg)
  & ((msg=1) OR (msg=2) OR (msg=3) OR (msg=4) OR (msg=6)) THEN 

    f:=dbase;
    f0:=NIL;
    WHILE (f<>NIL) & NOT StrCmp(f^.hex, csv[4]) DO
      f1:=f^.next;
      IF f^.lasttime+PURGETIME<t THEN
        IF f0=NIL THEN dbase:=f1 ELSE f0^.next:=f1 END;
IF verb2 THEN WrStr("purge "); WrStrLn(f^.hex) END;
        DEALLOCATE(f, SIZE(f^));
      ELSE f0:=f END;
      f:=f1;        
    END;

    IF f=NIL THEN
      ALLOCATE(f, SIZE(f^));
      IF f=NIL THEN WerrLn("Out of Memory"); RETURN END;

      FILL(f, 0C, SIZE(f^));
      f^.next:=dbase;
      dbase:=f;
      Assign(f^.hex, csv[4]);
IF verb2 THEN WrStr("new "); WrStrLn(f^.hex) END;
    END;

    f^.lasttime:=t;
    IF msg=1 THEN
IF verb2 & (f^.name[0]=0C) THEN WrStr("found name "); WrStr(f^.hex); WrStr(" "); WrStrLn(f^.name) END;
      Assign(f^.name, csv[10])
    ELSIF msg=4 THEN
      IF StrToFix(f^.speed, csv[12]) & StrToFix(f^.dir, csv[13]) & StrToFix(f^.clb, csv[16])
      & (f^.dir>=0.0) & (f^.dir<=360.0) THEN f^.speedtime:=t END;
    ELSIF (msg=3) OR (msg=2) THEN
      oalt:=0.0;
      IF ((msg=2) OR StrToFix(oalt, csv[11]))
      & StrToFix(olat, csv[14]) & (olat>-90.0) & (olat<90.0)
      & StrToFix(olong, csv[15]) & (olong>-180.0) & (olong<180.0)
      & ((olong<>f^.long) OR (olat<>f^.lat)) THEN
        f^.postime:=t;
        f^.newpos:=TRUE;
        f^.lat:=olat;
        f^.long:=olong; 
        IF oalt<>0.0 THEN f^.alt:=oalt*FEET+altcorr ELSE f^.alt:=0.0 END;
        IF msg=2 THEN f^.speedtime:=t END;
      END;
    ELSIF msg=6 THEN Assign(f^.squawk, csv[17]); 
    END;
--IF verb2 & (csv[17][0]<>0C) THEN WrStr("Squawk:"); WrStrLn(csv[17]); END; (* 7700 luftnotfall up/down, 7600 funkausfall, 7500 hijacking *)
    IF f^.lastbeacon>t THEN f^.lastbeacon:=t END;   (* system time jumped back *)
    IF f^.newpos & (f^.name[0]<>0C) & (f^.postime+TIMETOL>=t) & (f^.speedtime+TIMETOL>=t)
    & (f^.speed>=0.0) & (f^.lat<>0.0) & (f^.long<>0.0) & (f^.lastbeacon+btime<t) THEN
      aprs(f^);
      f^.newpos:=FALSE;
      f^.lastbeacon:=t;
    END;

  END; 
END store;


VAR ibuf, line:ARRAY[0..200] OF CHAR;
    ip, lp:CARDINAL;
    csv:CSV;
BEGIN
  Parms;

<*IF WITHDATABASE THEN*>
  IF csvfn[0]<>0C THEN rdcsv(csvfn) END;
<*END*>


  homealtwgs:=homealt;
<*IF SRTM THEN*>
  IF posvalid(homepos) & (srtmdir[0]<>0C) & (homealt<=-1000.0) THEN
    homealt:=-getoverground(homepos.lat, homepos.long, 0.0);
    IF verb THEN WrStrLn("get home altitude from srtm") END;
    homealtwgs:=egmcorr(homepos, TRUE, homealt);                (* altitude to wgs84 *)
  END;
<*END*>
  IF verb & (homealt>-1000.0) THEN
    WrStr("home altitude (egm):"); WrFixed(homealt,1,1); WrStrLn("m");
    IF homealt<>homealtwgs THEN 
      WrStr("home altitude (wgs84):"); WrFixed(homealtwgs,1,1); WrStrLn("m");
    END;
  END;

  fd:=-1;
  dbase:=NIL;
  fd:=connecttob(url,port);
  lp:=0;
  LOOP
    IF fd>=0 THEN
      IF readsockb(fd, ibuf, SIZE(ibuf))<0 THEN           (* connect lost *)
        Close(fd);
        fd:=-1;
      ELSE
        FOR ip:=0 TO HIGH(ibuf) DO
          IF ibuf[ip]<" " THEN
            IF lp<HIGH(line) THEN line[lp]:=0C END;
            IF Length(line)>2 THEN
              IF verb2 THEN WrStrLn(line) END; 

              decodeline(line, csv);
              store(csv);
              lp:=0;
            END; 
          ELSIF lp<HIGH(line) THEN line[lp]:=ibuf[ip]; INC(lp) END;
        END;
      END;

    ELSE 
      WerrLn("connection lost");
      IF reconn THEN
        usleep(1000000);
        fd:=connecttob(url,port);
      ELSE EXIT END;

    END;
  END; 

END adsb2aprs.