<*+M2EXTENSIONS *> <*-CHECKDIV *> <*-CHECKRANGE *> <*-COVERFLOW *> <*-IOVERFLOW*> <*+NOPTRALIAS*> <*CPU="PENTIUMPRO"*> <*-DOREORDER *> <*-CHECKNIL *> <*-CHECKSET*> <*-PROCINLINE*> <*-COVERFLOW*> <*-IOVERFLOW*> <*-CHECKRANGE*> <*-CHECKSET*> <*-CHECKDIV*> <* IF __GEN_C__ THEN *> <*-GENCTYPES*> <*+COMMENT*> <*-GENHISTORY*> <*-GENDEBUG*> <*-GENDATE*> <*-LINENO*> <*-CHECKINDEX*> <*+GENCDIV*> <*-GENKRC*> <*+NOOPTIMIZE*> <*-GENSIZE*> <*-ASSERT*> <*-CHECKNIL*> <*-GENCONSTENUM*> <* ELSE *> <*-GENHISTORY*> <*-GENDEBUG*> <*-LINENO*> <*-CHECKINDEX*> <* END *> MODULE sdrtx; (* audio to iq modulator am, fm, usb, lsb, wfm-stereo by oe5dxl *) FROM SYSTEM IMPORT INT8, CARD8, INT16, CARD16, CAST, SHIFT, FILL, ADR; FROM osi IMPORT WrFixed, WrStrLn, WrInt, WrStr, usleep, Werr, Close, WrBin, RdBin, OpenWrite, OpenRead, NextArg, sin, cos, pi, OpenNONBLOCK, OpenRW, power, sqrt, ALLOCATE; FROM signal IMPORT signal, SIGTERM, SIGINT, SIGPIPE, sighandler_t; FROM aprsstr IMPORT StrToCard, StrToFix; FROM soundctl IMPORT samplesize, channels, sampelrate; CONST SAMPLES=1024*2; OSSSAMP=48000; LEVEL=32767.0/1.12; -- RADIOPREEM=0.88; RADIOFG=18000; RADIOFIRLEN=64; LF=12C; PI=3.1415926535; INTPOLS=64; REOPEN=1; EXITPRG=0; SENDNULL=2; TYPE LPCONTEXT24=RECORD uc1, uc2, il, LPR, OLPR, LPL:REAL; END; LPCONTEXT12=RECORD uc, il, K1, K2:REAL; END; MODS=(mFM, mUSB, mLSB, mAM, mSTEREO, mUPSAMP); STEREOCONTEXT=RECORD lastl, lastr, wpilot:REAL; END; SET32=SET OF [0..31]; VAR buf:ARRAY[0..SAMPLES*2-1] OF INT16; fd,adc,i,len, tmpi, bi,bq, si,sq, shift, of, vu:INTEGER; wshift, is, p, adcrate, oform, pilotu, wpilotu, loops, firsteps, fs, fh:CARDINAL; asamp, limlev, ohp, ohd, levmul, wsub, ssbwinc, pilot, clipplev, upsamplef, offset, bbi,bbq, sampmul, sampcnt, fmdeviation, wtone, devi, miclowpass, preemfilter, bassfilter, limlim, sample, outlev, floatlev, sinlev, subtonhz, subtonlev:REAL; limmul:LONGREAL; upsamplelpi, upsamplelpq:LPCONTEXT12; miclp, ssblpi, ssblpq, ssblpic, ssblpqc, leftlp, rightlp:LPCONTEXT24; exit, exitpipe:BOOLEAN; abuf, about:ARRAY[0..1023] OF INT16; ifn, ofn:ARRAY[0..1023] OF CHAR; pabuf, abuflen, pobuf:CARDINAL; mod:MODS; cstereo:STEREOCONTEXT; sintab:ARRAY[0..32767] OF INT16; radiofirtab:ARRAY[0..INTPOLS-1] OF ARRAY[0..RADIOFIRLEN-1] OF REAL; radiofirl, radiofirr:ARRAY[0..RADIOFIRLEN-1] OF REAL; PROCEDURE Error(text:ARRAY OF CHAR); BEGIN Werr(text); Werr(" error abort"+LF); HALT END Error; PROCEDURE Parms; VAR err:BOOLEAN; h:ARRAY[0..1023] OF CHAR; v:REAL; BEGIN err:=FALSE; LOOP NextArg(h); IF h[0]=0C THEN EXIT END; IF (h[0]="-") & (h[1]<>0C) & (h[2]=0C) THEN IF h[1]="m" THEN NextArg(h); IF h[0]="u" THEN mod:=mUSB ELSIF h[0]="l" THEN mod:=mLSB ELSIF h[0]="a" THEN mod:=mAM ELSIF h[0]="f" THEN mod:=mFM ELSIF h[0]="s" THEN mod:=mSTEREO ELSE Error("-m a|f|u|l|s") END; ELSIF h[1]="o" THEN NextArg(ofn); IF (ofn[0]=0C) OR (ofn[0]="-") THEN Error("-o ") END; ELSIF h[1]="O" THEN NextArg(h); IF NOT StrToFix(outlev, h) THEN Error("-O ") END; ELSIF h[1]="i" THEN NextArg(ifn); IF (ifn[0]=0C) OR (ifn[0]="-") THEN Error("-i ") END; ELSIF h[1]="s" THEN NextArg(h); IF NOT StrToFix(offset, h) THEN Error("-s ") END; ELSIF h[1]="d" THEN NextArg(h); IF NOT StrToFix(devi, h) THEN Error("-d ") END; ELSIF h[1]="g" THEN NextArg(h); IF NOT StrToFix(levmul, h) THEN Error("-g ") END; ELSIF h[1]="e" THEN exitpipe:=TRUE; ELSIF h[1]="c" THEN NextArg(h); IF NOT StrToFix(clipplev, h) THEN Error("-c ") END; ELSIF h[1]="u" THEN NextArg(h); IF NOT StrToFix(upsamplef, h) THEN Error("-u ") END; (* ELSIF h[1]="a" THEN NextArg(h); IF NOT StrToFix(limlim, h) OR (limlim<0.0) THEN Error("-u ") END; limlim:=1.0/(limlim+1.0); *) ELSIF h[1]="l" THEN NextArg(h); IF NOT StrToFix(miclowpass, h) THEN Error("-l ") END; ELSIF h[1]="p" THEN NextArg(h); IF NOT StrToFix(preemfilter, h) OR (preemfilter>1.0) THEN Error("-p ") END; -- IF preemfilter<>0.0 THEN preemfilter:=1.0/preemfilter END; ELSIF h[1]="b" THEN NextArg(h); IF NOT StrToFix(bassfilter, h) THEN Error("-b ") END; ELSIF h[1]="T" THEN NextArg(h); IF NOT StrToFix(subtonhz, h) THEN Error("-T ") END; NextArg(h); IF NOT StrToFix(subtonlev, h) THEN Error("-T ") END; ELSIF h[1]="f" THEN NextArg(h); IF (h[0]="i") & (h[1]="1") & (h[2]="6") THEN oform:=2; ELSIF (h[0]="f") & (h[1]="3") & (h[2]="2")THEN oform:=4; ELSIF (h[0]="u") & (h[1]="8") THEN oform:=1; ELSE Error("-f u8|i16|f32") END; ELSIF h[1]="r" THEN NextArg(h); IF NOT StrToFix(sampmul, h) OR (sampmul<2.0) THEN Error("-r ") END; ELSIF h[1]="h" THEN WrStrLn(" Modulate audio to IQ-File"); WrStrLn(" -b <0..1> filter bass of modulation (not stereo) (0.05)"); WrStrLn(" -c ssb rf-clipper level after ALC 1=off (1.0)"); WrStrLn(" -d fm deviation (3000) (stereo 40000)"); WrStrLn(" -e not exit on broken pipe"); WrStrLn(" -f

u8 i16 f32 (u8)"); WrStrLn(" -g input loudness (not stereo) more for more ALC (50.0)"); WrStrLn(" -h this"); WrStrLn(" -i input file/pipe/oss-device (stereo 2 channel) (/dev/dsp)"); WrStrLn(" all frequency parameters based on 48kHz input rate"); WrStrLn(" -l modulation lowpass (not stereo) 0=off (3000)"); WrStrLn(" -m u(sb) l(sb) a(m) f(m) s(stereo) (f)"); WrStrLn(" -O output level (1.0)"); WrStrLn(" -o output iq file/pipe"); WrStrLn(" -p <0..1> preemphase of modulation (not stereo) 0=off (0.8)"); WrStrLn(" -r output/input samplerate (21.33333)"); WrStrLn(" -s shift signal from iq band center (ssb:center of band!) (0)"); WrStrLn(" -T (sub)Tone eg. 100.0 0.15"); WrStrLn(" -u upsampler aliasing filter (fm deviation+modlowpass, ssb 1500, stereo 110000)"); WrStrLn(" all -values based on 48kHz input samplerate and stereo pilot tone"); WrStrLn(" filters 4th order IIR, stereo preemphase+17kHz lowpass 64 tap FIR"); WrStrLn(""); 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; END Parms; PROCEDURE OpenSound(adcrate:CARDINAL; fn-:ARRAY OF CHAR); VAR i:INTEGER; BEGIN adc:=OpenRead(fn); IF adc>=0 THEN i:=samplesize(adc, 16); (* 8, 16 *) i:=channels(adc, 1+ORD(mod=mSTEREO)); (* 1, 2 *) i:=sampelrate(adc, adcrate); (* 8000..48000 *) ELSE Error("sound device open") END END OpenSound; PROCEDURE reopensound; BEGIN Close(adc); OpenSound(OSSSAMP, ifn); END reopensound; PROCEDURE audiosamp():REAL; VAR i:INTEGER; BEGIN IF pabuf>=abuflen THEN i:=RdBin(adc, abuf, SIZE(abuf)); IF i<=0 THEN i:=0; IF exitpipe THEN reopensound ELSE exit:=TRUE END; END; abuflen:=i DIV 2; pabuf:=0; END; i:=abuf[pabuf]; INC(pabuf); RETURN VAL(REAL, i) END audiosamp; (* PROCEDURE audioout(o:REAL); VAR i:INTEGER; BEGIN IF pobuf>HIGH(about) THEN WrBin(adc, about, SIZE(about)); pobuf:=0; END; i:=VAL(INTEGER, o); IF i>32767 THEN i:=32767 ELSIF i<-32767 THEN i:=-32767 END; about[pobuf]:=i; INC(pobuf); END audioout; *) PROCEDURE mkfir(gain, interp:REAL; flen:CARDINAL; VAR fir:ARRAY OF REAL); VAR i, f, m:CARDINAL; u, w, g:REAL; BEGIN m:=flen DIV 2; FOR i:=0 TO flen-1 DO fir[i]:=0.0 END; FOR f:=1 TO TRUNC(FLOAT(RADIOFG*2)/FLOAT(OSSSAMP)*FLOAT(m))-1 DO g:=FLOAT(f)/FLOAT(m)+0.25; (* preemphase *) w:=FLOAT(f)*2.0*PI/FLOAT(flen); FOR i:=0 TO flen-1 DO fir[i]:=fir[i]+g*cos((FLOAT(i)-FLOAT(m)+interp)*w) END; END; u:=2.0/FLOAT(flen); --WrStrLn(""); FOR i:=0 TO flen-1 DO (* hamming *) fir[i]:=gain*fir[i]*(0.54+0.46*cos(PI*(FLOAT(i)*u-1.0))); --WrFixed(fir[i], 3,1);WrStr(" "); END; --WrStrLn(""); END mkfir; PROCEDURE dofir(u:REAL; VAR f:ARRAY OF REAL; tab-:ARRAY OF REAL; flen:CARDINAL):REAL; VAR i:CARDINAL; s:REAL; BEGIN s:=f[0]*tab[0]; f[flen-1]:=u; FOR i:=0 TO flen-2 DO f[i]:=f[i+1]; s:=s+f[i]*tab[i] END; RETURN s END dofir; PROCEDURE dofiri(VAR f:ARRAY OF REAL; tab-:ARRAY OF REAL; flen:CARDINAL):REAL; VAR i:CARDINAL; s:REAL; BEGIN s:=0.0; FOR i:=0 TO flen-2 DO s:=s+f[i]*tab[i] END; RETURN s END dofiri; PROCEDURE lp(in:REAL; VAR c:LPCONTEXT24):REAL; (* lowpass 24db/oct 6dB loss *) BEGIN WITH c DO uc1:=uc1 + (in-uc1)*LPR - il; uc2:=uc2*OLPR + il; il:=il + (uc1-uc2)*LPL; RETURN uc2 END; END lp; PROCEDURE audioproc(in:REAL):REAL; (* lowpass, limiter, clipper ... *) VAR o, ll:REAL; BEGIN o:=in*levmul; IF miclowpass<>0.0 THEN o:=lp(o, miclp) END; (* lowpass *) IF bassfilter<>0.0 THEN ohd:=ohd+(o-ohd)*bassfilter; (* remove bass *) o:=o-ohd; END; IF preemfilter<>0.0 THEN ll:=ohp; (* preemphase *) ohp:=o; -- o:=o*preemfilter-ll; o:=o-ll*preemfilter; END; o:=o*(1.0-limmul); ll:=ABS(o)-limlev; IF ll>0.0 THEN (* too loud *) limmul:=limmul+(1.0-limmul)*ll*0.00002; (* 0.00002 *) IF limmul>1.0 THEN limmul:=1.0 END; ELSE limmul:=limmul*0.999995 END; IF subtonlev<>0.0 THEN o:=o+subtonlev*sin(wtone); wtone:=wtone+subtonhz; IF wtone>2.0*pi THEN wtone:=wtone-2.0*pi END; END; IF o>FLOAT(LEVEL) THEN o:=FLOAT(LEVEL) ELSIF o<-FLOAT(LEVEL) THEN o:=-FLOAT(LEVEL) END; RETURN o END audioproc; PROCEDURE ssbtx(u:REAL; VAR i, q:REAL); CONST L=LEVEL*2; VAR v:REAL; BEGIN u:=u*8; (* lp's have 6db loss, mixer 50% for each sideband *) i:=lp(u*sin(wsub), ssblpi); q:=lp(u*cos(wsub), ssblpq); v:=i*i+q*q; IF v>L*L THEN (* rf clipper *) v:=L/sqrt(v); i:=i*v; q:=q*v; END; i:=lp(i, ssblpic); q:=lp(q, ssblpqc); wsub:=wsub+ssbwinc; IF wsub>2.0*pi THEN wsub:=wsub-2.0*pi END; END ssbtx; PROCEDURE encstereo(l,r:REAL; VAR stereocontext:STEREOCONTEXT):REAL; VAR s:REAL; BEGIN WITH stereocontext DO wpilotu:=wpilotu+pilotu; s:=(1.0/32768.0)*VAL(REAL, sintab[CAST(CARDINAL,SHIFT(CAST(SET32,wpilotu),-17))]); RETURN (r-l)*s*s + l + s*(0.1*32768.0); END; END encstereo; 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*power(fg/samp,2.0)); OLPR:=1.0-LPR; END; END makelp24; PROCEDURE makelp12(fg, samp:REAL; VAR c:LPCONTEXT12); BEGIN WITH c DO K1:=power(fg/samp*5.2,2.0)-power(fg/samp*5.2,3.0)*0.5; IF K1<=0.0 THEN Error("modulation bandwith > samplerate") END; K2:=1.0-power(K1*1.0,0.48); (* 0.85 10% ripple, 1.0 11% overshoot *) END; END makelp12; PROCEDURE upsample(u:REAL; VAR c:LPCONTEXT12); BEGIN WITH c DO uc:=uc + il; il:=il*K2 + (u-uc)*K1; END; END upsample; PROCEDURE SendSamps(VAR buf:ARRAY OF INT16; VAR p:CARDINAL); VAR i:CARDINAL; b:ARRAY[0..SAMPLES*2-1] OF CARD8; f:ARRAY[0..SAMPLES*2-1] OF REAL; BEGIN IF oform=2 THEN WrBin(of, buf, p*2); ELSIF oform=1 THEN FOR i:=0 TO p-1 DO b[i]:=ASH(buf[i],-8)+128 END; WrBin(of, b, p); ELSE FOR i:=0 TO p-1 DO f[i]:=(VAL(REAL,buf[i])+0.5)*floatlev END; WrBin(of, f, p*SIZE(REAL)); END; p:=0; END SendSamps; PROCEDURE sat(VAR u:INTEGER); BEGIN IF u>32767 THEN u:=32767 ELSIF u<-32767 THEN u:=-32767 END END sat; PROCEDURE ["C"] exitprog(signum:INTEGER); BEGIN WrStr("got signum "); WrInt(signum,0); WrStrLn("!"); IF exitpipe THEN reopensound ELSE exit:=TRUE END; END exitprog; BEGIN (* signal(SIGTERM, exitprog); signal(SIGINT, exitprog); *) of:=-1; adcrate:=OSSSAMP; sampmul:=21.33333333333333; mod:=mFM; ifn:="/dev/dsp"; ofn:=""; wshift:=0; offset:=0.0; devi:=0.0; levmul:=50.0; miclowpass:=3000.0; bassfilter:=0.05; preemfilter:=0.8; clipplev:=1.0; upsamplef:=0.0; limlim:=0.0; oform:=1; outlev:=1.0; subtonlev:=0.0; subtonhz:=0.0; wtone:=0.0; exitpipe:=FALSE; Parms; IF exitpipe THEN signal(SIGPIPE, exitprog) END; subtonhz:=subtonhz*(2.0*pi/FLOAT(OSSSAMP)); subtonlev:=subtonlev*FLOAT(LEVEL); floatlev:=outlev/32768.0; -- ALLOCATE(buf, SIZE(buf^)); -- IF buf=NIL THEN Werr("out of memory") END; IF devi=0.0 THEN IF mod=mSTEREO THEN devi:=40000.0 ELSE devi:=3000.0 END; END; IF upsamplef=0.0 THEN IF mod=mSTEREO THEN upsamplef:=110000.0; ELSIF (mod=mUSB) OR (mod=mLSB) THEN upsamplef:=1600.0 ELSIF mod=mAM THEN upsamplef:=4500.0 ELSE upsamplef:=devi+miclowpass END; END; sample:=FLOAT(adcrate)*sampmul; IF ofn[0]=0C THEN Werr("output file?"); END; of:=OpenWrite(ofn); IF of<0 THEN Werr("file write") END; OpenSound(OSSSAMP, ifn); makelp12(upsamplef, sample, upsamplelpi); upsamplelpq:=upsamplelpi; IF miclowpass<>0.0 THEN makelp24(miclowpass, FLOAT(adcrate), miclp) END; makelp24(1200.0, FLOAT(adcrate), ssblpi); ssblpq:=ssblpi; makelp24(1200.0, FLOAT(adcrate), ssblpic); ssblpqc:=ssblpi; IF mod=mSTEREO THEN FOR i:=0 TO INTPOLS-1 DO mkfir(0.1, (FLOAT(i)+0.5)/INTPOLS, RADIOFIRLEN, radiofirtab[INTPOLS-1-i]); END; END; sinlev:=32766.0; IF (outlev<=1.0) & (oform<>4) THEN sinlev:=sinlev*outlev END; FOR i:=0 TO HIGH(sintab) DO sintab[i]:=VAL(INT16, sinlev*sin(FLOAT(i)*(pi*2.0/FLOAT(HIGH(sintab)+1)))) END; ssbwinc:=1500.0*2.0*pi/FLOAT(adcrate); fmdeviation:=devi*FLOAT(MAX(CARDINAL))/sample/FLOAT(LEVEL); pilot:=(19000.0*2.0*pi)/sample; pilotu:=TRUNC(LFLOAT(19000.0*65536.0)*65536.0/LFLOAT(sample)); limlev:=LEVEL*0.9-subtonlev; IF limlev<=0 THEN Werr("subtone level too high"+LF) END; shift:=VAL(INTEGER,-offset*FLOAT(MAX(CARDINAL))/sample); pabuf:=MAX(INTEGER); p:=0; sampcnt:=0.0; firsteps:=TRUNC(sampmul) DIV 2; (* make fir interpolation steps *) --WrStrLn(""); REPEAT sampcnt:=sampcnt+sampmul; loops:=TRUNC(sampcnt); IF mod32767 THEN si:=32767 END; buf[p]:=ASH(si*sintab[CAST(CARDINAL,SHIFT(CAST(SET32,wshift), -17))],-15); INC(p); buf[p]:=ASH(si*sintab[CAST(CARDINAL,SHIFT(CAST(SET32,wshift+ASH(HIGH(sintab)+1, 15)),-17))],-15); INC(p); INC(wshift, shift); ELSIF mod=mSTEREO THEN -- IF is+is=TRUNC(sampmul) THEN (* double audio samplerate *) -- bbi:=dofiri(radiofirl, radiofirtab[INTPOLS DIV 2], RADIOFIRLEN); -- bbq:=dofiri(radiofirr, radiofirtab[INTPOLS DIV 2], RADIOFIRLEN); -- END; IF fs>=firsteps THEN fh:=is*INTPOLS DIV loops; bbi:=dofiri(radiofirl, radiofirtab[fh], RADIOFIRLEN); bbq:=dofiri(radiofirr, radiofirtab[fh], RADIOFIRLEN); fs:=0; END; INC(fs); upsample(bbi, upsamplelpi); upsample(bbq, upsamplelpq); buf[p]:=sintab[CAST(CARDINAL,SHIFT(CAST(SET32,wshift), -17))]; INC(p); buf[p]:=sintab[CAST(CARDINAL,SHIFT(CAST(SET32,wshift+ASH(HIGH(sintab)+1, 15)),-17))]; INC(p); INC(wshift, shift+VAL(INTEGER, fmdeviation*encstereo(upsamplelpi.uc, upsamplelpq.uc, cstereo))); ELSE (* iq baseband upsample *) upsample(bbi, upsamplelpi); upsample(bbq, upsamplelpq); si:=sintab[CAST(CARDINAL,SHIFT(CAST(SET32,wshift), -17))]; sq:=sintab[CAST(CARDINAL,SHIFT(CAST(SET32,wshift+ASH(HIGH(sintab)+1, 15)),-17))]; bi:=VAL(INTEGER, upsamplelpi.uc); bq:=VAL(INTEGER, upsamplelpq.uc); tmpi:=ASH(bi*si - bq*sq,-15); --IF ABS(tmpi)>vu THEN vu:=ABS(tmpi) END; IF ABS(tmpi)>32767 THEN sat(tmpi) END; buf[p]:=tmpi; INC(p); tmpi:=ASH(bi*sq + bq*si,-15); --IF ABS(tmpi)>vu THEN vu:=ABS(tmpi) END; IF ABS(tmpi)>32767 THEN sat(tmpi) END; buf[p]:=tmpi; INC(p); INC(wshift, shift); END; IF p>HIGH(buf) THEN SendSamps(buf, p) END; END; sampcnt:=sampcnt-FLOAT(loops); UNTIL exit; IF p>0 THEN SendSamps(buf, p) END; Close(of); --WrInt(vu, 1); WrStrLn("vu"); END sdrtx. (* repair broken pipes *) (* PROCEDURE fmtx(u:REAL; VAR i, q:REAL); BEGIN i:=LEVEL*sin(wsub); q:=LEVEL*cos(wsub); wsub:=wsub + u*fmdeviation; IF wsub>2.0*pi THEN wsub:=wsub-2.0*pi ELSIF wsub<0.0 THEN wsub:=wsub+2.0*pi END; END fmtx; *) (* PROCEDURE preem(u:REAL; VAR last:REAL):REAL; VAR o:REAL; BEGIN o:=last; last:=u; o:=u-o*RADIOPREEM; IF o>32767.0 THEN o:=32767.0 ELSIF o<-32767.0 THEN o:=-32767.0 END; RETURN o END preem; *) (* PROCEDURE encstereo(l,r:REAL; VAR stereocontext:STEREOCONTEXT):REAL; VAR s:REAL; BEGIN WITH stereocontext DO wpilot:=wpilot+pilot; IF wpilot>2.0*pi THEN wpilot:=wpilot-2.0*pi END; -- RETURN (r+l) + (r-l)*sin(wpilot*2.0) + sin(wpilot)*(0.4*32768.0); s:=sin(wpilot); -- RETURN (r+l) + (r-l)*(s*s*2.0-1.0) + s*(0.4*32768.0); RETURN (r-l)*s*s + l + s*(0.1*32768.0); END; END encstereo; *) (* PROCEDURE mkfir(gain, void:REAL; flen:CARDINAL; VAR fir:ARRAY OF REAL); VAR i, f, m:CARDINAL; u, w, g:REAL; BEGIN m:=flen DIV 2; FOR i:=0 TO flen-1 DO fir[i]:=0.0 END; FOR f:=1 TO TRUNC(FLOAT(RADIOFG*2)/FLOAT(OSSSAMP)*FLOAT(m))-1 DO g:=FLOAT(f)/FLOAT(m)+0.25; (* preemphase *) w:=FLOAT(f)*2.0*PI/FLOAT(flen); FOR i:=0 TO flen DIV 2 DO fir[i+m]:=fir[i+m]+g*cos(FLOAT(i)*w) END; END; FOR i:=1 TO flen DIV 2 DO fir[m-i]:=fir[m+i] END; u:=2.0/FLOAT(flen); FOR i:=0 TO flen-1 DO (* hamming *) fir[i]:=gain*fir[i]*(0.54+0.46*cos(PI*(FLOAT(i)*u-1.0))); END; END mkfir; *)