<*+M2EXTENSIONS *>
<*-CHECKDIV *>
<*-CHECKRANGE *>
<*-GENFRAME*>
<*-COVERFLOW *>
<*-IOVERFLOW*>
<*-NOPTRALIAS*>
<*-DOREORDER*>
<*-PROCINLINE*>
<*-GENPTRINIT*>
<*+STORAGE *>
<* IF __GEN_C__ THEN *>
  <*GENWIDTH="120"*>
  <*+STORAGE *>
  <*-GENCTYPES*>
  <*+COMMENT*>
  <*-GENHISTORY*>
  <*-GENDEBUG*>
  <*-GENDATE*>
  <*-LINENO*>
  <*-CHECKINDEX*>
  <*-CHECKDINDEX*>
  <*+GENCDIV*>
  <*-GENKRC*>
  <*+NOOPTIMIZE*>
  <*-GENSIZE*>
  <*-ASSERT*>
  <*-CHECKNIL*>
  <*-COVERFLOW*>
  <*-IOVERFLOW*>
  <*-CHECKRANGE*>
  <*-CHECKSET*>
  <*-CHECKDIV*>
  <*-GENCONSTENUM*>
  <*-ASSERT*>
<* ELSE *>
  <*HEAPLIMIT="100000000"*>
  <*+GENHISTORY*>
  <*+GENDEBUG*>
  <*-GENDATE*>
  <*+LINENO*>
  <*+CHECKINDEX*>
  <*+CHECKDNDEX*>
  <*+NOOPTIMIZE*>
  <*-GENSIZE*>
  <*-ASSERT*>
  <*+CHECKNIL*>
  <*-COVERFLOW*>
  <*-IOVERFLOW*>
  <*-CHECKRANGE*>
  <*-CHECKSET*>
  <*-CHECKDIV*>
  <*-GENCONSTENUM*>
<* END *>
<*NEW WITHAPRS*>
<*+WITHAPRS*>

MODULE fsk4rx; (* iq 4fsk, 2fsk, afsk demod with axudp and json output and sound monitor by oe5dxl *)

FROM SYSTEM IMPORT FILL, MOVE, ADR, CAST, CARD8, CARD16, INT16, SHIFT, BYTE;

FROM osi IMPORT Werr, WrStr, WrStrLn, WrInt, File, OpenRead, Close,
     WrFixed, ALLOCATE, NextArg, RdBin, time, IsFifo,
     OpenWrite, Seekend, WrBin, OpenNONBLOCK, OpenAppend, WrCard, realcard;
FROM math IMPORT sin, cos, log, sqrt, atan, pow;
<* IF WITHUDP OR WITHAPRS THEN *>
FROM osi IMPORT openudp, SOCKET, udpsend;
FROM aprsstr IMPORT IntToStr, mon2raw, AppCRC, Assign;
<* END *>

FROM aprsstr IMPORT StrToCard, StrToInt, StrToFix, Append, CardToStr, TimeToStr, FixToStr,
                    DateToStr, Length;
FROM signal IMPORT signal, SIGPIPE;

CONST
      PI=3.1415926535;
      PI2=PI*2.0;
      LF=12C;
      MAXINBUF=4096;
      LOGNFSK=2;
      NFSK=1<<LOGNFSK;
      OVERSAMP=16;
      BAUD=100.0;
      BASEBAND=140.0;  (*Hz baseband lowpass *)
      SPACEING=270.0;  (*Hz between carriers *)
      BASESTEP=5; 
      WAITBESTFRAME=OVERSAMP*2;
      FRAME22=22;
      FRAME32=32;
      MAXDEMODS=256;
      MAXSUBBANDS=256;
      BFOFREQ=1500;
      IFBAND=3240.0;
      DDSSLEN=4096;
      DDSLEN=16384; 
      AFSKOVERSAMPLE=16;
      CHECKSNR=8.0;                             (* send new payload id only over this snr *)
      MOD4="4";
      MODA="a";
      MODF="f";
      MOD0="0";
      MAXSHIPS=10000;
TYPE
     Complex=RECORD Re, Im:REAL END;
     SET8= SET OF [0..7];
     SET16=SET OF [0..15];
     SET32=SET OF [0..31];
     IPNUM=CARDINAL;
     UDPPORT=CARDINAL;
     LPCONTEXT24=RECORD
       uc1, uc2, il, LPR, OLPR, LPL:REAL;
     END;
     FRAME=ARRAY[0..100] OF CHAR;
     DEMOD=RECORD
       lastn,
       symclk,
       framewp,
       synword     :CARDINAL;  
       ppm         :INTEGER;
       frame       :FRAME;
       afc,
       levm,
       noism       :REAL;
     END;
     FECINFO=ARRAY[0..100] OF CHAR;
     BESTFRAME=RECORD
       timer,
       len,
       cor         :CARDINAL;
       ppm         :INTEGER;
       frame       :FRAME;
       afc,
       rfdb,
       snr         :REAL;
       crcok       :BOOLEAN;
       fecinfo     :FECINFO;
     END;
    
     pAFSKMODEM=POINTER TO AFSKMODEM;
     AFSKMODEM=RECORD
       next       :pAFSKMODEM;
       ademod,
       demod      :CHAR;
       rawbits,
       scrambled,
       oldbit,
       oldd,
       oldraw,
       synd       :BOOLEAN;
       sqlev,
       soundfd,
       dir        :INTEGER;
       usbosc,
       iffreq,
       iffreqafc,
       ifosc      :CARD16;
       freq,
       osc        :ARRAY[0..1] OF CARD16; 
       baselp     :ARRAY[0..2*2-1] OF LPCONTEXT24; 
       fsklp, 
       iflpi,
       iflpq      :LPCONTEXT24;
       modemnum,
       afbufw,
       syncnt,
       cnt,
       baud,
       bitcnt, 
       zerocnt,
       ifsamp,
       txc,
       txd,
       ifsamprate,
       ifstep     :CARDINAL;
       rflevel,
       usbgain,
       sq,
       lastlev,
       afskifwidth,
       oldaf,
       wavoldaf,
       jmhz,
       clamph,
       clampl,
       lastu,
       noise,
       qual,
       fe,
       afc,
       afcmul,
       afclimit,
       level      :REAL;
       scrambler  :SET32;
       frame      :ARRAY[0..350] OF CHAR;
       afbuf      :ARRAY[0..4095] OF INT16;
     END;

     pFSK4MODEM=POINTER TO FSK4MODEM;
     FSK4MODEM=RECORD
       next        :pFSK4MODEM;
       modemnum,
       afbufw,
       subbands,
       demods,
       subspaceing,
       maxframelen,
       ifsamp,
       ifstep,
       baseoversamp:CARDINAL;
       soundfd     :INTEGER;
       ademod      :CHAR;
       iflpi,
       iflpq       :LPCONTEXT24;
       usbosc,
       iffreq,
       ifosc       :CARD16;
       freq,
       osc         :ARRAY[0..MAXSUBBANDS-1] OF CARD16; 
       baselp      :ARRAY[0..MAXSUBBANDS*2-1] OF LPCONTEXT24; 
       rfdb,
       usbgain,
       wavoldaf,
       baud,
       ifsamprate,
       ifbandwidth,
       baseband,
       spaceing,
       jmhz        :REAL;
       demod       :ARRAY[0..MAXDEMODS-1] OF DEMOD;
       bestframe   :BESTFRAME;
       afbuf       :ARRAY[0..4095] OF INT16;
     END;   


     pUDPDESTS=POINTER TO UDPDESTS;
     UDPDESTS=RECORD
       next:pUDPDESTS;
       ipnum:IPNUM;
       toport:UDPPORT;
       udp2:BOOLEAN;
     END;

     pSHIP=POINTER TO SHIP;
     SHIP=RECORD
            next:pSHIP;
            dimens, 
            mmsi:CARDINAL; 
            name:ARRAY[0..19] OF CHAR;
            dest:ARRAY[0..19] OF CHAR;
            call:ARRAY[0..6] OF CHAR;
            vendorid:ARRAY[0..6] OF CHAR;
            eta:ARRAY[0..7] OF CHAR;
            draught:REAL;
            typ:CARD8;
          END;

     pCALLS=POINTER TO CALLS;
     CALLS=RECORD
             next:pCALLS;
             num :CARDINAL;
             valid:CARD8; 
             call:ARRAY[0..15] OF CHAR;
           END;

VAR
    fsk4modems  :pFSK4MODEM;
    afskmodems  :pAFSKMODEM;
    iqfn,    
    ccfilename,
    jpipename   :ARRAY[0..1023] OF CHAR;
    mycall      :ARRAY[0..9] OF CHAR;
    bfofreq,
    iqfd, 
    aisfd,
    jsonfd      :INTEGER;
    insamprate,
    isize       :CARDINAL;
    ccdone,
    verb,
    verb2       :BOOLEAN;
    udpsock     :INTEGER;
    iqbuf:ARRAY[0..MAXINBUF*2-1] OF INT16;
    DDS :ARRAY[0..DDSLEN-1] OF INT16;
    DDSS:ARRAY[0..DDSSLEN-1] OF REAL;
    jipnum      :IPNUM;
    judpport    :UDPPORT;
    squelch4    :REAL;
    udpdests    :pUDPDESTS;
    checktable  :ARRAY[0..10] OF RECORD payload, time:CARDINAL END;
    decodingtable:ARRAY[0..2047] OF CARDINAL;
    ships:pSHIP;
    calls:pCALLS;
    countrycodes:POINTER TO ARRAY[0..999] OF ARRAY[0..31] OF CHAR;

PROCEDURE Error(text-:ARRAY OF CHAR);
BEGIN
  Werr("fsk4rx:"); Werr(text); Werr(" error abort"+LF);
  HALT
END Error;

PROCEDURE hex(n:CARDINAL; cap:BOOLEAN):CHAR;
BEGIN
  n:=n MOD 16;
  IF n<=9 THEN RETURN CHR(n+ORD("0")) END;
  IF cap THEN  RETURN CHR(n+(ORD("A")-10)) END;
  RETURN CHR(n+(ORD("a")-10))
END hex;

PROCEDURE HexStr(x, digits, len:CARDINAL; cap:BOOLEAN; VAR s:ARRAY OF CHAR);
VAR i:CARDINAL;
BEGIN
  IF digits>HIGH(s) THEN digits:=HIGH(s) END;
  i:=digits;
  WHILE (i<len) & (i<HIGH(s)) DO
    s[i]:=" ";
    INC(i);
  END;
  s[i]:=0C;
  WHILE digits>0 DO
    DEC(digits);
    s[digits]:=hex(x, cap);
    x:=x DIV 16;
  END;
END HexStr;

PROCEDURE WrHex(x, digits, len:CARDINAL);
VAR s:ARRAY[0..255] OF CHAR;
BEGIN
  HexStr(x, digits, len, FALSE, s);
  WrStr(s);
END WrHex;

PROCEDURE WrHexCap(x, digits, len:CARDINAL);
VAR s:ARRAY[0..255] OF CHAR;
BEGIN
  HexStr(x, digits, len, TRUE, s);
  WrStr(s);
END WrHexCap;


PROCEDURE ChHex(c:CHAR; VAR s:ARRAY OF CHAR);
BEGIN
  IF (c>=177C) OR (c<" ") THEN
    s[0]:="[";
    s[1]:=hex(ORD(c) DIV 16, FALSE);
    s[2]:=hex(ORD(c), FALSE);
    s[3]:="]";
    s[4]:=0C;
  ELSE s[0]:=c; s[1]:=0C; END;
END ChHex;

PROCEDURE WrChHex(c:CHAR);
VAR s:ARRAY[0..10] OF CHAR;
BEGIN
  ChHex(c, s);
  WrStr(s);
END WrChHex;


PROCEDURE sqr(x:REAL):REAL;
BEGIN RETURN x*x END sqr;

PROCEDURE atan2(u-:Complex):REAL;
VAR w:REAL;
    abs:Complex;
BEGIN
  abs.Re:=ABS(u.Re);
  abs.Im:=ABS(u.Im);
  IF abs.Im>abs.Re THEN
    IF abs.Im>0.0 THEN w:=abs.Re/abs.Im ELSE w:=0.0 END;
    w:=PI/2.0 - (w*1.055 - w*w*0.267);                    (* arctan *)
  ELSE
    IF abs.Re>0.0 THEN w:=abs.Im/abs.Re ELSE w:=0.0 END;
    w:=w*1.055 - w*w*0.267;
  END;
  IF u.Re<0.0 THEN w:=PI-w END;
  IF u.Im<0.0 THEN w:=-w END;
  RETURN w
END atan2;

PROCEDURE dB(u:REAL):REAL;
BEGIN
  IF u>0.0001 THEN RETURN log(u)*8.68588963 END;
  RETURN 0.0
END dB;

PROCEDURE fmhighpass(w:REAL; VAR w1:REAL):REAL;
VAR af:REAL;
BEGIN
(* phase highpass make FM out of phase *)
  af:=w-w1;
  w1:=w;
  IF af> PI THEN af:=af - PI*2.0 END;
  IF af<-PI THEN af:=af + PI*2.0 END;
  RETURN af
END fmhighpass;

PROCEDURE wwav(fd:INTEGER; hz:CARDINAL);
CONST bytes=2;
VAR b:ARRAY[0..43] OF CHAR;
BEGIN
  b:="RIFF    WAVEfmt ";
  b[4]:=377C;                                     (* len *)
  b[5]:=377C;
  b[6]:=377C;
  b[7]:=377C;

  b[16]:=20C;
  b[17]:=0C;
  b[18]:=0C;
  b[19]:=0C;

  b[20]:=1C;                                      (* PCM/ALAW *)
  b[21]:=0C;

  b[22]:=CHR(1);                                  (* channels *)
  b[23]:=0C;

  b[24]:=CHR(hz MOD 100H);                        (* samp *)
  b[25]:=CHR(hz DIV 100H MOD 100H);
  b[26]:=CHR(hz DIV 10000H MOD 100H);
  b[27]:=CHR(hz DIV 1000000H);

  b[28]:=CHR(hz*bytes MOD 256);                   (* byte/s *)
  b[29]:=CHR(hz*bytes DIV 256 MOD 256);
  b[30]:=CHR(hz*bytes DIV 65536);
  b[31]:=0C;

  b[32]:=CHR(bytes);                              (* block byte *)
  b[33]:=0C;
  b[34]:=20C;                                     (* bit/samp *)
  b[35]:=0C;

  b[36]:="d";
  b[37]:="a";
  b[38]:="t";
  b[39]:="a";

  b[40]:=377C;       (* len *)
  b[41]:=377C;
  b[42]:=377C;
  b[43]:=377C;

  IF fd>=0 THEN WrBin(fd, b, 44) END;
END wwav;


PROCEDURE ln0(x:REAL):REAL;
BEGIN
  IF x<=0.0 THEN RETURN 0.0 END;
  RETURN log(x)
END ln0;
 

PROCEDURE MakeDDS(VAR dds:ARRAY OF REAL);
VAR i:CARDINAL;
    r:REAL; 
BEGIN
  r:=PI*2.0/FLOAT(HIGH(dds)+1);
  FOR i:=0 TO HIGH(dds) DO dds[i]:=sin(FLOAT(i)*r) END;
END MakeDDS;

PROCEDURE MakeDDSi(VAR dds:ARRAY OF INT16);
VAR i:CARDINAL;
    r:REAL; 
BEGIN
  r:=PI*2.0/FLOAT(HIGH(dds)+1);
  FOR i:=0 TO HIGH(dds) DO dds[i]:=VAL(INT16, 16383.9*sin(FLOAT(i)*r)) END;
END MakeDDSi;

PROCEDURE makelp24(fg, samp:REAL; VAR c:LPCONTEXT24);
BEGIN
  WITH c DO
    LPR:=fg/samp*2.33363;
    LPL:=LPR*LPR*2.888*(1.0-9.0*pow(fg/samp,2.0));
    OLPR:=1.0-LPR;
  END;
END makelp24;


PROCEDURE GetIp(h:ARRAY OF CHAR; VAR ip:CARDINAL; VAR port:CARDINAL):INTEGER;

CONST DEFAULTIP=7F000001H;
      PORTSEP=":";

VAR i, n, p:CARDINAL;
    ok:BOOLEAN;
BEGIN
  p:=0;
  h[HIGH(h)]:=0C;
  ip:=0;
  FOR i:=0 TO 4 DO
    IF (i>=3) OR (h[0]<>PORTSEP) THEN
      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;

    END;
    IF i<3 THEN
      IF h[0]<>PORTSEP THEN
        IF (h[p]<>".") OR (n>255) THEN RETURN -1 END;

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

    ELSIF n>65535 THEN RETURN -1 END;

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

PROCEDURE createnonblockfile(fn:ARRAY OF CHAR):INTEGER;
VAR fd:INTEGER;
BEGIN
  fd:=OpenNONBLOCK(fn);
  IF (fd<0) OR NOT IsFifo(fd) THEN   (* no pipe *)
    IF fd>=0 THEN Close(fd) END;
    fd:=OpenWrite(fn)
  END;
  RETURN fd
END createnonblockfile;


PROCEDURE checkcall(call-:ARRAY OF CHAR):CARDINAL;
VAR i,j, nn, nc:CARDINAL;
BEGIN
  j:=0;
  WHILE (j<=HIGH(call)) & (call[j]<>0C) & (call[j]<>"-") DO INC(j) END;
  nn:=0;
  nc:=0;
  i:=0;
  WHILE i<j DO
    IF (call[i]>="A") & (call[i]<="Z") THEN INC(nc);
    ELSIF (i<=2) & (call[i]>="0") & (call[i]<="9") THEN INC(nn) END;  
    INC(i);
  END;
  IF (j<=6) & (j>=3) & (nn+nc=j) & (nn>=1) & (nn<=2) THEN        (* looks like a ham callsign *)    
    IF (j<=HIGH(call)) & (call[j]="-") THEN                      (* looks some ssid *)
      INC(j);
      IF (j<=HIGH(call)) & (call[j]>="0") & (call[j]<="9") THEN
        INC(j);
        IF (j<=HIGH(call)) & (call[j]>="0") & (call[j]<="9") THEN INC(j) END;
        RETURN j
      END;
      IF Length(call)<=9 THEN RETURN Length(call) END;          (* strange ssid but fits in object *)
    ELSE RETURN j END;
  END;
  RETURN 0
END checkcall;

PROCEDURE callbookread(fn-:ARRAY OF CHAR):BOOLEAN;
VAR f, res:INTEGER;
    p:pCALLS;
    ch:CHAR; 
    st:CARDINAL;
BEGIN
  f:=OpenRead(fn);
  IF f<0 THEN RETURN FALSE END;

  p:=NIL;
  st:=0;
  WHILE RdBin(f, ch, 1)=1 DO
    IF (st=0) & (ch="#") THEN st:=9 END;
    IF st<>9 THEN 
      IF p=NIL THEN
        ALLOCATE(p, SIZE(p^));
        IF p=NIL THEN Error("out of memory") END;
        p^.num:=0;
        p^.call:="";
        st:=0;
      END;    
      IF ch>" " THEN 
        IF st<=1 THEN
          IF (ch>="0") & (ch<="9") THEN
            p^.num:=p^.num*10+ORD(ch)-ORD("0");
            st:=1;
          ELSIF st=1 THEN st:=2 ELSE st:=9 END;
        ELSIF (st<=3) & (ch<>",") THEN
          Append(p^.call, ch);
          st:=3;
        END;
      ELSIF st=3 THEN
        p^.valid:=checkcall(p^.call);
        IF verb2 THEN WrCard(p^.num,1); WrStr(":"); WrStr(p^.call); WrStr(" valid-len:"); WrCard(p^.valid,1); WrStrLn("") END;

        p^.next:=calls;
        calls:=p;
        p:=NIL; 
      END;
    ELSIF ch<" " THEN st:=0 END; 
  END;
  Close(f);
  RETURN TRUE
END callbookread;


PROCEDURE findcall(n:CARDINAL; VAR name, nocall:ARRAY OF CHAR);
VAR p:pCALLS;
    i,j, nn, nc:CARDINAL;
BEGIN
  name[0]:=0C;
  nocall[0]:=0C;
  p:=calls;
  WHILE p<>NIL DO
    IF p^.num=n THEN           (* call found *)
      IF p^.valid>0 THEN
        Assign(name, p^.call);
        IF p^.valid<=HIGH(name) THEN name[p^.valid]:=0C END;  (* strip junk after valid callsign *)
        WHILE Length(name)<9 DO Append(name, " ") END;
      ELSE Assign(nocall, p^.call) END;
      RETURN

    END;
    p:=p^.next;
  END;
END findcall;


PROCEDURE Parms;
VAR err,
    ok,
    hasudp         :BOOLEAN;
    sqlev, 
    stored,
    scramble, 
    ifwid,
    afsklowtone,
    afskhightone,
    afclim,
    n,
    fskbaud,
    afskbaud,
    i              :CARDINAL; 
    h              :ARRAY[0..1023] OF CHAR;
    udest          :pUDPDESTS;
    bfof,
    tune,
    soundfd        :INTEGER;
    spaceing,
    baseband,
    baud,
    ifbandwidth,
    jmhz           :REAL;
    mod,
    ademod         :CHAR;
    p4             :pFSK4MODEM;
    pa             :pAFSKMODEM;


  PROCEDURE newmodem;
  VAR i:CARDINAL;
  BEGIN
    IF VAL(CARDINAL, ABS(tune))*2>insamprate THEN Error("tuned outside bandwifth (-t)") END;

    IF mod=MOD4 THEN  
      ALLOCATE(p4, SIZE(p4^));
      IF p4=NIL THEN Error("out of memory") END;

      FILL(p4, 0C, SIZE(p4^)); 
      p4^.ifbandwidth:=ifbandwidth;
      p4^.subspaceing:=TRUNC(spaceing/(baseband*0.4));       (* stay in baseband window *)
      p4^.subbands:=TRUNC(ifbandwidth/(spaceing/FLOAT(p4^.subspaceing)));
      p4^.demods:=p4^.subbands-(NFSK-1)*p4^.subspaceing;
      p4^.maxframelen:=63;
      p4^.ifsamprate:=BASESTEP*OVERSAMP*baud;
      p4^.ifstep:=TRUNC(FLOAT(p4^.ifsamprate)/FLOAT(insamprate)*FLOAT(MAX(CARDINAL)));
      p4^.soundfd:=soundfd;
      p4^.ademod:=ademod;
      p4^.spaceing:=spaceing;
      p4^.baseband:=baseband;
      p4^.baud:=baud;
      makelp24(p4^.spaceing/FLOAT(p4^.subspaceing)*FLOAT(p4^.subbands)*0.65, FLOAT(insamprate), p4^.iflpi);
      makelp24(p4^.spaceing/FLOAT(p4^.subspaceing)*FLOAT(p4^.subbands)*0.65, FLOAT(insamprate), p4^.iflpq);
      FOR i:=0 TO p4^.subbands-1 DO
        makelp24(p4^.baseband*0.5, FLOAT(p4^.ifsamprate), p4^.baselp[i*2]);
        makelp24(p4^.baseband*0.5, FLOAT(p4^.ifsamprate), p4^.baselp[i*2+1]);
        p4^.freq[i]:=VAL(INTEGER, FLOAT(DDSSLEN)*FLOAT(p4^.spaceing)/FLOAT(p4^.subspaceing)*(FLOAT(i)-FLOAT(p4^.subbands DIV 2)+0.5)/FLOAT(p4^.ifsamprate));
      END;
      bfofreq:=VAL(INTEGER, VAL(REAL, bfof)*0.25*VAL(REAL, DDSLEN)/VAL(REAL, p4^.ifsamprate));
      p4^.jmhz:=jmhz;
      IF p4^.soundfd>=0 THEN wwav(p4^.soundfd, TRUNC(p4^.ifsamprate)) END; 
      ademod:=0C;
      soundfd:=-1; 
      p4^.iffreq:=VAL(INTEGER, FLOAT(DDSLEN)*FLOAT(tune)/FLOAT(insamprate));
      p4^.modemnum:=stored;
      p4^.next:=fsk4modems;
      fsk4modems:=p4;
      IF verb THEN
        WrStrLn("");
        WrStr("offset:"); WrInt(tune,1); WrStrLn("Hz");
        WrStr("4fsk spaceing:"); WrFixed(p4^.spaceing, 2,1); WrStrLn("Hz");
        WrStr("baud:"); WrFixed(p4^.baud, 2,1); WrStrLn("");
        WrStr("if-bandwidth:"); WrFixed(p4^.ifbandwidth, 2,1); WrStrLn("Hz");
        WrStr("demodbandwidth:"); WrFixed(p4^.baseband, 2,1); WrStrLn("Hz");
        WrStr("demodulators:"); WrCard(p4^.demods,1);WrStrLn("");
        WrStr("demodulator every:"); WrFixed(p4^.spaceing/FLOAT(p4^.subspaceing),2,1); WrStrLn("Hz");
        WrStr("if-samplerate:"); WrFixed(p4^.ifsamprate,2,1); WrStrLn("Hz");
        WrStr("afc-range +/-:"); WrFixed(FLOAT(p4^.demods DIV 2)*p4^.spaceing/FLOAT(p4^.subspaceing),1,1); WrStrLn("Hz");
        WrStr("squelch:"); WrFixed(squelch4,1,1); WrStrLn("dB");
        WrStrLn("");
      END;

    ELSIF (mod=MODA) OR (mod=MODF) OR (mod=MOD0) THEN  
      ALLOCATE(pa, SIZE(pa^));
      IF pa=NIL THEN Error("out of memory") END;

      FILL(pa, 0C, SIZE(pa^)); 
      pa^.ademod:=ademod;
      pa^.demod:=mod;
      pa^.scrambled:=scramble=1;
      pa^.rawbits:=scramble=2;
      pa^.baud:=afskbaud;
      IF pa^.demod=MODF THEN
        pa^.ifsamprate:=19200;
        IF fskbaud*2>pa^.ifsamprate THEN pa^.ifsamprate:=fskbaud*2 END;
        pa^.baud:=fskbaud;
      ELSIF pa^.demod=MODA THEN
        pa^.ifsamprate:=pa^.baud*AFSKOVERSAMPLE;
        pa^.baud:=afskbaud;
      ELSE
        pa^.ifsamprate:=fskbaud;
      END;
      pa^.afclimit:=FLOAT(afclim)/FLOAT(pa^.ifsamprate)*(PI*2.0);
      pa^.afcmul:=FLOAT(DDSLEN)/FLOAT(insamprate)*(FLOAT(pa^.ifsamprate)*(0.5/PI));

      pa^.jmhz:=jmhz;
      pa^.afskifwidth:=FLOAT(ifwid);
      pa^.soundfd:=soundfd;
      IF pa^.soundfd>=0 THEN wwav(pa^.soundfd, pa^.ifsamprate) END;
      pa^.ifstep:=TRUNC(FLOAT(pa^.ifsamprate)/FLOAT(insamprate)*FLOAT(MAX(CARDINAL)));
      makelp24(pa^.afskifwidth*0.5, FLOAT(insamprate), pa^.iflpi);
      makelp24(pa^.afskifwidth*0.5, FLOAT(insamprate), pa^.iflpq);
      makelp24(FLOAT(pa^.baud)*0.5, FLOAT(pa^.ifsamprate),pa^.fsklp);
      IF pa^.demod=MODA THEN
        pa^.freq[0]:=VAL(INTEGER, (FLOAT(DDSSLEN)*FLOAT(afsklowtone)+0.5)/FLOAT(pa^.ifsamprate));
        pa^.freq[1]:=VAL(INTEGER, (FLOAT(DDSSLEN)*FLOAT(afskhightone)+0.5)/FLOAT(pa^.ifsamprate));
        FOR i:=0 TO 3 DO makelp24(FLOAT(pa^.baud)*0.5, FLOAT(pa^.ifsamprate), pa^.baselp[i]) END;
      END;
      bfofreq:=VAL(INTEGER, VAL(REAL, bfof)*0.25*VAL(REAL, DDSLEN)/VAL(REAL, pa^.ifsamprate));
      soundfd:=-1;
      pa^.sqlev:=sqlev; 
      sqlev:=0;
      pa^.modemnum:=stored;
      pa^.next:=afskmodems;
      pa^.iffreq:=VAL(INTEGER, FLOAT(DDSLEN)*FLOAT(tune)/FLOAT(insamprate));
      pa^.iffreqafc:=pa^.iffreq;
      afskmodems:=pa;
      IF verb THEN
        WrStrLn("");
        WrStr("offset:"); WrInt(tune, 1); WrStrLn("Hz");
        IF afclim>0 THEN WrStr("max.afc:+-"); WrInt(afclim, 1); WrStrLn("Hz") END;
        WrStr("if-bandwidth:"); WrInt(VAL(INTEGER, pa^.afskifwidth),1);  WrStrLn("Hz");
        WrStr("if-samplerate:"); WrCard(pa^.ifsamprate, 1); WrStrLn("Hz");
        IF pa^.afskifwidth>VAL(REAL, pa^.ifsamprate)
        THEN WrStrLn("bandwidth should be lower than samplerate!") END;
        IF pa^.demod=MODF THEN
          WrStr("fsk ");
          IF pa^.scrambled THEN WrStr("scrambled ") END;
        ELSIF pa^.demod=MODA THEN WrStr("afsk ") END; 
        IF pa^.demod=MOD0 THEN
          WrStr("squelch:"); WrCard(pa^.sqlev, 1); WrStrLn("");
          IF pa^.soundfd<0 THEN WrStr("fm demod with no audio output?") END; 
        ELSE WrStr("baud:"); WrCard(pa^.baud, 1) END;
        IF pa^.demod=MODA THEN
          WrStr(" low tone:"); WrCard(afsklowtone, 1); WrStr(" ");
          WrStr("high tone:"); WrCard(afskhightone, 1);
        END;
        WrStrLn("");
      END;

    END;
  END newmodem;

  PROCEDURE num(VAR v:CARDINAL; h-:ARRAY OF CHAR; VAR i:CARDINAL);
  VAR n:CARDINAL;
      sg:BOOLEAN; 
  BEGIN
    IF h[i]<>"," THEN
      sg:=FALSE;
      n:=0;
      IF h[i]="+" THEN INC(i) ELSIF h[i]="-" THEN sg:=TRUE; INC(i) END;
      WHILE (i<HIGH(h)) & (h[i]<>",") & (h[i]>="0") & (h[i]<="9") DO
        n:=n*10 + ORD(h[i])-ORD("0");
        INC(i);
      END;
      IF sg THEN n:=-VAL(INTEGER,n) END;
      v:=n;
    END;
  END num;


BEGIN
  mod:=MOD4;
  ademod:=0C;
  soundfd:=-1;
  jmhz:=0.0;
  iqfn:="";
  isize:=1;
  verb:=FALSE;
  verb2:=FALSE;
  squelch4:=8.0;
  err:=FALSE;
  udpsock:=-1;
  jpipename:="";
  judpport:=0;
  jsonfd:=-1;
  aisfd:=-1;
  insamprate:=0;
  tune:=0;
  udpdests:=NIL;
  spaceing:=SPACEING;
  baseband:=BASEBAND;
  ifbandwidth:=IFBAND;
  baud:=BAUD;
  afskbaud:=1200;
  fskbaud:=9600;
  ifwid:=16000;
  afsklowtone:=1200;
  afskhightone:=2200;
  stored:=0;
  sqlev:=0;
  afclim:=0;
  bfof:=BFOFREQ;
  LOOP
    NextArg(h);
    IF h[0]=0C THEN EXIT END;
    IF (h[0]="-") & (h[1]<>0C) & (h[2]=0C) THEN

      IF h[1]="i" THEN
        NextArg(iqfn);
        IF (iqfn[0]=0C) OR (iqfn[0]="-") THEN Error("-i <iqfilename>") END;

      ELSIF h[1]="S" THEN
        IF soundfd>=0 THEN Error("only FM or SSB") END;
        NextArg(h);
        ademod:="S";
        IF (h[0]=0C) OR (h[0]="-") THEN Error("-S <usb-file/pipe-name>") END;
        soundfd:=createnonblockfile(h);
        IF soundfd<0 THEN Error("usbfile create") END;

      ELSIF h[1]="F" THEN
        IF soundfd>=0 THEN Error("only FM or SSB") END;
        NextArg(h);
        ademod:="F";
        IF (h[0]=0C) OR (h[0]="-") THEN Error("-F <fm-file/pipe-name>") END;
        soundfd:=createnonblockfile(h);
        IF soundfd<0 THEN Error("fmfile create") END;

      ELSIF h[1]="f" THEN
        NextArg(h);
        IF (h[0]="i") & (h[1]="1") & (h[2]="6") THEN isize:=2
        ELSIF (h[0]="u") & (h[1]="8") THEN isize:=1
        ELSIF (h[0]="f") & (h[1]="3") & (h[2]="2") THEN isize:=4
        ELSE Error("-f u8|i16|f32") END;

      ELSIF h[1]="M" THEN
        NextArg(h);
        IF NOT StrToFix(jmhz, h) THEN Error("-M <MHz>") END;

      ELSIF h[1]="W" THEN
        NextArg(h);
        IF NOT StrToFix(ifbandwidth, h) OR (ifbandwidth<100.0) THEN Error("-W <ifbandwidth-Hz>") END;

      ELSIF h[1]="B" THEN
        NextArg(h);

      ELSIF h[1]="m" THEN
        IF stored>0 THEN newmodem END;
        INC(stored);

        NextArg(h); mod:=h[0];
        IF mod=MODA THEN
          i:=1;
          IF h[i]="," THEN INC(i); num(afskbaud, h, i) END;
          IF afskbaud=2400 THEN afsklowtone:=1995; afskhightone:=3658 END;
          IF h[i]="," THEN INC(i); num(afsklowtone, h, i) END;
          IF h[i]="," THEN INC(i); num(afskhightone, h, i) END;
          IF h[i]="," THEN INC(i); num(ifwid, h, i) END;
          IF h[i]<>0C THEN Error("-m "+MODA+",<baud>,<low>,<hightone>,<if-width>") END;  

        ELSIF mod=MODF THEN
          scramble:=1; 
          i:=1;
          IF h[i]="," THEN INC(i); num(fskbaud, h, i) END;
          IF h[i]="," THEN INC(i); num(ifwid, h, i) END;
          IF h[i]="," THEN INC(i); num(scramble, h, i) END;
          IF h[i]<>0C THEN Error("-m "+MODA+",<baud>,<if-width>,<scrambler>") END;  

        ELSIF mod=MOD0 THEN
          i:=1;
          IF h[i]="," THEN INC(i); num(fskbaud, h, i) END;
          IF h[i]="," THEN INC(i); num(ifwid, h, i) END;
          IF h[i]="," THEN INC(i); num(sqlev, h, i) END;
          IF h[i]<>0C THEN Error("-m "+MOD0+",<sampelrate>,<if-width>,<squelch>") END;  

        ELSIF mod<>MOD4 THEN Error("-m "+MODF+",<baud>,<if-width>") END;


      ELSIF h[1]="b" THEN
        NextArg(h);
        IF NOT StrToFix(baud, h) OR (baud<1.0) THEN Error("-b <baud>") END;

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

      ELSIF h[1]="t" THEN
        NextArg(h);
        i:=0;
        num(n, h, i);
        tune:=n; 
        IF h[i]="," THEN INC(i); num(afclim, h, i) END;
        IF h[i]<>0C THEN Error("-t <+-Hz>[,<Hz>]") END;
 
      ELSIF h[1]="D" THEN
        NextArg(h);
        IF NOT StrToFix(spaceing, h) OR (spaceing<1.0) THEN Error("-D <Hz>") END;

      ELSIF h[1]="q" THEN
        NextArg(h);
        IF NOT StrToFix(squelch4, h) THEN Error("-q <dB>") END;
        verb:=TRUE;

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

      ELSIF h[1]="r" THEN
        NextArg(h);
        IF NOT StrToCard(h, insamprate) OR (insamprate<100) THEN Error("-r <samplerate-Hz>") END;

      ELSIF h[1]="n" THEN
        NextArg(h);
        IF NOT StrToInt(h, bfof) THEN Error("-n <bfo-frequency-Hz>") END;

<* IF WITHUDP OR WITHAPRS THEN *>
      ELSIF (h[1]="U") OR (h[1]="L") THEN
        ALLOCATE(udest, SIZE(udest^));
        IF udest=NIL THEN Error("out of memory") END;
        udest^.udp2:=h[1]="L";         (* switch on axudp2 *)
        NextArg(h);
        IF GetIp(h, udest^.ipnum, udest^.toport)<0 THEN Error("-U or -L ip:port number") END;
        udest^.next:=udpdests;
        udpdests:=udest;
        hasudp:=TRUE;

<* END *>

      ELSIF h[1]="J" THEN
        hasudp:=TRUE;
        NextArg(h);
        IF GetIp(h, jipnum, judpport)<0 THEN Error("-J ip:port number") END;

      ELSIF h[1]="A" THEN
        NextArg(h);
        aisfd:=OpenRead(h);
        IF aisfd<0 THEN aisfd:=OpenWrite(h)
        ELSE
          Close(aisfd);
          aisfd:=OpenAppend(h);
        END;
        IF aisfd<0 THEN Error("-A <filename>") END;

      ELSIF h[1]="C" THEN
        NextArg(h);
        IF NOT callbookread(h) THEN Error("-C <callbook> file not readable") END;

      ELSIF h[1]="Y" THEN
        NextArg(ccfilename);

      ELSIF h[1]="h" THEN
        WrStrLn("");
        WrStrLn("  Decode AFSK, FSK, 4FSK out of IQ-File/Pipe by oe5dxl");
        WrStrLn("  output data in udp, axudp or json + output pipe or file (wav) FM or USB");
        WrStrLn("");
        WrStrLn(" -A <filename>      write (append) ais shipdata to file");
        WrStrLn(" -B <Hz>            4fsk demodulator carriers filter bandwidth (140)");
        WrStrLn(" -b <baud>          4fsk baudrate, symbols/s (100)");
        WrStrLn(" -C <filename>      read callsign database to replace payload number if valid callsign found (<num>,<call>)");
        WrStrLn(" -D <Hz>            deviation, spaceing between 2 4fsk tones (270)");
        WrStrLn(" -F <filename>      output FM demodulated audio wav to file or (unbreakable) pipe");
        WrStrLn(" -f u8|i16|f32      IQ data format (f32 slow");
        WrStrLn(" -h                 this");
        WrStrLn(" -I <callsign-ssid> Callsign of APRS-object sender (NOCALL)");
        WrStrLn(" -i <file>          IQ-filename or pipe from sdr receiver");
        WrStrLn(" -J <x.x.x.x:destport>  send demodulated data(base64) with metadata in json");
--        WrStrLn(" -j <file/pipe>     write demodulated data(base64) with metadata in json to file or (unbreakable) pipe");
<* IF WITHUDP OR WITHAPRS  THEN *>
        WrStrLn(" -L <x.x.x.x:destport>  as -U but AXUDPv2 with metadata for igate"); 
<* END *>
        WrStrLn(" -M <MHz>           pass through rx frequency to json metadata and aprs comment -M 437.6");
        WrStrLn(" -m "+MOD4+"               demodulate 4fsk (default)");
        WrStrLn(" -m "+MODA+"[,<baud>[,<low>[,<hightone>[,<if-width>]]]] afsk (-m "+MODA+",1200,1200,2400,12500");
        WrStrLn(" -m "+MODF+"[,<baud>[,<if-width>[,<sramble>]]] fsk, scramble=2 raw hdlc, -m "+MODF+",9600,16000,1");
        WrStrLn(" -m "+MOD0+"[,<samplerate>[,<if-width>,<squelch>]]] no demodulator, use for audio pipe -m "+MOD0+",16000,12500 -F af.wav");
        WrStrLn("                      may be repeated as cpu is able to do with following other -t ");
        WrStrLn(" -n <Hz>            bfo frequency Hz for ssb audio output, -1500 for lsb (1500)");
        WrStrLn(" -q <dB>            verbous like -v but show only frames with crc ok or SNR over <dB> (8)");
        WrStrLn("                      set to 0 to show all, 100 for frames with crc ok, axudp sent if crc ok");
        WrStrLn(" -r <Hz>            iq samplerate");
        WrStrLn(" -S <filename>      output USB demodulated audio wav to file or (unbreakable) pipe");
        WrStrLn(" -t <+-Hz>[,<Hz>]   Shift rx-frequency inside IQ band (avoid near 0 where is adc birdy) (0)");
        WrStrLn("                      afc-follow-range Hz, 90% in about 10ms, 0=afc off (0)");
--        WrStrLn(" -N                 fsk steps (4)");
<* IF WITHUDP OR WITHAPRS  THEN *>
        WrStrLn(" -U <x.x.x.x:destport>  send frame in AXUDP, may be repeated to more destinations"); 
<* END *>
--        WrStrLn(" -V                 very verbous");
        WrStrLn(" -v                 verbous");
        WrStrLn(" -W <Hz>            if-bandwidth 4fsk (2970)");
        WrStrLn(" -Y <filename>      read AIS countrynames database (<num> <name>)");
        WrStrLn("");

        WrStrLn("  mknod a.wav p");
        WrStrLn("  rtl_sdr -f 437.5m -s 1024000 - | ./fsk4rx -i /dev/stdin -f u8 -v -r 1024000 -t 100000 -L 127.0.0.1:9001 -M 437.6 -I MYCALL-11 -S a.wav");
        WrStrLn("  usb rx: rtl_sdr -f 144.4m -s 1024000 - | ./fsk4rx -i /dev/stdin -f u8 -v -r 1024000 -t 28000 -m 0,16000,2400 -S a.wav");
        WrStrLn("  AIS rx: rtl_sdr -f 162.0m -s 1024000 -g 49 - | ./fsk4rx -i /dev/stdin -f u8 -v -r 1024000 -m f,9600,11000,2 -t -25000 -m f,9600,11000,2 -t 25000 -U 127.0.0.1:9000");
        WrStrLn("  aplay a.wav");

        HALT
 
      ELSE err:=TRUE END;
    ELSE err:=TRUE END;
    IF err THEN EXIT END;
  END;
  IF err THEN Werr(">"); Werr(h); Werr("< use -h"+LF); HALT END;

  newmodem;
  IF hasudp THEN
    IF udpsock<0 THEN udpsock:=openudp() END;
    IF udpsock<0 THEN Error("cannot open udp socket") END;
  END;
  IF insamprate=0 THEN Error("need input samplerate (-r)") END;
END Parms;


PROCEDURE sendjson(jipnum:IPNUM; judpport:UDPPORT; text-:ARRAY OF CHAR; mod:ARRAY OF CHAR;
                   dlen, fec:CARDINAL; baud:REAL; ppm, afc:INTEGER; crc:BOOLEAN; snr, rfdb, jmhz:REAL);

  PROCEDURE b64(c:CARDINAL):CHAR;
  BEGIN
    c:=c MOD 64;
    IF c<26 THEN RETURN CHR(c+ORD("A"))
    ELSIF c<52 THEN RETURN CHR(c+(ORD("a")-26))
    ELSIF c<62 THEN RETURN CHR(VAL(INTEGER, c)+(VAL(INTEGER,ORD("0"))-52))
    ELSIF c=62 THEN RETURN "+"
    ELSE RETURN "/" END;
  END b64;
 
  PROCEDURE enc64(b, n:CARDINAL; VAR s:ARRAY OF CHAR);
  VAR i:CARDINAL;
  BEGIN
    FOR i:=n TO 2 DO b:=b*256 END;
    s[2]:="=";
    s[3]:="=";
    s[4]:=0C;
    s[0]:=b64(b DIV 40000H);
    s[1]:=b64(b DIV 1000H);
    IF n>=2 THEN s[2]:=b64(b DIV 40H) END;
    IF n=3 THEN s[3]:=b64(b) END;
  END enc64;

VAR s,h:ARRAY[0..999] OF CHAR;
    ret:INTEGER;
    i,b:CARDINAL;
BEGIN
  s:="{";
  Append(s, '"mod":"'); Append(s,mod);
  Append(s, '",baud":'); FixToStr(baud, 1, h); Append(s, h);
  Append(s, '","len":'); CardToStr(dlen, 1, h); Append(s, h);
  Append(s, ',"crc":'); CardToStr(ORD(crc), 1, h); Append(s, h);
  Append(s, ',"afc":'); IntToStr(afc, 1, h); Append(s, h);
  Append(s, ',"snr":'); FixToStr(snr, 2, h); Append(s, h);
  Append(s, ',"rfdb":'); FixToStr(rfdb, 2, h); Append(s, h);
  Append(s, ',"ppm":'); IntToStr(ppm, 1, h); Append(s, h);
  Append(s, ',"fecbits":'); CardToStr(fec, 1, h); Append(s, h);
  IF jmhz<>0.0 THEN Append(s, ',"rxmhz":'); FixToStr(jmhz+0.0005, 4, h); Append(s, h) END;
  Append(s, ',"ver":"fsk4rx"');
  Append(s, ',"payload":"');
  b:=0;
  i:=0;
  WHILE i<dlen DO            (* base64 encode *)
    b:=b*256 + ORD(text[i]);
    IF i MOD 3=2 THEN enc64(b, 3, h); Append(s, h); b:=0 END;
    INC(i);
  END;
  IF i MOD 3<>0 THEN enc64(b, i MOD 3, h); Append(s, h) END;  
  Append(s, '"}'+LF);

  IF jpipename[0]<>0C THEN
    IF jsonfd<0 THEN
      jsonfd:=OpenNONBLOCK(jpipename);
      IF jsonfd<0 THEN jsonfd:=OpenWrite(jpipename) ELSE Seekend(jsonfd, 0) END;  (* no file and no pipe *)
    END;
    IF jsonfd>=0 THEN WrBin(jsonfd, s, Length(s)) ELSE WrStrLn("cannot write json-file") END;
  END;

  IF judpport<>0 THEN ret:=udpsend(udpsock, s, Length(s), judpport, jipnum) END;

END sendjson;

PROCEDURE appmhz(VAR s:ARRAY OF CHAR; jmhz:REAL);
VAR h:ARRAY[0..30] OF CHAR;
BEGIN
  IF jmhz<>0.0 THEN
    Append(s, " rx:");FixToStr(jmhz+0.0005,4,h); Append(s, h);
    Append(s, "MHz");
  END;
END appmhz;

<* IF WITHAPRS THEN *>

PROCEDURE sendaxudp2(mon:ARRAY OF CHAR; dlen:CARDINAL;
                     snrr, rfdb:REAL; txd, afc, qual:INTEGER; longcall, israw:BOOLEAN);
VAR b, data:ARRAY[0..500] OF CHAR;
    ret, datalen, snr, lev:INTEGER;
    p, i, ff:CARDINAL;
    q:REAL;
    udp:pUDPDESTS;

  PROCEDURE app(c:CHAR; v:INTEGER);
  VAR I:CARDINAL;
      s:ARRAY[0..50] OF CHAR;
  BEGIN
    b[p]:=CHR(ORD(c)<<0); INC(p);
    IntToStr(v, 0, s);
    i:=0; WHILE s[i]<>0C DO b[p]:=CHR(ORD(s[i])<<0); INC(p); INC(i) END;
    b[p]:=" "; INC(p);
  END app;


BEGIN
  snr:=VAL(INTEGER, snrr+0.5);
  IF snr>127 THEN snr:=127 ELSIF snr<-127 THEN snr:=-127 END;
  lev:=VAL(INTEGER, rfdb+0.5);
  IF lev>127 THEN lev:=127 ELSIF lev<-255 THEN lev:=-255 END;

  IF longcall THEN
    datalen:=Length(mon);
    i:=0;
    REPEAT data[i]:=mon[i]; INC(i); UNTIL (i>HIGH(data)) OR (VAL(INTEGER, i)>=datalen);
  ELSIF israw THEN
    i:=0;
    datalen:=dlen;
    WHILE (i<dlen) & (i<HIGH(data)) DO data[i]:=mon[i]; INC(i) END;
  ELSE mon2raw(mon, data, datalen) END;
  IF datalen>2 THEN
    udp:=udpdests;
    WHILE udp<>NIL DO

      p:=0;
      IF udp^.udp2 THEN
        IF NOT longcall THEN DEC(datalen, 2) END;             (* remove crc *)
        b[0]:=1C;
        b[1]:=CHR(30H);
        p:=2;
        app("T", txd);
        app("V", lev);
        app("S", snr);
        app("A", afc);
        app("Q", qual);
        IF longcall THEN app("X", 2) END;                     (* call are normal text *)
        b[p]:=0C; INC(p);                                     (* end of axudp2 header *) 
      END; 
      i:=0;
      REPEAT b[p]:=data[i]; INC(p); INC(i); UNTIL VAL(INTEGER, i)>=datalen;
      IF udp^.udp2 THEN 
        AppCRC(b, p);
        INC(p, 2);
      END;
      ret:=udpsend(udpsock, b, p, udp^.toport, udp^.ipnum);
      udp:=udp^.next;
    END;
  ELSIF verb THEN WrStrLn("beacon encode error, check callsign and ssid 0..15") END;
END sendaxudp2;

CONST KNOTS=1.851984;
      FEET=1.0/0.3048;
      WKNOTS=1.609;                            (* wx knots *)

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 (TRUNC((a-LFLOAT(TRUNC(a)))*600000.0) MOD 100*20+11) DIV 22
END dao91;


PROCEDURE encodeaprs(id-:ARRAY OF CHAR; td:CARDINAL; mycall-, comment-, sym-, destcall-:ARRAY OF CHAR; lat-, long-:LONGREAL;
                     txd, afc, qual:INTEGER; snrr, rfdb:REAL; speed, course, alt, clb, gust,
                     temp, hum, baro:REAL; verbo:BOOLEAN);
VAR b,h:ARRAY[0..500] OF CHAR;
    i,n:CARDINAL;
    a:LONGREAL;
    v:REAL;
    sig:BOOLEAN;
BEGIN
  b:="";
  Append(b, mycall);
  Append(b, ">"); Append(b, destcall);
  Append(b, ":;");
  Append(b, id);
  Append(b, "*");
  DateToStr(td, h);
  h[0]:=h[11]; h[1]:=h[12]; h[2]:=h[14]; h[3]:=h[15]; h[4]:=h[17]; h[5]:=h[18];
  h[6]:=0C;
  Append(b, h);
  Append(b, "h");

  i:=Length(b);
  a:=ABS(lat);
  n:=realcard(a);
  b[i]:=num(n DIV 10); INC(i);
  b[i]:=num(n); INC(i);
  n:=realcard((a-LFLOAT(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:=realcard(a);
  b[i]:=num(n DIV 100); INC(i);
  b[i]:=num(n DIV 10); INC(i);
  b[i]:=num(n); INC(i);
  n:=realcard((a-LFLOAT(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 long>=0.0 THEN b[i]:="E" ELSE b[i]:="W" END; INC(i);
  b[i]:=sym[1]; INC(i);

  IF (speed>0.0) OR (gust<1000.0) THEN
    n:=realcard(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);
    IF (sym[0]="/") & (sym[1]="_") THEN n:=realcard(speed*(1.0/WKNOTS)+0.5);
    ELSE n:=realcard(speed*(1.0/KNOTS)+0.5) END;
    b[i]:=num(n DIV 100); INC(i);
    b[i]:=num(n DIV 10); INC(i);
    b[i]:=num(n); INC(i);
    IF gust<1000.0 THEN
      n:=realcard(gust*(1.0/WKNOTS)+0.5);
      b[i]:="g"; 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;
  END;
  IF ABS(temp)<1000.0 THEN
    v:=temp*1.8+32.0;
    sig:=v<0.0;
    n:=realcard(ABS(v)+0.5);
    b[i]:="t"; INC(i);
    IF sig THEN b[i]:="-" ELSE  b[i]:=num(n DIV 100) END; INC(i);
    b[i]:=num(n DIV 10); INC(i);
    b[i]:=num(n); INC(i);
  END;
  IF hum<=100.0 THEN
    b[i]:="h"; INC(i);
    n:=realcard(hum+0.5);
    IF n=100 THEN n:=0 END;
    b[i]:=num(n DIV 10); INC(i);
    b[i]:=num(n); INC(i);
  END;
  IF baro<10000.0 THEN
    b[i]:="b"; INC(i);
    n:=realcard(baro*10+0.5);
    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 alt>0.5 THEN
    b[i]:="/"; INC(i);
    b[i]:="A"; INC(i);
    b[i]:="="; INC(i);
    n:=realcard(ABS(alt*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;

  b[i]:="!"; INC(i);                              (* DAO *)
  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);
  b[i]:=0C; 

  IF ABS(clb)<1000.0 THEN
    Append(b, "Clb=");
    FixToStr(clb, 2, h); Append(b, h);
    Append(b, "m/s ");
  END; 

  Append(b, comment);
  IF verbo THEN WrStr("TX:"); WrStrLn(b); WrStrLn(""); END;
  sendaxudp2(b, Length(b), snrr, rfdb, txd, afc, qual, FALSE, FALSE);
END encodeaprs;


<* END *>

PROCEDURE lp(in:REAL; VAR c:LPCONTEXT24);     (* lowpass 24db/oct 6dB loss *)
BEGIN
  WITH c DO
    uc1:=uc1 + (in-uc1)*LPR - il;
    uc2:=uc2*OLPR + il;
    il:=il + (uc1-uc2)*LPL;
  END;  (* result is uc2 *)
END lp;

PROCEDURE crc16(f-:ARRAY OF CHAR; len:CARDINAL):CARD16;
VAR i:CARDINAL;
    c,x:SET16;
BEGIN

  c:=CAST(SET16, 0FFFFH);
  FOR i:=0 TO len-1 DO
    x:=CAST(SET16, ORD(f[i]))/SHIFT(c, -8);
    x:=x/SHIFT(x,-4);
    c:=SHIFT(c, 8)/SHIFT(x, 12)/SHIFT(x, 5)/x;
  END;
  RETURN CAST(CARD16, c)
END crc16;

PROCEDURE wavw(u:REAL; soundfd:INTEGER; VAR afbuf:ARRAY OF INT16; VAR afbufw:CARDINAL);
BEGIN
  afbuf[afbufw]:=VAL(INT16, u*(30000.0/PI*0.5));
  INC(afbufw);
  IF afbufw>HIGH(afbuf) THEN WrBin(soundfd, afbuf, SIZE(afbuf)); afbufw:=0 END;
END wavw;

PROCEDURE fmoutc(u-:Complex; soundfd:INTEGER; VAR oldaf:REAL; VAR afbuf:ARRAY OF INT16;
                VAR afbufw:CARDINAL);
BEGIN
  wavw(fmhighpass(atan2(u), oldaf), soundfd, afbuf, afbufw);
  INC(afbufw);
  IF afbufw>HIGH(afbuf) THEN WrBin(soundfd, afbuf, SIZE(afbuf)); afbufw:=0 END;
END fmoutc;


PROCEDURE usbout(u-:Complex; soundfd:INTEGER; VAR usbosc:CARD16; VAR usbgain:REAL;
                 VAR afbufw:CARDINAL; VAR afbuf:ARRAY OF INT16);
VAR af:REAL;
BEGIN
--ssb demodulator
  af:=u.Re*DDSS[usbosc MOD DDSSLEN]-u.Im*DDSS[(usbosc+DDSSLEN DIV 4) MOD DDSSLEN];
--agc
  af:=af*usbgain;
  IF ABS(af)>10000.0 THEN usbgain:=usbgain*0.95 ELSE
    usbgain:=usbgain*1.0002;
    IF usbgain<0.00001 THEN usbgain:=0.00001 END;
  END;
--peak limiter
  IF af>30000.0 THEN af:=30000.0 ELSIF af<-30000.0 THEN af:=-30000.0 END;
  afbuf[afbufw]:=VAL(INTEGER, af);
--bfo
  INC(usbosc, bfofreq);
--audio out
  INC(afbufw);
  IF afbufw>HIGH(afbuf) THEN WrBin(soundfd, afbuf, SIZE(afbuf)); afbufw:=0 END;
END usbout;


----------------- (a)fsk modem

PROCEDURE AIS(f:ARRAY OF CHAR; len:CARDINAL; port:CHAR; afc:INTEGER; rfdb, jmhz:REAL);


  PROCEDURE aischar(c:CARDINAL):CHAR;
  BEGIN IF c<32 THEN RETURN CHR(c+64) ELSE RETURN CHR(c) END; END aischar;

  PROCEDURE clean(VAR s:ARRAY OF CHAR);
  VAR i:CARDINAL;
  BEGIN
    FOR i:=0 TO HIGH(s) DO IF s[i]="@" THEN s[i]:=0C END; END;  (* @ is end of string *)
    i:=HIGH(s);                                                 (* trailing blanks *)
    LOOP
      IF s[i]=" " THEN s[i]:=0C ELSIF s[i]<>0C THEN EXIT END;
      IF i=0 THEN EXIT END;
      DEC(i);
    END;
  END clean;  

  PROCEDURE wrdimens(n:CARDINAL; VAR s:ARRAY OF CHAR);
  VAR h:ARRAY[0..30] OF CHAR;
  BEGIN
    CardToStr(n DIV 1000H MOD 512 + n DIV 200000H MOD 512,1, s); Append(s, "x");
    CardToStr(n DIV 40H MOD 64 + n MOD 64,1,h); Append(s, h);  Append(s, "m");
  END wrdimens;


CONST FIX="undefined  GPS        GLONASS    GPS+GLONASSLORAN-C    CHAYKA     Integrated survayed   Galileo    intern GNSS";
      TXRX="TxB, RxA/RxBTxA, RxA/RxBTxB, RxA/RxB            ";

VAR i, ih, mn, uid, sog, fix, course, navstat, viac, bitc, dac, fi, textnum:CARDINAL;
    ii:INTEGER;
    newship:BOOLEAN;
    long, lat:REAL;
    b:ARRAY[0..919] OF BOOLEAN;
    ls, ns, mmsitext, h, utc, cc:ARRAY[0..200] OF CHAR;
    symb:ARRAY[0..1] OF CHAR;
    comm:ARRAY[0..250] OF CHAR;
    ps, ps1:pSHIP;

  PROCEDURE bits(x,y:CARDINAL):CARDINAL;
  VAR n:CARDINAL;
  BEGIN
    n:=0;
    WHILE x<=y DO
      INC(n, n+ORD(b[x]));
      INC(x);
    END;
    RETURN n
  END bits;

  PROCEDURE latlong(bp:CARDINAL; VAR lat, long:REAL);
  VAR ii:CARDINAL;
  BEGIN
    ii:=bits(bp,bp+27); 
    IF ii>=8000000H THEN INC(ii,0F0000000H) END;
    long:=VAL(REAL,CAST(INTEGER,ii))*0.00000166666666666666;
    ii:=bits(bp+28,bp+54);
    IF ii>=4000000H THEN INC(ii,0F8000000H) END;
    lat:=VAL(REAL,CAST(INTEGER,ii))*0.00000166666666666666;
  END latlong;


  PROCEDURE getcountrycodes;
  VAR fp:INTEGER;
      c:CHAR;
      n:CARDINAL;
      num:BOOLEAN;
  BEGIN
    IF ccfilename[0]=0C THEN RETURN END;

    fp:=OpenRead(ccfilename); 
    IF fp>=0 THEN
      ALLOCATE(countrycodes, SIZE(countrycodes^));
      IF countrycodes=NIL THEN RETURN END;

      FILL(countrycodes, 0C, SIZE(countrycodes^));
      n:=0;
      num:=TRUE;
      WHILE RdBin(fp, c, 1)=1 DO
        IF num THEN 
          IF (c>="0") & (c<="9") THEN n:=n*10 + ORD(c) - ORD("0") ELSE num:=FALSE END;
        ELSIF (n<=HIGH(countrycodes^)) & (c>=" ") THEN Append(countrycodes^[n], c);
        ELSE num:=TRUE; n:=0; END;
      END;             
    END;
  END getcountrycodes;


BEGIN
--FOR i:=0 TO 20 DO f[i]:=CHR(test[i]) END;
--len:=21;
  IF NOT ccdone & (countrycodes=NIL) THEN getcountrycodes END;
  ccdone:=TRUE;
  bitc:=0;
  REPEAT
    b[bitc]:=(7-bitc MOD 8) IN CAST(SET8, f[bitc DIV 8]);
    INC(bitc);
  UNTIL (bitc>HIGH(b)) OR (bitc>len*8);
  mn:=bits(0,5);
  viac:=bits(6,7);
  uid:=bits(8,37);
  mmsitext[9]:=0C;
  i:=uid;
  FOR ii:=8 TO 0 BY -1 DO mmsitext[ii]:=CHR(i MOD 10+ORD("0")); i:=i DIV 10 END;
  ps:=ships;
  WHILE (ps<>NIL) & (ps^.mmsi<>uid) DO ps:=ps^.next END;

  ns:="";
  utc:="";
  cc:="";
  IF countrycodes<>NIL THEN
    i:=1000000;
    IF uid<10000000 THEN i:=10000 END;
    Assign(cc, countrycodes^[uid DIV i MOD (HIGH(countrycodes^)+1)]);
  END;
  lat:=0.0;
  long:=0.0;
  sog:=0;
  course:=0;
  navstat:=0;
  newship:=FALSE;
  symb:="/s";
  IF (mn=5) OR (mn=24) THEN             (* ship data *)
    IF (len=53) OR (len=20) OR (len=21) THEN
      IF ps=NIL THEN                    (* new ship *)
        newship:=TRUE;
        ps1:=ships;                     (* check memory usage *) 
        IF (ps1<>NIL) & (ps1^.next<>NIL) THEN
          i:=2;
          WHILE ps1^.next^.next<>NIL DO INC(i); ps1:=ps1^.next END;
          IF i>MAXSHIPS THEN            (* recycle oldest entry *)
            ps:=ps1^.next;              (* end of chain *)
            ps1^.next:=NIL;
            IF verb THEN WrStrLn("remove oldest ship from database") END;
          ELSE ps:=NIL END;
        END; 
        IF ps=NIL THEN ALLOCATE(ps, SIZE(ps^)) END;
        IF ps<>NIL THEN
          FILL(ps, 0C, SIZE(ps^));
          ps^.next:=ships;
          ships:=ps;
        END;
      END;
      IF ps<>NIL THEN                   (* new or update *)
        WITH ps^ DO
          mmsi:=uid;
          IF (len=20) & (bits(38,39)=0) THEN                         (* msg 24 part 1 *)
            FOR i:=0 TO HIGH(name) DO name[i]:=aischar(bits(i*6+40,i*6+45)) END;
          ELSIF (len=21) & (bits(38,39)=1) THEN                      (* msg 24 part 1 *)
            FOR i:=0 TO HIGH(vendorid) DO vendorid[i]:=aischar(bits(i*6+48,i*6+53)) END;
            FOR i:=0 TO HIGH(call) DO call[i]:=aischar(bits(i*6+90,i*6+95)) END;
            dimens:=bits(132,161);
          ELSIF len=53 THEN                                                       (* msg 5 *)             
            FOR i:=0 TO HIGH(call) DO call[i]:=aischar(bits(i*6+70,i*6+75)) END;
            FOR i:=0 TO HIGH(name) DO name[i]:=aischar(bits(i*6+112,i*6+117)) END;
            FOR i:=0 TO HIGH(dest) DO dest[i]:=aischar(bits(i*6+302,i*6+307)) END;
            typ:=bits(232,239);
            dimens:=bits(240,269);
            draught:=FLOAT(bits(294,301))*0.1;
            i:=bits(274,293);
            eta[0]:=CHR(i DIV 65536 DIV 10+ORD("0"));
            eta[1]:=CHR(i DIV 65536 MOD 10+ORD("0"));
            eta[2]:=CHR(i DIV 2048 MOD 32 DIV 10+ORD("0"));
            eta[3]:=CHR(i DIV 2048 MOD 32 MOD 10+ORD("0"));
            eta[4]:=CHR(i DIV 64 MOD 32 DIV 10+ORD("0"));
            eta[5]:=CHR(i DIV 64 MOD 32 MOD 10+ORD("0"));
            eta[6]:=CHR(i MOD 64 DIV 10+ORD("0"));
            eta[7]:=CHR(i MOD 64 MOD 10+ORD("0"));
          END;
          clean(call);
          clean(name);
          clean(dest);
          clean(vendorid);
---shiplog
          IF (len=53) & newship & (aisfd>=0) THEN
            Assign(ls, name); Append(ls, ",");
            Append(ls, call); Append(ls, ",");
            Append(ls, vendorid); Append(ls, ",");
            Append(ls, mmsitext); Append(ls, ",");
            CardToStr(typ, 1, h); Append(ls, h);  Append(ls, ",");
            wrdimens(dimens,h); Append(ls,h); Append(ls, ","); 
            FixToStr(draught, 2, h); Append(ls, h); 
            Append(ls, "m"+LF);
            WrBin(aisfd, ls, Length(ls)); 
          END;
---shiplog
        END;
      END;
    END;    

  ELSIF (mn=1) OR (mn=2) OR (mn=3) THEN
    IF len=21 THEN 
      navstat:=bits(38,41);
--    rot:=bits(42,49);
      sog:=bits(50,59);
      course:=bits(116,127);
      latlong(61, lat, long);
      CASE navstat MOD 16 OF
        0:ns:="under way using engine";
       |1:ns:="at anchor";
       |2:ns:="not under command";
       |3:ns:="restricted maneuverability";
       |4:ns:="constrained by her draught";
       |5:ns:="moored";
       |6:ns:="aground";
       |7:ns:="engaged in fishing";
       |8:ns:="under way sailing";
       |9:ns:="reserved for future";
       |10:ns:="dangerous goods";
       |11:ns:="powerdriven vessel towing astern";
       |12:ns:="power-driven vessel pushing ahead";
       |13:ns:="reserved for future use";
       |14:ns:="AIS-SART, MOB-AIS, EPIRB-AIS";
       |15:ns:="under test";
      END;
    END;

  ELSIF mn=18 THEN              (* class b *)
    IF len=21 THEN 
      sog:=bits(46,55);
      latlong(57, lat, long);
      course:=bits(112,123);
    END;

  ELSIF (mn=4) OR (mn=11) THEN
    IF len=21 THEN
      IF mn=4 THEN symb:="/r" END; (* base station *)
      latlong(79, lat, long);
      CardToStr(bits(38,51),1,utc); Append(utc,"-");
      CardToStr(bits(52,55),1,h); Append(utc,h); Append(utc,"-");
      CardToStr(bits(56,60),1,h); Append(utc,h); Append(utc," ");
      CardToStr(bits(61,65),1,h); Append(utc,h); Append(utc,":");
      CardToStr(bits(66,71),1,h); Append(utc,h); Append(utc,":");
      CardToStr(bits(72,77),1,h); Append(utc,h);
    END;
  END;
  
  IF verb THEN
    WrStr("AIS");
    WrStr(port);
    WrStr(":len:"); WrCard(len,1);
    WrStr(" "); WrFixed(rfdb,1,1);
    WrStr("dB msg:"); WrCard(mn,1);
    WrStr(" MMSI:"); WrStr(mmsitext);
    IF cc[0]<>0C THEN WrStr("("); WrStr(cc); WrStr(")") END;
    WrStr(" rep:"); WrCard(viac,1);
    IF (mn=1) OR (mn=2) OR (mn=3) OR (mn=18) THEN
      WrStr(" lat:"); WrFixed(lat,6,1);
      WrStr(" long:"); WrFixed(long,6,1);
      WrStr(" dir:"); WrFixed(FLOAT(course)*0.1,1,1);
      WrStr(" knots:"); WrFixed(FLOAT(sog)*0.1,1,1);
      IF ns<>"" THEN WrStr(" stat:"); WrStr(ns) END; 

    ELSIF mn=6 THEN
      WrStr(" ToID:"); WrHexCap(bits(40,69),4,0);
      WrStr(" Text:"); 
      i:=100;
      REPEAT
        WrStr(CHR(aischar(bits(i,i+5)))); 
        INC(i,6);
      UNTIL (i>100+906) OR (i>bitc); 

    ELSIF (mn=4) OR (mn=11) THEN
      IF mn=4 THEN WrStr(" BaseStationUTC:") ELSIF mn=11 THEN WrStr(" MobilStationUTC:") END;
      WrStr(utc);
      WrStr(" lat:"); WrFixed(lat,6,1);
      WrStr(" long:"); WrFixed(long,6,1);

    ELSIF mn=5 THEN WrStr(" IMO:"); WrHexCap(bits(40,69),8,0);

    ELSIF mn=8 THEN
      dac:=bits(40,49);
      fi:=bits(50,55);
      WrStr(" dac:"); WrCard(dac,1);
      WrStr(" fi:"); WrCard(fi,1);
      IF bits(56,56)>0 THEN WrStr(" ack") END;
      textnum:=bits(57,67);
      WrStr(" textnum:"); WrCard(textnum,1);

--    IF (dac=1) & (fi=0) THEN (* text message *)
        WrStr(" text:");
        i:=68;
        REPEAT
          WrStr(CHR(aischar(bits(i,i+5))));
          INC(i,6);
        UNTIL (i>68+936) OR (i>bitc);
--    ELSE WrStr(" Binary") END;

    ELSIF mn=20 THEN                                    (* data link management *)
      i:=0;
      REPEAT
        ih:=i*30;
        WrStr(" Offset"); WrCard(i+1,1); WrStr(":"); WrCard(bits(40+ih,51+ih),1);
        WrStr(" Slots");  WrCard(i+1,1); WrStr(":"); WrCard(bits(52+ih,55+ih),1);
        WrStr(" Timeout");WrCard(i+1,1); WrStr(":"); WrCard(bits(56+ih,58+ih),1); 
        WrStr("min Incr");WrCard(i+1,1); WrStr(":"); WrCard(bits(59+ih,69+ih),1); 
        INC(i);
      UNTIL len*8<40+i*30;

    ELSIF mn=23 THEN
      IF len=20 THEN 
        latlong(40, lat, long);
        WrStr(" lat1:"); WrFixed(lat,6,1);
        WrStr(" long1:"); WrFixed(long,6,1);
        latlong(75, lat, long);
        WrStr(" lat2:"); WrFixed(lat,6,1);
        WrStr(" long2:"); WrFixed(long,6,1);
        WrStr(" Typ:"); WrCard(bits(110,113),1);
        WrStr(" Mode:");
        ih:=bits(144,145)*12;
        FOR i:=ih TO ih+11 DO WrStr(TXRX[i]) END; 
        WrStr(" Quiet:"); WrCard(bits(150,153),1);
      END;

    ELSIF mn=24 THEN
      WrStr(" Part:");WrInt(bits(38,39),1);
    END;
    IF ps<>NIL THEN
      WITH ps^ DO 
        WrStr(" Call:"); WrStr(call);
        WrStr(" Name:"); WrStr(name);
        WrStr(" Vendor:"); WrStr(vendorid);
        WrStr(" Type:"); WrCard(typ,1);
        WrStr(" Arrive:"); WrStr(eta);
        WrStr(" Draught:"); WrFixed(draught,1,1);
        WrStr(" Dim:"); wrdimens(dimens,h); WrStr(h);
        WrStr(" Dest:"); WrStr(dest);
      END;
    END;
    WrStrLn("");
  END; 

  IF (len=21) & ((mn>=1) & (mn<=4) OR (mn=18)) & (ABS(lat)<=90.0) & (ABS(long)<=180.0) THEN
    comm:="rep:";  CardToStr(viac,1,h); Append(comm,h);
    appmhz(comm, jmhz);
    Append(comm," "); FixToStr(rfdb,2,h); Append(comm, h); Append(comm,"dB msg:");  
    CardToStr(mn,1,h); Append(comm, h);
    IF cc<>"" THEN Append(comm, " ["); Append(comm, cc); Append(comm, "]"); END;
    IF utc<>"" THEN Append(comm, " "); Append(comm, utc) END;
    IF ps<>NIL THEN
      CardToStr(ps^.typ,1,h); Append(comm," Type:"); Append(comm, h);
      FixToStr(ps^.draught,2,h); Append(comm,", draught:"); Append(comm, h);
      Append(comm," Dim:"); wrdimens(ps^.dimens,h); Append(comm, h);
      Append(comm," ETA:"); Append(comm, ps^.eta);
      Append(comm," Call["); Append(comm,ps^.call);
      Append(comm,"] Name["); Append(comm,ps^.name);
      Append(comm,"] Dest["); Append(comm,ps^.dest); Append(comm,"]");
      IF ps^.vendorid[0]<>0C THEN
        Append(comm," Vendor["); Append(comm,ps^.vendorid); Append(comm,"]");
      END;
    END;
    IF ns<>"" THEN Append(comm," ["); Append(comm,ns); Append(comm,"]") END;
    encodeaprs(mmsitext, time() MOD 86400, mycall, comm, symb, "APLAIS", lat, long,
               0, VAL(INTEGER, afc), 0, 0.0, rfdb, FLOAT(sog)*(0.1*KNOTS), FLOAT(course)*0.1,
              -30000.0, 100000.0, 100000.0, 100000.0, 100000.0, 100000.0, FALSE);
  END;
(*name call mmsi typ*)
END AIS;

PROCEDURE ShowFrame(f:ARRAY OF CHAR; len:CARDINAL; port:CHAR; level, snrr:REAL; txd, afc, qual:INTEGER);

  PROCEDURE WCh(c:CHAR);
  BEGIN
    IF c<>15C THEN
      IF (c<" ") OR (c>=177C) THEN WrStr(".") ELSE WrStr(c) END;
    END;
  END WCh;


  PROCEDURE ShowCall(VAR f:ARRAY OF CHAR; pos:CARDINAL);
  VAR i,e:CARDINAL;
  BEGIN
    e:=pos;
    FOR i:=pos TO pos+5 DO
      IF f[i]<>100C THEN e:=i END;
    END;
    FOR i:=pos TO e DO WCh(CHR(ASH(ORD(f[i]), -1))) END;
    i:=ASH(ORD(f[pos+6]), -1) MOD 16;
    IF i<>0 THEN
      WrStr("-"); 
      IF i>=10 THEN WrStr(CHR(i DIV 10 + ORD("0"))) END;
      WrStr(CHR(i MOD 10 + ORD("0")));
    END;
  END ShowCall;


  PROCEDURE Showctl(com, cmd:CARDINAL);
  CONST UA = {0,1,5,6};
        DM = {0,1,2,3};
        SABM={0,1,2,3,5};
        DISC={0,1,6};
        FRMR={0,1,2,7};
        UI = {0,1};
        RR = {0};
        REJ= {0,3};
        RNR= {0,2};

  VAR cm:BITSET;
      PF:ARRAY[0..3] OF CHAR;

  BEGIN
    WrStr(" ctl ");
    cm:=CAST(BITSET, cmd) - {4};
    IF cm * {0,1,2,3} = RR THEN
      WrStr("RR");
      WrStr(CHR(48+ASH(cmd, -5)));
    ELSIF cm * {0,1,2,3} = RNR THEN
      WrStr("RNR");
      WrStr(CHR(48+ASH(cmd, -5)));
    ELSIF cm * {0,1,2,3} = REJ THEN
      WrStr("REJ");
      WrStr(CHR(48+ASH(cmd, -5)));
    ELSIF cm * {0} = {} THEN
      WrStr("I");
      WrStr(CHR(48+ASH(cmd, -5)));
      WrStr(CHR(48+ASH(cmd, -1) MOD 8));
    ELSIF cm = UI THEN WrStr("UI")
    ELSIF cm = DM THEN WrStr("DM");
    ELSIF cm = SABM THEN WrStr("SABM")
    ELSIF cm = DISC THEN WrStr("DISC")
    ELSIF cm = UA THEN WrStr("UA")
    ELSIF cm = FRMR THEN WrStr("FRMR")
    ELSE WrHexCap(cmd,2,0) END;
    PF:="v^-+";
    IF (com=0) OR (com=3) THEN WrStr("v1")
    ELSE WrStr(PF[com MOD 2 + 2*ORD(4 IN CAST(BITSET, cmd))]) END;
  END Showctl;


VAR i:CARDINAL;
    v, d:BOOLEAN;
    h:ARRAY[0..20] OF CHAR;
BEGIN
  WrStr(port);
  i:=0;
  WHILE NOT ODD(ORD(f[i])) DO
    INC(i);
    IF i>len THEN
      WrStrLn(" no ax.25 (no address end mark)");      
      RETURN           (* no address end mark found *)

    END;
  END;
  IF i MOD 7 <> 6 THEN
    WrStrLn(" no ax.25 (address field size not multiples of 7)");
    RETURN             (* address end not modulo 7 error *)

  END;
  WrStr(":fm ");
  ShowCall(f, 7);
  WrStr(" to ");
  ShowCall(f, 0);
  i:=14;
  v:=TRUE;
  WHILE (i+6<len) & NOT ODD(ORD(f[i-1])) DO
    IF v THEN WrStr(" via"); v:=FALSE END;
    WrStr(" ");
    ShowCall(f, i);
    IF (ORD(f[i+6])>=128) & (ODD(ORD(f[i+6])) OR (ORD(f[i+13])<128)) THEN WrStr("*") END;
    INC(i,7);
  END;
  Showctl(ORD(7 IN CAST(SET8, f[6])) + 2*ORD(7 IN CAST(SET8,f[13])), ORD(f[i]));
  INC(i);

  IF i<len THEN WrStr(" pid "); WrHexCap(ORD(f[i]),2,0) END;
  INC(i);
  IF level<>0.0 THEN WrStr(" lev:"); WrFixed(level,1,1); WrStr("dB") END; 
  IF snrr<>0.0 THEN WrStr(" snr:"); WrFixed(snrr,1,1); WrStr("dB") END; 
  IF txd<>0 THEN WrStr(" txd:"); WrInt(txd,1); WrStr("ms") END; 
  IF afc<>0 THEN WrStr(" afc:"); WrInt(afc,1); WrStr("Hz") END; 
  IF qual<>0 THEN WrStr(" eye:"); WrInt(qual,1); WrStr("%") END; 
  WrStrLn("");

--  IF NOT noinfo THEN
    d:=FALSE;
    WHILE i<len DO
      IF f[i]<>15C THEN WCh(f[i]); d:=TRUE;
      ELSIF d THEN WrStrLn(""); d:=FALSE END;
      INC(i);
    END;
    IF d THEN WrStrLn("") END;
--  END;
END ShowFrame;


PROCEDURE afskframe(VAR m:AFSKMODEM);
VAR i, dlen:CARDINAL;
    ch,cl:CHAR;
    level, snrr, rfdb:REAL;
    txd, afc, qual:INTEGER;
    crcok:BOOLEAN;
    ms:ARRAY[0..99] OF CHAR;
BEGIN
  IF (m.bitcnt>140) & (m.bitcnt MOD 8=6) THEN   (* min len and modulo 8 bits *)
    dlen:=(m.bitcnt-6) DIV 8;
    i:=0;
    WHILE (i<dlen) & NOT ODD(ORD(m.frame[i])) DO INC(i) END; 
    IF m.rawbits OR (i MOD 7=6) & (i<70) THEN     (* has correct ax.25 address field len *)
      cl:=m.frame[dlen-2];
      ch:=m.frame[dlen-1];
      AppCRC(m.frame, dlen-2);
      crcok:=(cl=m.frame[dlen-2]) & (ch=m.frame[dlen-1]);
      txd:=m.txd*1000 DIV m.baud;
      level:=dB(m.level/FLOAT(m.cnt)*(1.0/PI));
      snrr:=dB(m.level/(m.noise+0.00001));
      rfdb:=dB(m.rflevel)*0.5-90.3;                                 (* -dds gain *)
      afc:=VAL(INTEGER, (m.afc+m.fe)*FLOAT(m.ifsamprate)*(0.5/PI));
      qual:=VAL(INTEGER, 100.0*(1.0-m.qual/m.level*0.5));
      IF crcok THEN
        
        IF verb & NOT m.rawbits THEN ShowFrame(m.frame, dlen-2, CHR(m.modemnum+ORD("0")), level, snrr, txd, afc, qual) END;
        IF m.rawbits THEN AIS(m.frame, dlen-2, CHR(m.modemnum+ORD("0")), afc, rfdb, m.jmhz);
        ELSE sendaxudp2(m.frame, dlen, snrr, rfdb, txd, afc, qual, FALSE, TRUE) END;
      END;
      IF judpport<>0 THEN
        IF m.demod=MODF THEN ms:="fsk" ELSE ms:="afsk" END;
        sendjson(jipnum, judpport, m.frame, ms, dlen, 0, FLOAT(m.baud), 0, afc, crcok, 0.0, rfdb, m.jmhz);
      END;
    END;
  END;
END afskframe;


PROCEDURE databit(d:BOOLEAN; u1, u2:REAL; VAR m:AFSKMODEM);
VAR u:REAL; 
BEGIN
  IF (m.zerocnt<5) & (m.bitcnt DIV 8<=HIGH(m.frame)) THEN
    m.frame[m.bitcnt DIV 8]:=CHR(ORD(m.frame[m.bitcnt DIV 8]) DIV 2 + 128*ORD(d));
    INC(m.bitcnt);
  END;
  IF u1>u2 THEN u:=u1; u1:=u2; u2:=u END;
  u1:=sqrt(u1);
  u2:=sqrt(u2);
  m.level:=m.level+u2;
  m.noise:=m.noise+u1;
  IF m.lastu<>0.0 THEN m.qual:=m.qual+ABS(u2-m.lastu) END;
  m.lastu:=u2;
  INC(m.cnt);
  INC(m.txc);
  IF d THEN
    INC(m.zerocnt);
    IF m.zerocnt>=6 THEN                                      (* flag, frame ready *)
      afskframe(m);
      m.bitcnt:=0;
      m.afc:=0.0;
      m.level:=0.0;
      m.qual:=0.0;
      m.noise:=0.0;
      m.cnt:=0;
      m.lastu:=0.0;
      m.txd:=m.txc;
    END;
  ELSE
    IF (m.zerocnt>0) & (m.zerocnt<6) THEN m.txc:=0 END;       (* looks like no txd pattern *)
    m.zerocnt:=0;
  END;
END databit;


PROCEDURE subbit(u1, u2:REAL; VAR m:AFSKMODEM);
VAR d, b:BOOLEAN;
    c:CARDINAL;
BEGIN
  b:=u1>u2;
  c:=m.syncnt;
  m.syncnt:=(m.syncnt+2) MOD (AFSKOVERSAMPLE*2);
  IF m.syncnt<c THEN                                            (* data bit *)
    d:=b=m.oldd;                                                (* nrzi *)
    m.oldd:=b;
    databit(d, u1,u2, m);
  ELSIF b<>m.oldbit THEN                                        (* level change used for bit clock *)
    IF m.syncnt<>AFSKOVERSAMPLE THEN                            (* no clock adjust *) 
    m.syncnt:=m.syncnt-1+ORD(m.syncnt<AFSKOVERSAMPLE)*2;  (* up or down *)
    END;
  END;
  m.oldbit:=b; 
END subbit;

PROCEDURE fskbit(u:REAL; VAR m:AFSKMODEM);
VAR d, b:BOOLEAN;
BEGIN
  b:=u>0.0;
  INC(m.syncnt, m.baud);
  IF m.syncnt>=m.ifsamprate THEN                              (* data bit *)
    m.syncnt:=0;
--data clock
    IF m.oldraw<>b THEN
      m.oldraw:=b;
      IF b=m.synd THEN m.dir:=1 ELSE m.dir:=-1 END;
    END;
--descramble
    IF m.scrambled THEN 
      m.scrambler:=SHIFT(m.scrambler, 1);
      IF b THEN INCL(m.scrambler, 0) END; 
      b:=(0 IN m.scrambler) = ((12 IN m.scrambler) = (17 IN m.scrambler));  (* result is xor bit 0 12 17 *)
    END;
--nrzi
    d:=b=m.oldd;                                                (* nrzi *)
    m.oldd:=b;
    IF u>=0.0 THEN databit(d, u, 0.0, m) ELSE databit(d, 0.0, -u, m) END;
  ELSIF m.syncnt*2=m.ifsamprate THEN m.synd:=b END;
END fskbit;


PROCEDURE sampleafsk(ire, iim:INTEGER; VAR m:AFSKMODEM);
VAR c, dm:CARDINAL;
    si, co, af, lev, ss:REAL;
    isi, ico:INTEGER;
    s:Complex;
    f:ARRAY[0..1] OF REAL;
BEGIN
  isi:=DDS[m.ifosc MOD DDSLEN];
  ico:=DDS[(m.ifosc+DDSLEN DIV 4) MOD DDSLEN];
  INC(m.ifosc, m.iffreqafc);
  lp(FLOAT(iim*ico - ire*isi), m.iflpq);
  lp(FLOAT(ire*ico + iim*isi), m.iflpi);
  c:=m.ifsamp;
  dm:=m.ifstep;
  IF m.dir>0 THEN INC(dm, m.ifstep DIV 8)
  ELSIF m.dir<0 THEN DEC(dm, m.ifstep DIV 8) END;
  m.dir:=0;
  INC(m.ifsamp, dm);                      (* wrap around 32bit *)
  IF m.ifsamp<c THEN                      (* input samplerate down to if-samplerate *)

    s.Re:=m.iflpq.uc2;
    s.Im:=m.iflpi.uc2;
    af:=fmhighpass(atan2(s), m.oldaf);    (* baseband audio *)

--smeter
    lev:=0.0000001 + s.Re*s.Re + s.Im*s.Im;
    m.rflevel:=m.rflevel+(lev-m.rflevel)*0.02;

--soundout
    IF m.soundfd>=0 THEN
      IF m.ademod="F" THEN
        IF m.sqlev>0 THEN
          ss:=ABS(m.lastlev-lev)/(m.lastlev+lev);
          m.sq:=m.sq+(ss-m.sq)*0.01;
          m.lastlev:=lev;
        END;
        IF (m.sqlev=0) OR (m.sq<FLOAT(m.sqlev)*0.01) THEN
          wavw(af, m.soundfd, m.afbuf, m.afbufw);
        END;
      ELSIF m.ademod="S" THEN usbout(s, m.soundfd, m.usbosc, m.usbgain, m.afbufw, m.afbuf) END;
    END;

---afc
    m.afc:=m.afc+af*0.01;
    IF m.afc>m.afclimit THEN m.afc:=m.afclimit ELSIF m.afc<-m.afclimit THEN m.afc:=-m.afclimit;
    ELSIF m.afc>0.0 THEN m.afc:=m.afc-0.0002 ELSIF m.afc<0.0 THEN m.afc:=m.afc+0.0002 END;
    m.iffreqafc:=CAST(INT16, m.iffreq)-VAL(INT16, m.afc*m.afcmul);
    m.fe:=m.fe+(af-m.fe)*0.001;               (* only for monitoring *)

    IF m.demod=MODF THEN 
      lp(af, m.fsklp);
      IF m.fsklp.uc2>m.clamph THEN m.clamph:=m.fsklp.uc2 END;
      IF m.fsklp.uc2<m.clampl THEN m.clampl:=m.fsklp.uc2 END;
      m.clamph:=m.clamph*0.99;
      m.clampl:=m.clampl*0.99;
      fskbit(m.fsklp.uc2-(m.clamph+m.clampl)*0.5, m);

    ELSIF m.demod=MODA THEN
      FOR c:=0 TO 1 DO
        si:=DDSS[m.osc[c] MOD DDSSLEN];
        co:=DDSS[(m.osc[c]+DDSSLEN DIV 4) MOD DDSSLEN];
        INC(m.osc[c], m.freq[c]);
        WITH s DO
          lp(af*si, m.baselp[c*2]);
          lp(af*co, m.baselp[c*2+1]);
        END;
        f[c]:=sqr(m.baselp[c*2].uc2) + sqr(m.baselp[c*2+1].uc2);
      END;
      subbit(f[0],f[1], m);


    END;                                  (* fm demod only *) 
  END; 
END sampleafsk;


----------------- (a)fsk modem


PROCEDURE check(num:CARDINAL):BOOLEAN;   (* check if this payload num is active else send only with good snr *)
CONST MAXAGE=600;                        (* seconds payload active *)
VAR i, t, age:CARDINAL;
BEGIN
  t:=time();
  FOR i:=0 TO HIGH(checktable) DO
    IF num=checktable[i].payload THEN    (* playload is in table *)
      age:=t-checktable[i].time;
      checktable[i].time:=t;             (* heard now *)
      RETURN age<MAXAGE 

    END;
  END;
  FOR i:=HIGH(checktable) TO 1 BY -1 DO checktable[i]:=checktable[i-1] END; (* place for new entry *)
  checktable[0].time:=t;
  checktable[0].payload:=num;
  RETURN FALSE
END check;


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;

PROCEDURE sendframe(f-:FRAME; len:CARDINAL; snrl, rfdb, afc, jmhz:REAL; corbit:CARDINAL; baud:REAL;
                    ppm:INTEGER; crcok:BOOLEAN; fecinfo-:FECINFO);
CONST SATMOD=50;
VAR plnum, seq, td, alt, speed, sat, p:CARDINAL;
    ppmi,
    temp:INTEGER;
    lat, long:LONGREAL;
    snr,
    batt:REAL;
    s,h,name, nocall:ARRAY[0..200] OF CHAR;
BEGIN
  p:=0;
  IF len=FRAME32 THEN
    plnum:=ORD(f[0]) + ORD(f[1])*256;
    seq:=ORD(f[2]) + ORD(f[3])*256; 
    p:=4;
    batt:=FLOAT(ORD(f[p+16]))*(5.0/256.0);
  ELSIF len=FRAME22 THEN
    plnum:=ORD(f[0]);
    seq:=ORD(f[1]) + ORD(f[2])*256; 
    p:=3;
--    batt:=1.0 + FLOAT(ORD(f[p+16]))*(4.0/256.0);
    batt:=FLOAT(ORD(f[p+16]))*(5.0/256.0);
  END;
  IF p=0 THEN RETURN END;

  IF batt<1.8 THEN batt:=batt*2.0 END;                     (* encoding of the day ... *)
  td:=ORD(f[p])*3600 + ORD(f[p+1])*60 + ORD(f[p+2]);
  lat:=SaveReal(ORD(f[p+6])*1000000H + ORD(f[p+5])*10000H + ORD(f[p+4])*100H + ORD(f[p+3]));
  IF lat>90.0 THEN lat:=90.0 ELSIF lat<-90.0 THEN lat:=-90.0 END;
  long:=SaveReal(ORD(f[p+10])*1000000H + ORD(f[p+9])*10000H + ORD(f[p+8])*100H + ORD(f[p+7]));
  IF long>180.0 THEN long:=180.0 ELSIF long<-180.0 THEN long:=-180.0 END;
  alt:=ORD(f[p+11]) + ORD(f[p+12])*256;
  speed:=ORD(f[p+13]);
  sat:=ORD(f[p+14]);
  temp:=ORD(f[p+15]);
  IF temp>=128 THEN DEC(temp, 256) END;
  snr:=0.0;
  IF snrl>0 THEN snr:=dB(snrl)*0.5 END;
  ppmi:=ppm*VAL(INTEGER, 1000000 DIV (OVERSAMP*(len*16+1) DIV LOGNFSK));
  IF verb & (crcok OR (squelch4<snr)) THEN
    WrStr("["); WrStr(fecinfo); 
    WrStr("] len:"); WrInt(len,1);
    IF crcok THEN WrStr(" crc:ok") ELSE WrStr(" crc:err") END;
    WrStr(" "); TimeToStr(time() MOD 86400, s); WrStr(s);
    WrStr(" id:"); WrCard(plnum,1);
    WrStr(" seq:"); WrInt(seq, 1);
    WrStr(" td:");  TimeToStr(td MOD 86400, s); WrStr(s);
    WrStr(" lat:"); WrFixed(lat, 5,1);
    WrStr(" long:"); WrFixed(long, 5,1);
    WrStr(" alt:"); WrInt(alt, 1);
    WrStr(" speed:"); WrInt(speed, 1);
    WrStr(" sat:"); WrInt(sat MOD SATMOD, 1);
    WrStr(" gpspower:"); WrInt(sat DIV SATMOD, 1);
    WrStr(" batt:"); WrFixed(batt, 2,1);
    WrStr(" snr:"); WrFixed(snr, 1,1); WrStr("dB");
    WrStr(" rf:"); WrFixed(rfdb, 1,1); WrStr("dB");
    WrStr(" afc:"); WrFixed(afc, 1,1); WrStr("Hz");
    WrStr(" ppm:"); WrInt(ppmi, 1);
    WrStrLn("");
  END;

  IF crcok & ((snr>CHECKSNR) OR check(plnum)) & (ABS(lat)<90.0) & (ABS(long)<180.0) & ((lat<>0.0) OR (long<>0.0)) THEN
    s:="Seq:";
    CardToStr(seq,1,h); Append(s, h);
    Append(s, " Sat:");
    CardToStr(sat MOD SATMOD ,1,h); Append(s, h);
    IF sat DIV SATMOD=1 THEN Append(s, "(powersafe=off)");
    ELSIF sat DIV SATMOD=2 THEN Append(s, "(powersafe=tracking)");
    ELSIF sat DIV SATMOD=4 THEN Append(s, "(powersafe=opt)");
    END;
--    Append(s, " ");TimeToStr(td MOD 86400, h); Append(s, h); 
    Append(s, " Temp:");
    IntToStr(temp,1,h); Append(s, h);
    Append(s, "C Batt:");
    FixToStr(batt,3,h); Append(s, h);
    Append(s, "V");
    appmhz(s, jmhz);
    Append(s, " rf:"); FixToStr(rfdb,2,h); Append(s, h); Append(s,"dB");
    Append(s, " afc:"); IntToStr(VAL(INTEGER, afc),1,h); Append(s, h); Append(s, "Hz");
    IF snr>0.0 THEN
      Append(s, " snr:");FixToStr(snr,2,h); Append(s, h);
      Append(s, "dB");
    END;
    Append(s, " ppm:"); IntToStr(ppmi,1,h); Append(s, h);
    Append(s, " fec:"); CardToStr(corbit,1,h); Append(s, h);


    findcall(plnum  MOD 65536, name, nocall);
    IF name="" THEN                          (* call to payload num not found so build a name *)
      CardToStr(plnum MOD 65536,1,h);
      WHILE Length(h)<4 DO Append(h, " ") END;
      name:="HORU";
      IF Length(h)<=4 THEN Append(name, "S") END;
      Append(name,h);
      IF nocall<>"" THEN Append(s, " ["); Append(s, nocall); Append(s, "]") END;
    ELSE CardToStr(plnum MOD 65536,1,h); Append(s, " id:"); Append(s, h); END;
    name[9]:=0C;
    encodeaprs(name, td, mycall, s, "/O", "APLHOR", lat, long, 0, VAL(INTEGER, afc), 0, snr,
               rfdb, FLOAT(speed), -1.0, VAL(REAL, alt), 10000.0, 100000.0, 100000.0,
               100000.0, 100000.0, verb);
  END;
  IF judpport<>0 THEN
    sendjson(jipnum, judpport, f, "4fsk", len, corbit, baud, ppmi, VAL(INTEGER, afc), crcok, snr, rfdb, jmhz);
  END;
END sendframe;


PROCEDURE maxbits(lenbyte:CARDINAL):CARDINAL;
BEGIN RETURN (lenbyte + ((lenbyte*8+11) DIV 12*11+7) DIV 8)*8 END maxbits;


PROCEDURE fec(VAR f:ARRAY OF CHAR; len:CARDINAL; verb:BOOLEAN; VAR corcnt:CARDINAL; VAR fecinfo:ARRAY OF CHAR);
CONST X22=00400000H;       (* vector representation of X^{22} *)
      X11=00000800H;       (* vector representation of X^{11} *)
      MASK12=0fffff800H;   (* auxiliary vector for testing *)
      GENPOL=00000c75H;    (* generator polinomial, g(x) *)
VAR
    a:ARRAY[0..3] OF INTEGER;

PROCEDURE arr2int(a:ARRAY OF INTEGER; r:INTEGER):INTEGER;
(*
 * Convert a binary vector of Hamming weight r, and nonzero positions in
 * array a[1]...a[r], to a long integer \sum_{i=1}^r 2^{a[i]-1}.
 *)
VAR i:INTEGER;
    mul:CARDINAL;
    result:CARDINAL;
    temp:CARDINAL;  
BEGIN
  result:=0;
  FOR i:=1 TO r DO
    mul:=1;
    temp:=a[i]-1;
    WHILE temp>0 DO DEC(temp); INC(mul,mul) END;
    INC(result, mul);
  END;
  RETURN result;
END arr2int;

PROCEDURE nextcomb(n, r:INTEGER; VAR a:ARRAY OF INTEGER);
(*
 * Calculate next r-combination of an n-set.
 *)
VAR i, j:INTEGER;
BEGIN
  INC(a[r]);
  IF a[r]<=n THEN RETURN END;

  j:=r-1;
  WHILE a[j]=n-r+j DO DEC(j) END;
  FOR i:=r TO j BY -1 DO a[i]:=a[j]+i-j+1 END;
END nextcomb;

PROCEDURE getsyndrome(pattern:CARDINAL):CARDINAL;
(*
 * Compute the syndrome corresponding to the given pattern, i.e., the
 * remainder after dividing the pattern (when considering it as the vector
 * representation of a polynomial) by the generator polynomial, GENPOL.
 * In the program this pattern has several meanings: (1) pattern = infomation
 * bits, when constructing the encoding table; (2) pattern = error pattern,
 * when constructing the decoding table; and (3) pattern = received vector, to
 * obtain its 0syndrome in decoding.
 *)
VAR aux:CARDINAL; 
BEGIN
  aux:=X22;
  IF pattern>=X11 THEN
    WHILE CAST(SET32, pattern)*CAST(SET32, MASK12)<>SET32{} DO
      WHILE CAST(SET32, aux)*CAST(SET32, pattern)=SET32{} DO aux:=ASH(aux,-1) END;
      pattern:=CAST(CARDINAL,CAST(SET32,pattern)/CAST(SET32,aux DIV X11 * GENPOL));
    END;
  END;
  RETURN pattern
END getsyndrome;

VAR temp, i:CARDINAL;
    j, b, g, p, errmap, cnt:CARDINAL;

BEGIN
  IF decodingtable[0]=MAX(CARDINAL) THEN
    decodingtable[0]:=0;
    decodingtable[1]:=1;
    temp:=1;
    FOR i:=2 TO 23 DO
      INC(temp, temp);
      decodingtable[getsyndrome(temp)]:=temp;
    END;
    a[1]:=1;
    a[2]:=2;
    temp:=arr2int(a, 2);
    decodingtable[getsyndrome(temp)]:=temp;
    FOR i:=1 TO 252 DO
      nextcomb(23,2,a);
      temp:=arr2int(a,2);
      decodingtable[getsyndrome(temp)]:=temp;
    END;
    a[1]:=1;
    a[2]:=2;
    a[3]:=3;
    temp:=arr2int(a,3);
    decodingtable[getsyndrome(temp)]:=temp;
    FOR i:=1 TO 1770 DO
      nextcomb(23,3,a);
      temp:=arr2int(a,3);
      decodingtable[getsyndrome(temp)]:=temp;
    END;
  END;

  fecinfo[0]:=0C;

  corcnt:=0;
  i:=0;
  LOOP
    IF i>=(len*8+11) DIV 12 THEN EXIT END;

    p:=0;
    FOR j:=0 TO 10 DO
      b:=i*11+j;
      INC(p, p+ORD(((7-b MOD 8) IN CAST(SET8, f[len+b DIV 8]))));
    END;
    g:=0;
    FOR j:=0 TO 11 DO
      b:=i*12+j;
      IF b>=len*8 THEN EXIT END;    (* do not repair partial filled syndrom as sender encodes with junk in unfilled bits *)


      INC(g, g+ORD((7-b MOD 8) IN CAST(SET8, f[b DIV 8])));
    END;
    INC(g, ASH(p, 12));
    errmap:=decodingtable[getsyndrome(g)];
    IF errmap<>0 THEN
      cnt:=0;
      FOR j:=0 TO 22 DO INC(cnt, ORD(j IN CAST(SET32, errmap))) END;
      IF cnt<=3 THEN
        FOR j:=0 TO 11 DO
          IF 11-j IN CAST(SET32, errmap) THEN
            b:=i*12+j;
            f[b DIV 8]:=CAST(CHAR, CAST(SET8, f[b DIV 8])/SET8{7-b MOD 8});
            INC(corcnt);
          END;
        END;
        Append(fecinfo, CHR(cnt+ORD("0")));
      ELSE Append(fecinfo, "-") END; 
    ELSE Append(fecinfo, "+") END;
    INC(i);
  END;
END fec;


PROCEDURE scramble(VAR f:ARRAY OF CHAR; len:CARDINAL);
VAR i:CARDINAL;
    s,o:SET16;
BEGIN
  s:=CAST(SET16, 4A80H);
  FOR i:=0 TO maxbits(len)-1 DO
    o:=(s/SHIFT(s,-1))*SET16{0};
    s:=SHIFT(s,-1)+SHIFT(o,14);
    f[i DIV 8]:=CHR(CAST(CARD16, CAST(SET16, ORD(f[i DIV 8]))/SHIFT(o, VAL(INTEGER, i MOD 8))));
  END;
END scramble;

PROCEDURE deinterleave(VAR f:ARRAY OF CHAR; len:CARDINAL);
CONST P=ARRAY OF CARD16 {                                                           
    2,   3,   5,   7,   11,  13,  17,  19,  23,  29, 
    31,  37,  41,  43,  47,  53,  59,  61,  67,  71, 
    73,  79,  83,  89,  97,  101, 103, 107, 109, 113,
    127, 131, 137, 139, 149, 151, 157, 163, 167, 173,
    179, 181, 191, 193, 197, 199, 211, 223, 227, 229,
    233, 239, 241, 251, 257, 263, 269, 271, 277, 281,
    283, 293, 307, 311, 313, 317, 331, 337, 347, 349,
    379, 383, 389, 757, 761, 769, 773};                                                                              

VAR i,j,maxlen,bits,p:CARDINAL;
    o:ARRAY[0..255] OF SET8;
BEGIN
  maxlen:=maxbits(len) DIV 8;
  bits:=maxlen*8;
  i:=1;
  WHILE (i<=HIGH(P)) & (P[i]<bits) DO INC(i) END;
  p:=P[i-1]; 
  FOR i:=0 TO maxlen-1 DO o[i]:=SET8{} END;
  FOR i:=0 TO bits-1 DO
    j:=p*i MOD bits;
    IF ((j MOD 8) IN CAST(SET8, f[j DIV 8])) THEN INCL(o[i DIV 8], i MOD 8) END;
  END;
  FOR i:=0 TO maxlen-1 DO f[i]:=CAST(CHAR, o[i]) END;
END deinterleave;

PROCEDURE decodeframe(frame:FRAME; dlen, dm:CARDINAL; levm, noism, rfdb, afc:REAL;
                      ppm:INTEGER; dryrun:BOOLEAN; VAR m:FSK4MODEM):BOOLEAN;   (* 4fsk *)
VAR crcok:BOOLEAN;
    cor:CARDINAL;
    snr:REAL;
    fecinfo:FECINFO;
BEGIN
  IF dlen>2 THEN
    scramble(frame, dlen);
    deinterleave(frame, dlen);
    fec(frame, dlen, verb & NOT dryrun, cor, fecinfo);
    crcok:=ORD(frame[dlen-2]) + ORD(frame[dlen-1])*256 = crc16(frame, dlen-2);
    IF NOT dryrun THEN 
      snr:=0.0;
      IF noism>0.0 THEN snr:=levm/noism END;
      IF (crcok OR NOT m.bestframe.crcok) & ((crcok & NOT m.bestframe.crcok)
      OR (cor<m.bestframe.cor) OR (snr>m.bestframe.snr)) THEN
        m.bestframe.frame:=frame;
        m.bestframe.len:=dlen;
        m.bestframe.snr:=snr;
        m.bestframe.afc:=(FLOAT(dm)-FLOAT(m.demods DIV 2)+0.5)*(m.spaceing/FLOAT(m.subspaceing));
        m.bestframe.cor:=cor;
        m.bestframe.crcok:=crcok;
        m.bestframe.ppm:=ppm;
        m.bestframe.rfdb:=dB(rfdb)*0.5-90.3;
        m.bestframe.fecinfo:=fecinfo;
        m.bestframe.timer:=WAITBESTFRAME;
      END;
    END;
  END;
  RETURN crcok 
END decodeframe;


PROCEDURE nibble(dm, n:CARDINAL; lev, noise:REAL; VAR m:FSK4MODEM);
CONST SYNTOLERANCE=2;
VAR i,j:CARDINAL;
    p:INTEGER;
    max:REAL;
    ok:BOOLEAN;
    e:SET32;
BEGIN
  WITH m.demod[dm] DO
    IF lastn<>n THEN 
      p:=0;
      IF symclk>OVERSAMP DIV 2 THEN p:=-1 ELSIF symclk<OVERSAMP DIV 2 THEN p:=1 END;
      INC(symclk, p);
      INC(ppm,p);
      lastn:=n;
    END; 
    INC(symclk);
    IF symclk>=OVERSAMP THEN
      symclk:=0;
      synword:=ASH(synword, LOGNFSK) + n;  (* gray coded symbol would have been nice ... *) 
      IF framewp=0 THEN                    (* hunt mode *)
        e:=CAST(SET32, synword)/CAST(SET32, 01B1B2424H);
        IF e*SET32{0..15}=SET32{} THEN                  (* start word correct, error tolerant syn bits *) 
          j:=0;
          i:=16;
          REPEAT
            IF i IN e THEN INC(j) END; 
            INC(i);
          UNTIL (i>=32) OR (j>=SYNTOLERANCE);
        ELSE j:=SYNTOLERANCE+1 END;
        IF j<=SYNTOLERANCE THEN                                   (* start of frame *)
          framewp:=1;
          noism:=0.0;
          levm:=0.0;
          afc:=0.0;
          ppm:=0;
        END;
      ELSE                                                        (* in frame *) 
        frame[(framewp-1) DIV 8]:=CHR(synword MOD 256);
        INC(framewp, LOGNFSK);
        IF (framewp-1>=maxbits(FRAME22)) & decodeframe(frame, FRAME22, dm, lev, noism, lev, afc, ppm, TRUE, m) THEN
          ok:=decodeframe(frame, FRAME22, dm, levm, noism, lev, afc, ppm, FALSE, m);
          framewp:=0;
        ELSIF (framewp-1>=maxbits(FRAME32)) THEN
          ok:=decodeframe(frame, FRAME32, dm, levm, noism, lev, afc, ppm, FALSE, m); 
          framewp:=0;
        END;
        noism:=noism+noise;
        levm:=levm+lev;
      END;
    END;
  END;
END nibble;


PROCEDURE sample(ire, iim:INTEGER; VAR m:FSK4MODEM);
VAR c, cmax, dm, j:CARDINAL;
    max, med, si, co:REAL;
    isi, ico:INTEGER;
    s:Complex;
BEGIN
--  isi:=DDS[ifosc];
--  ico:=DDS[CAST(CARD16, ifosc+(HIGH(DDS)+1) DIV 4)];
  isi:=DDS[m.ifosc MOD DDSLEN];
  ico:=DDS[(m.ifosc+DDSLEN DIV 4) MOD DDSLEN];
  INC(m.ifosc, m.iffreq);
  lp(FLOAT(iim*ico - ire*isi), m.iflpq);
  lp(FLOAT(ire*ico + iim*isi), m.iflpi);
  c:=m.ifsamp;
  INC(m.ifsamp, m.ifstep);              (* wrap around 32bit *)
  IF m.ifsamp<c THEN                    (* input samplerate down to if-samplerate *)

    s.Re:=m.iflpq.uc2;
    s.Im:=m.iflpi.uc2;
    IF m.ademod="F" THEN fmoutc(s, m.soundfd, m.wavoldaf, m.afbuf, m.afbufw)
    ELSIF m.ademod="S" THEN usbout(s, m.soundfd, m.usbosc, m.usbgain, m.afbufw, m.afbuf) END;

    FOR c:=0 TO m.subbands-1 DO
      si:=DDSS[m.osc[c] MOD DDSSLEN];
      co:=DDSS[(m.osc[c]+DDSSLEN DIV 4) MOD DDSSLEN];
      INC(m.osc[c], m.freq[c]);
      WITH s DO
        lp(Im*si - Re*co, m.baselp[c*2]);
        lp(Re*si + Im*co, m.baselp[c*2+1]);
      END;
    END; 
    INC(m.baseoversamp);
    IF m.baseoversamp>=BASESTEP THEN  (* if-samplerate down to symbol oversamplerate *)
      m.baseoversamp:=0;
      FOR dm:=0 TO m.demods-1 DO      (* all demodulators in subspacing steps *)
        max:=-1.0;
        med:=0.000001;
        FOR c:=0 TO NFSK-1 DO                        (* 4 4fsk frequencys *)
          j:=(dm+c*m.subspaceing)*2;
          si:=sqr(m.baselp[j].uc2) + sqr(m.baselp[j+1].uc2);
          IF si>max THEN max:=si; cmax:=c; (* fmax:=f *)END;
          med:=med+si;
        END;
        med:=(med-max)*(1.0/FLOAT(NFSK-1));          (* for noisefloor sum other filters as max *)
        nibble(dm, cmax, max, med, m);
      END; 
    END;
    IF m.bestframe.timer>0 THEN                        (* we have a frame to send *) 
      DEC(m.bestframe.timer);
      IF m.bestframe.timer=0 THEN
        sendframe(m.bestframe.frame, m.bestframe.len, m.bestframe.snr, m.bestframe.rfdb, m.bestframe.afc, m.jmhz,
                    m.bestframe.cor, m.baud, m.bestframe.ppm, m.bestframe.crcok, m.bestframe.fecinfo);
        FILL(ADR(m.bestframe), 0C, SIZE(m.bestframe));
      END;
    END;
  END;  
END sample;

PROCEDURE realint(x:REAL; VAR g:REAL):INT16;  (* limit real input > +-1.0 to INT16*)
VAR r:REAL;
BEGIN
  r:=x*g;
  IF ABS(r)>=32767.0 THEN
    g:=32767.0*32767.0/r;
    r:=x*g;
  END;
  RETURN VAL(INT16, r)
END realint;

PROCEDURE inreform(VAR b:ARRAY OF INT16):CARDINAL;
VAR i, bs, rs, wp:CARDINAL;
    res:INTEGER;
    ib:RECORD CASE :CARDINAL OF
                0:c:ARRAY[0..MAXINBUF-1] OF Complex;
               |1:i:ARRAY[0..MAXINBUF*4-1] OF INT16;
               |2:b:ARRAY[0..MAXINBUF*8-1] OF CARD8;
              END;
       END;
    p:POINTER TO ARRAY[0..65535] OF BYTE;
    g:REAL;
BEGIN
  bs:=isize*(MAXINBUF*2);
  IF bs>(HIGH(b)+1)*2 THEN bs:=(HIGH(b)+1)*2 END;
  rs:=0;
  REPEAT
    p:=ADR(ib.b[rs]);
    res:=RdBin(iqfd, p^, bs-rs);
    IF res<=0 THEN RETURN 0 END;

    INC(rs, res);
  UNTIL rs>=bs;

  wp:=0;
  IF isize=1 THEN
    FOR i:=0 TO rs-1 DO b[i]:=VAL(INT16, ib.b[i])*256-32640 END;
    wp:=rs;
  ELSIF isize=2 THEN
--    FOR i:=0 TO rs DIV 2-1 DO b[i]:=ib.i[i] END;

    MOVE(ADR(ib), ADR(b), rs);
    wp:=rs DIV 2;
  ELSE
    g:=32767.0;
    FOR i:=0 TO rs DIV 8 - 1 DO
      b[wp]:=realint(ib.c[i].Re, g);
      INC(wp);
      b[wp]:=realint(ib.c[i].Im, g);
      INC(wp);
    END;
  END;
  RETURN wp
END inreform;


PROCEDURE ["C"] jsonpipebroken(signum:INTEGER);
BEGIN
  WrStr("got signal "); WrInt(signum,0); WrStrLn("!");
END jsonpipebroken;


VAR wp, i:CARDINAL;
    ok:BOOLEAN;
    m4:pFSK4MODEM;
    ma:pAFSKMODEM;
BEGIN
  mycall:="NOCALL";
  calls:=NIL;
  Parms;
  IF judpport>0 THEN signal(SIGPIPE, jsonpipebroken) END;
  decodingtable[0]:=MAX(CARDINAL);
  MakeDDSi(DDS);
  MakeDDS(DDSS);
  iqfd:=OpenRead(iqfn);
  IF iqfd<0 THEN Error("open iq file") END;
  LOOP
    wp:=inreform(iqbuf);
    IF wp=0 THEN EXIT END;  
    
    m4:=fsk4modems;
    WHILE m4<>NIL DO
      FOR i:=0 TO wp-2 BY 2 DO sample(iqbuf[i], iqbuf[i+1], m4^) END;
      m4:=m4^.next;
    END;
    ma:=afskmodems;
    WHILE ma<>NIL DO
      FOR i:=0 TO wp-2 BY 2 DO sampleafsk(iqbuf[i], iqbuf[i+1], ma^) END;
      ma:=ma^.next;
    END;
  END;

END fsk4rx.