diff --git a/CMakeLists.txt b/CMakeLists.txt index 96cdc3d05..92d0e68b6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -461,6 +461,7 @@ set (wsjt_FSRCS lib/jtmsg.f90 lib/libration.f90 lib/lorentzian.f90 + lib/fst4/lorentzian_fading.f90 lib/lpf1.f90 lib/mixlpf.f90 lib/makepings.f90 @@ -568,6 +569,7 @@ set (wsjt_FSRCS lib/fst4/ldpcsim240_74.f90 lib/fst4/osd240_101.f90 lib/fst4/osd240_74.f90 + lib/fst4/fastosd240_74.f90 lib/fst4/get_crc24.f90 lib/fst4/fst4_baseline.f90 ) diff --git a/Network/MessageClient.cpp b/Network/MessageClient.cpp index 45d47f9b6..4374e8dc1 100644 --- a/Network/MessageClient.cpp +++ b/Network/MessageClient.cpp @@ -569,7 +569,8 @@ void MessageClient::status_update (Frequency f, QString const& mode, QString con , bool watchdog_timeout, QString const& sub_mode , bool fast_mode, quint8 special_op_mode , quint32 frequency_tolerance, quint32 tr_period - , QString const& configuration_name) + , QString const& configuration_name + , QString const& tx_message) { if (m_->server_port_ && !m_->server_.isNull ()) { @@ -578,8 +579,9 @@ void MessageClient::status_update (Frequency f, QString const& mode, QString con out << f << mode.toUtf8 () << dx_call.toUtf8 () << report.toUtf8 () << tx_mode.toUtf8 () << tx_enabled << transmitting << decoding << rx_df << tx_df << de_call.toUtf8 () << de_grid.toUtf8 () << dx_grid.toUtf8 () << watchdog_timeout << sub_mode.toUtf8 () - << fast_mode << special_op_mode << frequency_tolerance << tr_period << configuration_name.toUtf8 (); - TRACE_UDP ("frequency:" << f << "mode:" << mode << "DX:" << dx_call << "report:" << report << "Tx mode:" << tx_mode << "tx_enabled:" << tx_enabled << "Tx:" << transmitting << "decoding:" << decoding << "Rx df:" << rx_df << "Tx df:" << tx_df << "DE:" << de_call << "DE grid:" << de_grid << "DX grid:" << dx_grid << "w/d t/o:" << watchdog_timeout << "sub_mode:" << sub_mode << "fast mode:" << fast_mode << "spec op mode:" << special_op_mode << "frequency tolerance:" << frequency_tolerance << "T/R period:" << tr_period << "configuration name:" << configuration_name); + << fast_mode << special_op_mode << frequency_tolerance << tr_period << configuration_name.toUtf8 () + << tx_message.toUtf8 (); + TRACE_UDP ("frequency:" << f << "mode:" << mode << "DX:" << dx_call << "report:" << report << "Tx mode:" << tx_mode << "tx_enabled:" << tx_enabled << "Tx:" << transmitting << "decoding:" << decoding << "Rx df:" << rx_df << "Tx df:" << tx_df << "DE:" << de_call << "DE grid:" << de_grid << "DX grid:" << dx_grid << "w/d t/o:" << watchdog_timeout << "sub_mode:" << sub_mode << "fast mode:" << fast_mode << "spec op mode:" << special_op_mode << "frequency tolerance:" << frequency_tolerance << "T/R period:" << tr_period << "configuration name:" << configuration_name << "Tx message:" << tx_message); m_->send_message (out, message); } } diff --git a/Network/MessageClient.hpp b/Network/MessageClient.hpp index cc348be2d..3f21a598a 100644 --- a/Network/MessageClient.hpp +++ b/Network/MessageClient.hpp @@ -63,7 +63,8 @@ public: , quint32 rx_df, quint32 tx_df, QString const& de_call, QString const& de_grid , QString const& dx_grid, bool watchdog_timeout, QString const& sub_mode , bool fast_mode, quint8 special_op_mode, quint32 frequency_tolerance - , quint32 tr_period, QString const& configuration_name); + , quint32 tr_period, QString const& configuration_name + , QString const& tx_message); Q_SLOT void decode (bool is_new, QTime time, qint32 snr, float delta_time, quint32 delta_frequency , QString const& mode, QString const& message, bool low_confidence , bool off_air); diff --git a/Network/NetworkMessage.hpp b/Network/NetworkMessage.hpp index f892eda06..61aaf7038 100644 --- a/Network/NetworkMessage.hpp +++ b/Network/NetworkMessage.hpp @@ -160,6 +160,7 @@ * Frequency Tolerance quint32 * T/R Period quint32 * Configuration Name utf8 + * Tx Message utf8 * * WSJT-X sends this status message when various internal state * changes to allow the server to track the relevant state of each @@ -183,7 +184,8 @@ * when the Tx watchdog is set or reset, * when the frequency tolerance is changed, * when the T/R period is changed, - * when the configuration name changes. + * when the configuration name changes, + * when the message being transmitted changes. * * The Special operation mode is an enumeration that indicates the * setting selected in the WSJT-X "Settings->Advanced->Special diff --git a/UDPExamples/ClientWidget.cpp b/UDPExamples/ClientWidget.cpp index 75930b7e5..b82836f04 100644 --- a/UDPExamples/ClientWidget.cpp +++ b/UDPExamples/ClientWidget.cpp @@ -147,6 +147,7 @@ ClientWidget::ClientWidget (QAbstractItemModel * decodes_model, QAbstractItemMod , mode_line_edit_ {new QLineEdit {this}} , frequency_tolerance_spin_box_ {new QSpinBox {this}} , tx_mode_label_ {new QLabel {this}} + , tx_message_label_ {new QLabel {this}} , submode_line_edit_ {new QLineEdit {this}} , fast_mode_check_box_ {new QCheckBox {this}} , tr_period_spin_box_ {new QSpinBox {this}} @@ -302,6 +303,7 @@ ClientWidget::ClientWidget (QAbstractItemModel * decodes_model, QAbstractItemMod // set up status area status_bar_->addPermanentWidget (de_label_); status_bar_->addPermanentWidget (tx_mode_label_); + status_bar_->addPermanentWidget (tx_message_label_); status_bar_->addPermanentWidget (frequency_label_); status_bar_->addPermanentWidget (tx_df_label_); status_bar_->addPermanentWidget (report_label_); @@ -400,7 +402,7 @@ void ClientWidget::update_status (ClientKey const& key, Frequency f, QString con , QString const& de_call, QString const& de_grid, QString const& dx_grid , bool watchdog_timeout, QString const& submode, bool fast_mode , quint8 special_op_mode, quint32 frequency_tolerance, quint32 tr_period - , QString const& configuration_name) + , QString const& configuration_name, QString const& tx_message) { if (key == key_) { @@ -427,8 +429,8 @@ void ClientWidget::update_status (ClientKey const& key, Frequency f, QString con update_spin_box (frequency_tolerance_spin_box_, frequency_tolerance , quint32_max == frequency_tolerance ? QString {"n/a"} : QString {}); update_line_edit (submode_line_edit_, submode, false); - tx_mode_label_->setText (QString {"Tx Mode: %1"} - .arg (tx_mode.isEmpty () || tx_mode == mode ? "" : '(' + tx_mode + ')')); + tx_mode_label_->setText (tx_mode.isEmpty () || tx_mode == mode ? "" : "Tx Mode: (" + tx_mode + ')'); + tx_message_label_->setText (tx_message.isEmpty () ? "" : "Tx Msg: " + tx_message.trimmed ()); frequency_label_->setText ("QRG: " + Radio::pretty_frequency_MHz_string (f)); update_line_edit (dx_call_line_edit_, dx_call); update_line_edit (dx_grid_line_edit_, dx_grid); diff --git a/UDPExamples/ClientWidget.hpp b/UDPExamples/ClientWidget.hpp index ee91d084a..fb0ef47f4 100644 --- a/UDPExamples/ClientWidget.hpp +++ b/UDPExamples/ClientWidget.hpp @@ -52,7 +52,7 @@ public: , QString const& de_call, QString const& de_grid, QString const& dx_grid , bool watchdog_timeout, QString const& sub_mode, bool fast_mode , quint8 special_op_mode, quint32 frequency_tolerance, quint32 tr_period - , QString const& configuration_name); + , QString const& configuration_name, QString const& tx_message); Q_SLOT void decode_added (bool is_new, ClientKey const& key, QTime, qint32 snr , float delta_time, quint32 delta_frequency, QString const& mode , QString const& message, bool low_confidence, bool off_air); @@ -122,6 +122,7 @@ private: QLineEdit * mode_line_edit_; QSpinBox * frequency_tolerance_spin_box_; QLabel * tx_mode_label_; + QLabel * tx_message_label_; QLineEdit * submode_line_edit_; QCheckBox * fast_mode_check_box_; QSpinBox * tr_period_spin_box_; diff --git a/UDPExamples/MessageServer.cpp b/UDPExamples/MessageServer.cpp index 8aadd08a6..74090395b 100644 --- a/UDPExamples/MessageServer.cpp +++ b/UDPExamples/MessageServer.cpp @@ -243,9 +243,11 @@ void MessageServer::impl::parse_message (QHostAddress const& sender, port_type s quint32 frequency_tolerance {quint32_max}; quint32 tr_period {quint32_max}; QByteArray configuration_name; + QByteArray tx_message; in >> f >> mode >> dx_call >> report >> tx_mode >> tx_enabled >> transmitting >> decoding >> rx_df >> tx_df >> de_call >> de_grid >> dx_grid >> watchdog_timeout >> sub_mode - >> fast_mode >> special_op_mode >> frequency_tolerance >> tr_period >> configuration_name; + >> fast_mode >> special_op_mode >> frequency_tolerance >> tr_period >> configuration_name + >> tx_message; if (check_status (in) != Fail) { Q_EMIT self_->status_update (client_key, f, QString::fromUtf8 (mode) @@ -256,7 +258,8 @@ void MessageServer::impl::parse_message (QHostAddress const& sender, port_type s , QString::fromUtf8 (dx_grid), watchdog_timeout , QString::fromUtf8 (sub_mode), fast_mode , special_op_mode, frequency_tolerance, tr_period - , QString::fromUtf8 (configuration_name)); + , QString::fromUtf8 (configuration_name) + , QString::fromUtf8 (tx_message)); } } break; diff --git a/UDPExamples/MessageServer.hpp b/UDPExamples/MessageServer.hpp index 7cf5653a0..c18cc95fd 100644 --- a/UDPExamples/MessageServer.hpp +++ b/UDPExamples/MessageServer.hpp @@ -97,7 +97,7 @@ public: , QString const& de_call, QString const& de_grid, QString const& dx_grid , bool watchdog_timeout, QString const& sub_mode, bool fast_mode , quint8 special_op_mode, quint32 frequency_tolerance, quint32 tr_period - , QString const& configuration_name); + , QString const& configuration_name, QString const& tx_message); Q_SIGNAL void client_closed (ClientKey const&); Q_SIGNAL void decode (bool is_new, ClientKey const&, QTime time, qint32 snr, float delta_time , quint32 delta_frequency, QString const& mode, QString const& message diff --git a/UDPExamples/UDPDaemon.cpp b/UDPExamples/UDPDaemon.cpp index 2d028f074..1d3a7abef 100644 --- a/UDPExamples/UDPDaemon.cpp +++ b/UDPExamples/UDPDaemon.cpp @@ -59,7 +59,7 @@ public: , QString const& /*de_call*/, QString const& /*de_grid*/, QString const& /*dx_grid*/ , bool /* watchdog_timeout */, QString const& sub_mode, bool /*fast_mode*/ , quint8 /*special_op_mode*/, quint32 /*frequency_tolerance*/, quint32 /*tr_period*/ - , QString const& /*configuration_name*/) + , QString const& /*configuration_name*/, QString const& /*tx_message*/) { if (key == key_) { diff --git a/lib/fst4/decode240_74.f90 b/lib/fst4/decode240_74.f90 index be18f6e09..f5aac2e10 100644 --- a/lib/fst4/decode240_74.f90 +++ b/lib/fst4/decode240_74.f90 @@ -25,6 +25,8 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder include "ldpc_240_74_parity.f90" maxiterations=30 + if(Keff.eq.50) maxiterations=1 + nosd=0 if(maxosd.gt.3) maxosd=3 if(maxosd.eq.0) then ! osd with channel llrs @@ -36,6 +38,8 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder nosd=0 endif + if(maxosd.eq.0) goto 73 + toc=0 tov=0 tanhtoc=0 @@ -133,9 +137,11 @@ subroutine decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw,ntype,nharder enddo ! bp iterations +73 continue do i=1,nosd zn=zsave(:,i) - call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) +! call osd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) + call fastosd240_74(zn,Keff,apmask,norder,message74,cw,nharderror,dminosd) if(nharderror.gt.0) then hdec=0 where(llr .ge. 0) hdec=1 diff --git a/lib/fst4/fastosd240_74.f90 b/lib/fst4/fastosd240_74.f90 new file mode 100644 index 000000000..f4bb61d60 --- /dev/null +++ b/lib/fst4/fastosd240_74.f90 @@ -0,0 +1,291 @@ +subroutine fastosd240_74(llr,k,apmask,ndeep,message74,cw,nhardmin,dmin) +! +! An ordered-statistics decoder for the (240,74) code. +! Message payload is 50 bits. Any or all of a 24-bit CRC can be +! used for detecting incorrect codewords. The remaining CRC bits are +! cascaded with the LDPC code for the purpose of improving the +! distance spectrum of the code. +! +! If p1 (0.le.p1.le.24) is the number of CRC24 bits that are +! to be used for bad codeword detection, then the argument k should +! be set to 77+p1. +! +! Valid values for k are in the range [50,74]. +! + character*24 c24 + integer, parameter:: N=240 + integer*1 apmask(N),apmaskr(N) + integer*1, allocatable, save :: gen(:,:) + integer*1, allocatable :: genmrb(:,:),g2(:,:) + integer*1, allocatable :: temp(:),temprow(:),m0(:),me(:),mi(:) + integer indices(N),indices2(N),nxor(N) + integer*1 cw(N),ce(N),c0(N),hdec(N) + integer*1, allocatable :: decoded(:) + integer*1 message74(74) + integer*1, allocatable :: sp(:) + integer indx(N),ksave + real llr(N),rx(N),absrx(N) + + logical first + data first/.true./,ksave/64/ + save first,ksave + + allocate( genmrb(k,N), g2(N,k) ) + allocate( temp(k), temprow(n), m0(k), me(k), mi(k) ) + allocate( decoded(k) ) + + if( first .or. k.ne.ksave) then ! fill the generator matrix +! +! Create generator matrix for partial CRC cascaded with LDPC code. +! +! Let p2=74-k and p1+p2=24. +! +! The last p2 bits of the CRC24 are cascaded with the LDPC code. +! +! The first p1=k-50 CRC24 bits will be used for error detection. +! + if( allocated(gen) ) deallocate(gen) + allocate( gen(k,N) ) + gen=0 + do i=1,k + message74=0 + message74(i)=1 + if(i.le.50) then + call get_crc24(message74,74,ncrc24) + write(c24,'(b24.24)') ncrc24 + read(c24,'(24i1)') message74(51:74) + message74(51:k)=0 + endif + call encode240_74(message74,cw) + gen(i,:)=cw + enddo + + first=.false. + ksave=k + endif + +! Use best k elements from the sorted list for the first basis. For the 2nd basis replace +! the nswap lowest quality symbols with the best nswap elements from the parity symbols. + nswap=20 + + do ibasis=1,2 + rx=llr + apmaskr=apmask + +! Hard decisions on the received word. + hdec=0 + where(rx .ge. 0) hdec=1 + +! Use magnitude of received symbols as a measure of reliability. + absrx=abs(llr) + call indexx(absrx,N,indx) + +! Re-order the columns of the generator matrix in order of decreasing reliability. + do i=1,N + genmrb(1:k,i)=gen(1:k,indx(N+1-i)) + indices(i)=indx(N+1-i) + enddo + + if(ibasis.eq.2) then + do i=k-nswap+1,k + temp(1:k)=genmrb(1:k,i) + genmrb(1:k,i)=genmrb(1:k,i+nswap) + genmrb(1:k,i+nswap)=temp(1:k) + itmp=indices(i) + indices(i)=indices(i+nswap) + indices(i+nswap)=itmp + enddo + endif + +! Do gaussian elimination to create a generator matrix with the most reliable +! received bits in positions 1:k in order of decreasing reliability (more or less). + + icol=1 + indices2=0 + nskipped=0 + do id=1,k + iflag=0 + do while(iflag.eq.0) + if(genmrb(id,icol).ne.1) then + do j=id+1,k + if(genmrb(j,icol).eq.1) then + temprow=genmrb(id,:) + genmrb(id,:)=genmrb(j,:) + genmrb(j,:)=temprow + iflag=1 + endif + enddo + if(iflag.eq.0) then ! skip this column + nskipped=nskipped+1 + indices2(k+nskipped)=icol ! put icol where skipped columns go + icol=icol+1 ! look at the next column + endif + else + iflag=1 + endif + enddo + indices2(id)=icol + do j=1,k + if(id.ne.j .and. genmrb(j,icol).eq.1) then + genmrb(j,:)=ieor(genmrb(id,:),genmrb(j,:)) + endif + enddo + icol=icol+1 + enddo + do i=k+nskipped+1,240 + indices2(i)=i + enddo + genmrb(1:k,:)=genmrb(1:k,indices2) + indices=indices(indices2) + +!************************************ + g2=transpose(genmrb) + +! The hard decisions for the k MRB bits define the order 0 message, m0. +! Encode m0 using the modified generator matrix to find the "order 0" codeword. +! Flip various combinations of bits in m0 and re-encode to generate a list of +! codewords. Return the member of the list that has the smallest Euclidean +! distance to the received word. + + hdec=hdec(indices) ! hard decisions from received symbols + m0=hdec(1:k) ! zero'th order message + absrx=abs(llr) + absrx=absrx(indices) + rx=rx(indices) + apmaskr=apmaskr(indices) + + call mrbencode74(m0,c0,g2,N,k) + nxor=ieor(c0,hdec) + nhardmin=sum(nxor) + dmin=sum(nxor*absrx) + np=32 + if(ibasis.eq.1) allocate(sp(np)) + + cw=c0 + ntotal=0 + nrejected=0 + + if(ndeep.eq.0) goto 998 ! norder=0 + if(ndeep.gt.4) ndeep=4 + if( ndeep.eq. 1) then + nord=1 + xlambda=0.0 + nsyncmax=np + elseif(ndeep.eq.2) then + nord=2 + xlambda=0.0 + nsyncmax=np + elseif(ndeep.eq.3) then + nord=3 + xlambda=4.0 + nsyncmax=11 + elseif(ndeep.eq.4) then + nord=4 + xlambda=3.4 + nsyndmax=12 + endif + + s1=sum(absrx(1:k)) + s2=sum(absrx(k+1:N)) + rho=s1/(s1+xlambda*s2) + rhodmin=rho*dmin + nerr64=-1 + do iorder=1,nord +!beta=0.0 +!if(iorder.ge.3) beta=0.4 +!spnc_order=sum(absrx(k-iorder+1:k))+beta*(N-k) +!if(dmin.lt.spnc_order) cycle + mi(1:k-iorder)=0 + mi(k-iorder+1:k)=1 + iflag=k-iorder+1 + do while(iflag .ge.0) + ntotal=ntotal+1 + me=ieor(m0,mi) + d1=sum(mi(1:k)*absrx(1:k)) + if(d1.gt.rhodmin) exit + call partial_syndrome(me,sp,np,g2,N,K) + nwhsp=sum(ieor(sp(1:np),hdec(k:k+np-1))) + if(nwhsp.le.nsyndmax) then + call mrbencode74(me,ce,g2,N,k) + nxor=ieor(ce,hdec) + dd=sum(nxor*absrx(1:N)) + if( dd .lt. dmin ) then + dmin=dd + rhodmin=rho*dmin + cw=ce + nhardmin=sum(nxor) + nwhspmin=nwhsp + nerr64=sum(nxor(1:K)) + endif + endif +! Get the next test error pattern, iflag will go negative +! when the last pattern with weight iorder has been generated. + call nextpat74(mi,k,iorder,iflag) + enddo + enddo + +998 continue +! Re-order the codeword to [message bits][parity bits] format. + cw(indices)=cw + hdec(indices)=hdec + message74=cw(1:74) + call get_crc24(message74,74,nbadcrc) + if(nbadcrc.eq.0) exit + nhardmin=-nhardmin + enddo ! basis loop + return +end subroutine fastosd240_74 + +subroutine mrbencode74(me,codeword,g2,N,K) + integer*1 me(K),codeword(N),g2(N,K) +! fast encoding for low-weight test patterns + codeword=0 + do i=1,K + if( me(i) .eq. 1 ) then + codeword=ieor(codeword,g2(1:N,i)) + endif + enddo + return +end subroutine mrbencode74 + +subroutine partial_syndrome(me,sp,np,g2,N,K) + integer*1 me(K),sp(np),g2(N,K) +! compute partial syndrome + sp=0 + do i=1,K + if( me(i) .eq. 1 ) then + sp=ieor(sp,g2(K:K+np-1,i)) + endif + enddo + return +end subroutine partial_syndrome + +subroutine nextpat74(mi,k,iorder,iflag) + integer*1 mi(k),ms(k) +! generate the next test error pattern + ind=-1 + do i=1,k-1 + if( mi(i).eq.0 .and. mi(i+1).eq.1) ind=i + enddo + if( ind .lt. 0 ) then ! no more patterns of this order + iflag=ind + return + endif + ms=0 + ms(1:ind-1)=mi(1:ind-1) + ms(ind)=1 + ms(ind+1)=0 + if( ind+1 .lt. k ) then + nz=iorder-sum(ms) + ms(k-nz+1:k)=1 + endif + mi=ms + do i=1,k ! iflag will point to the lowest-index 1 in mi + if(mi(i).eq.1) then + iflag=i + exit + endif + enddo + return +end subroutine nextpat74 + diff --git a/lib/fst4/fst4sim.f90 b/lib/fst4/fst4sim.f90 index 5b8f33bc3..83ac5baed 100644 --- a/lib/fst4/fst4sim.f90 +++ b/lib/fst4/fst4sim.f90 @@ -19,10 +19,10 @@ program fst4sim ! Get command-line argument(s) nargs=iargc() - if(nargs.ne.10) then - print*,'Need 10 arguments, got ',nargs - print*,'Usage: fst4sim "message" TRsec f0 DT h fdop del nfiles snr W' - print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 1 0.1 1.0 10 -15 F' + if(nargs.ne.9) then + print*,'Need 9 arguments, got ',nargs + print*,'Usage: fst4sim "message" TRsec f0 DT fdop del nfiles snr W' + print*,'Examples: fst4sim "K1JT K9AN EN50" 60 1500 0.0 0.1 1.0 10 -15 F' print*,'W (T or F) argument is hint to encoder to use WSPR message when there is abiguity' go to 999 endif @@ -34,16 +34,14 @@ program fst4sim call getarg(4,arg) read(arg,*) xdt !Time offset from nominal (s) call getarg(5,arg) - read(arg,*) hmod !Modulation index, h - call getarg(6,arg) read(arg,*) fspread !Watterson frequency spread (Hz) - call getarg(7,arg) + call getarg(6,arg) read(arg,*) delay !Watterson delay (ms) - call getarg(8,arg) + call getarg(7,arg) read(arg,*) nfiles !Number of files - call getarg(9,arg) + call getarg(8,arg) read(arg,*) snrdb !SNR_2500 - call getarg(10,arg) + call getarg(9,arg) read(arg,*) wspr_hint !0:break ties as 77-bit 1:break ties as 50-bit nfiles=abs(nfiles) @@ -89,8 +87,8 @@ program fst4sim call genfst4(msg37,0,msgsent37,msgbits,itone,iwspr) write(*,*) write(*,'(a9,a37,a3,L2,a7,i2)') 'Message: ',msgsent37,'W:',wspr_hint,' iwspr:',iwspr - write(*,1000) f00,xdt,hmod,txt,snrdb -1000 format('f0:',f9.3,' DT:',f6.2,' hmod:',i6,' TxT:',f6.1,' SNR:',f6.1) + write(*,1000) f00,xdt,txt,snrdb +1000 format('f0:',f9.3,' DT:',f6.2,' TxT:',f6.1,' SNR:',f6.1) write(*,*) if(i3.eq.1) then write(*,*) ' mycall hiscall hisgrid' @@ -106,7 +104,8 @@ program fst4sim ! call sgran() - fsample=12000.0 + fsample=12000.0 + hmod=1 icmplx=1 f0=f00+1.5*hmod*baud call gen_fst4wave(itone,NN,nsps,nwave,fsample,hmod,f0,icmplx,c0,wave) @@ -118,7 +117,8 @@ program fst4sim do ifile=1,nfiles c=c0 - if(fspread.ne.0.0 .or. delay.ne.0.0) call watterson(c,nwave,NZ,fs,delay,fspread) + if(fspread.gt.0.0 .or. delay.ne.0.0) call watterson(c,nwave,NZ,fs,delay,fspread) + if(fspread.lt.0.0) call lorentzian_fading(c,nwave,fs,-fspread) c=sig*c wave=real(c) if(snrdb.lt.90) then diff --git a/lib/fst4/ldpcsim240_74.f90 b/lib/fst4/ldpcsim240_74.f90 index b488aa6b6..78e8e6b5f 100644 --- a/lib/fst4/ldpcsim240_74.f90 +++ b/lib/fst4/ldpcsim240_74.f90 @@ -101,7 +101,7 @@ write(*,'(24i1)') msgbits(51:74) llr=2.0*rxdata/(ss*ss) apmask=0 dmin=0.0 - maxosd=0 + maxosd=2 call decode240_74(llr, Keff, maxosd, norder, apmask, message74, cw, ntype, nharderror, dmin) if(nharderror.ge.0) then n2err=0 diff --git a/lib/fst4/lorentzian_fading.f90 b/lib/fst4/lorentzian_fading.f90 new file mode 100644 index 000000000..c1bd5c325 --- /dev/null +++ b/lib/fst4/lorentzian_fading.f90 @@ -0,0 +1,43 @@ +subroutine lorentzian_fading(c,npts,fs,fspread) +! +! npts is the total length of the simulated data vector +! + complex c(0:npts-1) + complex cspread(0:npts-1) + complex z + + twopi=8.0*atan(1.0) + df=fs/npts + nh=npts/2 + cspread(0)=1.0 + cspread(nh)=0. + b=6.0 + do i=1,nh + f=i*df + x=b*f/fspread + z=0. + a=0. + if(x.lt.3.0) then + a=sqrt(1.111/(1.0+x*x)-0.1) + phi1=twopi*rran() + z=a*cmplx(cos(phi1),sin(phi1)) + endif + cspread(i)=z + z=0. + if(x.lt.3.0) then + phi2=twopi*rran() + z=a*cmplx(cos(phi2),sin(phi2)) + endif + cspread(npts-i)=z + enddo + + call four2a(cspread,npts,1,1,1) + + s=sum(abs(cspread)**2) + avep=s/npts + fac=sqrt(1.0/avep) + cspread=fac*cspread + c=cspread*c + + return +end subroutine lorentzian_fading diff --git a/lib/fst4_decode.f90 b/lib/fst4_decode.f90 index ba49fb54d..5fb591ffa 100644 --- a/lib/fst4_decode.f90 +++ b/lib/fst4_decode.f90 @@ -33,15 +33,17 @@ contains ndepth,ntrperiod,nexp_decode,ntol,emedelay,lagain,lapcqonly,mycall, & hiscall,iwspr) + use prog_args use timer_module, only: timer use packjt77 use, intrinsic :: iso_c_binding include 'fst4/fst4_params.f90' - parameter (MAXCAND=100) + parameter (MAXCAND=100,MAXWCALLS=100) class(fst4_decoder), intent(inout) :: this procedure(fst4_decode_callback) :: callback character*37 decodes(100) character*37 msg,msgsent + character*20 wcalls(MAXWCALLS), wpart character*77 c77 character*12 mycall,hiscall character*12 mycall0,hiscall0 @@ -56,8 +58,7 @@ contains logical lagain,lapcqonly integer itone(NN) integer hmod - integer ipct(0:7) - integer*1 apmask(240),cw(240) + integer*1 apmask(240),cw(240),hdec(240) integer*1 message101(101),message74(74),message77(77) integer*1 rvec(77) integer apbits(240) @@ -66,11 +67,12 @@ contains integer mcq(29),mrrr(19),m73(19),mrr73(19) logical badsync,unpk77_success,single_decode - logical first,nohiscall,lwspr,ex + logical first,nohiscall,lwspr + logical new_callsign,plotspec_exists,wcalls_exists,do_k50_decode + logical decdata_exists integer*2 iwave(30*60*12000) - data ipct/0,8,14,4,12,2,10,6/ data mcq/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0/ data mrrr/0,1,1,1,1,1,1,0,1,0,0,1,0,0,1,0,0,0,1/ data m73/0,1,1,1,1,1,1,0,1,0,0,1,0,1,0,0,0,0,1/ @@ -80,6 +82,7 @@ contains 0,1,0,1,0,1,1,0,1,1,1,1,1,0,0,0,1,0,1/ data first/.true./,hmod/1/ save first,apbits,nappasses,naptypes,mycall0,hiscall0 + save wcalls,nwcalls this%callback => callback dxcall13=hiscall ! initialize for use in packjt77 @@ -88,6 +91,20 @@ contains if(iwspr.ne.0.and.iwspr.ne.1) return if(first) then +! read the fst4_calls.txt file + inquire(file=trim(data_dir)//'/fst4w_calls.txt',exist=wcalls_exists) + if( wcalls_exists ) then + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,MAXWCALLS + wcalls(i)='' + read(42,fmt='(a)',end=2867) wcalls(i) + wcalls(i)=adjustl(wcalls(i)) + if(len(trim(wcalls(i))).eq.0) exit + enddo +2867 nwcalls=i-1 + close(42) + endif + mcq=2*mod(mcq+rvec(1:29),2)-1 mrrr=2*mod(mrrr+rvec(59:77),2)-1 m73=2*mod(m73+rvec(59:77),2)-1 @@ -213,17 +230,22 @@ contains allocate( cframe(0:160*nss-1) ) jittermax=2 + do_k50_decode=.false. if(ndepth.eq.3) then nblock=4 jittermax=2 + do_k50_decode=.true. elseif(ndepth.eq.2) then - nblock=3 - jittermax=0 + nblock=4 + jittermax=2 + do_k50_decode=.false. elseif(ndepth.eq.1) then - nblock=1 + nblock=4 jittermax=0 + do_k50_decode=.false. endif +! Noise blanker setup ndropmax=1 single_decode=iand(nexp_decode,32).ne.0 npct=0 @@ -239,33 +261,40 @@ contains inb2=1 !Try NB = 0, 1, 2,... 20% else inb1=0 !Fixed NB value, 0 to 25% - ipct(0)=npct endif + +! nfa,nfb: define the noise-baseline analysis window +! fa, fb: define the signal search window +! We usually make nfafb so that noise baseline analysis +! window extends outside of the [fa,fb] window where we think the signals are. +! if(iwspr.eq.1) then !FST4W - !300 Hz wide noise-fit window - nfa=max(100,nint(nfqso+1.5*baud-150)) - nfb=min(4800,nint(nfqso+1.5*baud+150)) + nfa=max(100,nfqso-ntol-100) + nfb=min(4800,nfqso+ntol+100) fa=max(100,nint(nfqso+1.5*baud-ntol)) ! signal search window fb=min(4800,nint(nfqso+1.5*baud+ntol)) - else if(single_decode) then - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) - else - fa=max(100,nint(nfa+1.5*baud)) - fb=min(4800,nint(nfb+1.5*baud)) - ! extend noise fit 100 Hz outside of search window - nfa=max(100,nfa-100) - nfb=min(4800,nfb+100) + else if(iwspr.eq.0) then + if(single_decode) then + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + else + fa=max(100,nint(nfa+1.5*baud)) + fb=min(4800,nint(nfb+1.5*baud)) + ! extend noise fit 100 Hz outside of search window + nfa=max(100,nfa-100) + nfb=min(4800,nfb+100) + endif endif - + ndecodes=0 decodes=' ' + new_callsign=.false. do inb=0,inb1,inb2 - if(nb.lt.0) npct=inb + if(nb.lt.0) npct=inb ! we are looping over blanker settings call blanker(iwave,nfft1,ndropmax,npct,c_bigfft) ! The big fft is done once and is used for calculating the smoothed spectrum @@ -275,23 +304,22 @@ contains nsyncoh=8 minsync=1.20 if(ntrperiod.eq.15) minsync=1.15 - + ! Get first approximation of candidate frequencies call get_candidates_fst4(c_bigfft,nfft1,nsps,hmod,fs,fa,fb,nfa,nfb, & - minsync,ncand,candidates0) + minsync,ncand,candidates0) isbest=0 fc2=0. do icand=1,ncand fc0=candidates0(icand,1) if(iwspr.eq.0 .and. nb.lt.0 .and. npct.ne.0 .and. & - abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle + abs(fc0-(nfqso+1.5*baud)).gt.ntol) cycle ! blanker loop only near nfqso detmet=candidates0(icand,2) ! Downconvert and downsample a slice of the spectrum centered on the ! rough estimate of the candidates frequency. ! Output array c2 is complex baseband sampled at 12000/ndown Sa/sec. ! The size of the downsampled c2 array is nfft2=nfft1/ndown - call timer('dwnsmpl ',0) call fst4_downsample(c_bigfft,nfft1,ndown,fc0,sigbw,c2) call timer('dwnsmpl ',1) @@ -330,9 +358,9 @@ contains endif enddo ncand=ic - -! If FST4 and Single Decode is not checked, then find candidates within -! 20 Hz of nfqso and put them at the top of the list + +! If FST4 mode and Single Decode is not checked, then find candidates +! within 20 Hz of nfqso and put them at the top of the list if(iwspr.eq.0 .and. .not.single_decode) then nclose=count(abs(candidates0(:,3)-(nfqso+1.5*baud)).le.20) k=0 @@ -368,12 +396,13 @@ contains if(ijitter.eq.1) ioffset=1 if(ijitter.eq.2) ioffset=-1 is0=isbest+ioffset - if(is0.lt.0) cycle - cframe=c2(is0:is0+160*nss-1) + iend=is0+160*nss-1 + if( is0.lt.0 .or. iend.gt.(nfft2-1) ) cycle + cframe=c2(is0:iend) bitmetrics=0 call timer('bitmetrc',0) call get_fst4_bitmetrics(cframe,nss,nblock,nhicoh,bitmetrics, & - s4,nsync_qual,badsync) + s4,nsync_qual,badsync) call timer('bitmetrc',1) if(badsync) cycle @@ -384,10 +413,10 @@ contains llrs(181:240,il)=bitmetrics(245:304, il) enddo - apmag=maxval(abs(llrs(:,1)))*1.1 + apmag=maxval(abs(llrs(:,4)))*1.1 ntmax=nblock+nappasses(nQSOProgress) if(lapcqonly) ntmax=nblock+1 - if(ndepth.eq.1) ntmax=nblock + if(ndepth.eq.1) ntmax=nblock ! no ap for ndepth=1 apmask=0 if(iwspr.eq.1) then ! 50-bit msgs, no ap decoding @@ -405,7 +434,7 @@ contains iaptype=0 endif - if(itry.gt.nblock) then ! do ap passes + if(itry.gt.nblock .and. iwspr.eq.0) then ! do ap passes llr=llrs(:,nblock) ! Use largest blocksize as the basis for AP passes iaptype=naptypes(nQSOProgress,itry-nblock) if(lapcqonly) iaptype=1 @@ -428,7 +457,7 @@ contains apmask(1:58)=1 llr(1:58)=apmag*apbits(1:58) endif - + if(iaptype.eq.4 .or. iaptype.eq.5 .or. iaptype .eq.6) then apmask=0 apmask(1:77)=1 @@ -438,7 +467,7 @@ contains if(iaptype.eq.6) llr(59:77)=apmag*mrr73(1:19) endif endif - + dmin=0.0 nharderrors=-1 unpk77_success=.false. @@ -448,83 +477,142 @@ contains norder=3 call timer('d240_101',0) call decode240_101(llr,Keff,maxosd,norder,apmask,message101, & - cw,ntype,nharderrors,dmin) + cw,ntype,nharderrors,dmin) call timer('d240_101',1) - elseif(iwspr.eq.1) then - maxosd=2 - call timer('d240_74 ',0) - Keff=64 - norder=4 - call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & - ntype,nharderrors,dmin) - call timer('d240_74 ',1) - endif - - if(nharderrors .ge.0) then if(count(cw.eq.1).eq.0) then nharderrors=-nharderrors cycle endif - if(iwspr.eq.0) then - write(c77,'(77i1)') mod(message101(1:77)+rvec,2) - call unpack77(c77,1,msg,unpk77_success) - else + write(c77,'(77i1)') mod(message101(1:77)+rvec,2) + call unpack77(c77,1,msg,unpk77_success) + elseif(iwspr.eq.1) then +! Try decoding with Keff=66 + maxosd=2 + call timer('d240_74 ',0) + Keff=66 + norder=3 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(nharderrors.lt.0) goto 3465 + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif + write(c77,'(50i1)') message74(1:50) + c77(51:77)='000000000000000000000110000' + call unpack77(c77,1,msg,unpk77_success) + if(unpk77_success .and. do_k50_decode) then +! If decode was obtained with Keff=66, save call/grid in fst4w_calls.txt if not there already. + i1=index(msg,' ') + i2=i1+index(msg(i1+1:),' ') + wpart=trim(msg(1:i2)) +! Only save callsigns/grids from type 1 messages + if(index(wpart,'/').eq.0 .and. index(wpart,'<').eq.0) then + ifound=0 + do i=1,nwcalls + if(index(wcalls(i),wpart).ne.0) ifound=1 + enddo + + if(ifound.eq.0) then ! This is a new callsign + new_callsign=.true. + if(nwcalls.lt.MAXWCALLS) then + nwcalls=nwcalls+1 + wcalls(nwcalls)=wpart + else + wcalls(1:nwcalls-1)=wcalls(2:nwcalls) + wcalls(nwcalls)=wpart + endif + endif + endif + endif +3465 continue + +! If no decode then try Keff=50 + iaptype=0 + if( .not. unpk77_success .and. do_k50_decode ) then + maxosd=1 + call timer('d240_74 ',0) + Keff=50 + norder=4 + call decode240_74(llr,Keff,maxosd,norder,apmask,message74,cw, & + ntype,nharderrors,dmin) + call timer('d240_74 ',1) + if(count(cw.eq.1).eq.0) then + nharderrors=-nharderrors + cycle + endif write(c77,'(50i1)') message74(1:50) c77(51:77)='000000000000000000000110000' call unpack77(c77,1,msg,unpk77_success) +! No CRC in this mode, so only accept the decode if call/grid have been seen before + if(unpk77_success) then + unpk77_success=.false. + do i=1,nwcalls + if(index(msg,trim(wcalls(i))).gt.0) then + unpk77_success=.true. + endif + enddo + endif endif - if(unpk77_success) then - idupe=0 - do i=1,ndecodes - if(decodes(i).eq.msg) idupe=1 - enddo - if(idupe.eq.1) goto 800 - ndecodes=ndecodes+1 - decodes(ndecodes)=msg - - if(iwspr.eq.0) then - call get_fst4_tones_from_bits(message101,itone,0) - else - call get_fst4_tones_from_bits(message74,itone,1) - endif - inquire(file='plotspec',exist=ex) - fmid=-999.0 - call timer('dopsprd ',0) - if(ex) then - call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & - isbest,fc_synced,fmid,w50) - endif - call timer('dopsprd ',1) - xsig=0 - do i=1,NN - xsig=xsig+s4(itone(i),i) - enddo - base=candidates(icand,5) - arg=600.0*(xsig/base)-1.0 - if(arg.gt.0.0) then - xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) - if(ntrperiod.eq. 15) xsnr=xsnr+2 - if(ntrperiod.eq. 30) xsnr=xsnr+1 - if(ntrperiod.eq. 900) xsnr=xsnr+1 - if(ntrperiod.eq.1800) xsnr=xsnr+2 - else - xsnr=-99.9 - endif + + endif + + if(nharderrors .ge.0 .and. unpk77_success) then + idupe=0 + do i=1,ndecodes + if(decodes(i).eq.msg) idupe=1 + enddo + if(idupe.eq.1) goto 800 + ndecodes=ndecodes+1 + decodes(ndecodes)=msg + + if(iwspr.eq.0) then + call get_fst4_tones_from_bits(message101,itone,0) else - cycle + call get_fst4_tones_from_bits(message74,itone,1) + endif + inquire(file='plotspec',exist=plotspec_exists) + fmid=-999.0 + call timer('dopsprd ',0) + if(plotspec_exists) then + call dopspread(itone,iwave,nsps,nmax,ndown,hmod, & + isbest,fc_synced,fmid,w50) + endif + call timer('dopsprd ',1) + xsig=0 + do i=1,NN + xsig=xsig+s4(itone(i),i) + enddo + base=candidates(icand,5) + arg=600.0*(xsig/base)-1.0 + if(arg.gt.0.0) then + xsnr=10*log10(arg)-35.5-12.5*log10(nsps/8200.0) + if(ntrperiod.eq. 15) xsnr=xsnr+2 + if(ntrperiod.eq. 30) xsnr=xsnr+1 + if(ntrperiod.eq. 900) xsnr=xsnr+1 + if(ntrperiod.eq.1800) xsnr=xsnr+2 + else + xsnr=-99.9 endif nsnr=nint(xsnr) - qual=0. + qual=0.0 fsig=fc_synced - 1.5*baud - if(ex) then + inquire(file=trim(data_dir)//'/decdata',exist=decdata_exists) + if(decdata_exists) then + hdec=0 + where(llrs(:,1).ge.0.0) hdec=1 + nhp=count(hdec.ne.cw) ! # hard errors wrt N=1 soft symbols + hd=sum(ieor(hdec,cw)*abs(llrs(:,1))) ! weighted distance wrt N=1 symbols + open(21,file=trim(data_dir)//'/fst4_decodes.dat',status='unknown',position='append') write(21,3021) nutc,icand,itry,nsyncoh,iaptype, & - ijitter,ntype,nsync_qual,nharderrors,dmin, & - sync,xsnr,xdt,fsig,w50,trim(msg) -3021 format(i6.6,6i3,2i4,f6.1,f7.2,f6.1,f6.2,f7.1,f7.3,1x,a) - flush(21) + ijitter,npct,ntype,Keff,nsync_qual,nharderrors,dmin,nhp,hd, & + sync,xsnr,xdt,fsig,w50,trim(msg) +3021 format(i6.6,i4,6i3,3i4,f6.1,i4,f6.1,f9.2,f6.1,f6.2,f7.1,f7.3,1x,a) + close(21) endif call this%callback(nutc,smax1,nsnr,xdt,fsig,msg, & - iaptype,qual,ntrperiod,lwspr,fmid,w50) + iaptype,qual,ntrperiod,lwspr,fmid,w50) if(iwspr.eq.0 .and. nb.lt.0) go to 900 goto 800 endif @@ -532,9 +620,17 @@ contains enddo ! istart jitter 800 enddo !candidate list enddo ! noise blanker loop - + + if(new_callsign .and. do_k50_decode) then ! re-write the fst4w_calls.txt file + open(42,file=trim(data_dir)//'/fst4w_calls.txt',status='unknown') + do i=1,nwcalls + write(42,'(a20)') trim(wcalls(i)) + enddo + close(42) + endif + 900 return - end subroutine decode + end subroutine decode subroutine sync_fst4(cd0,i0,f0,hmod,ncoh,np,nss,ntr,fs,sync) @@ -726,8 +822,8 @@ contains do i=ina,inb !Compute CCF of s() and 4 tones s2(i)=s(i-hmod*3) + s(i-hmod) +s(i+hmod) +s(i+hmod*3) enddo - npct=30 - call fst4_baseline(s2,nnw,ina+hmod*3,inb-hmod*3,npct,sbase) + npctile=30 + call fst4_baseline(s2,nnw,ina+hmod*3,inb-hmod*3,npctile,sbase) if(any(sbase(ina:inb).le.0.0)) return s2(ina:inb)=s2(ina:inb)/sbase(ina:inb) !Normalize wrt noise level @@ -902,6 +998,6 @@ contains enddo return - end subroutine dopspread + end subroutine dopspread end module fst4_decode diff --git a/lib/ft8/get_spectrum_baseline.f90 b/lib/ft8/get_spectrum_baseline.f90 index 9cf4e637c..f815eba14 100644 --- a/lib/ft8/get_spectrum_baseline.f90 +++ b/lib/ft8/get_spectrum_baseline.f90 @@ -35,8 +35,19 @@ subroutine get_spectrum_baseline(dd,nfa,nfb,sbase) savg=savg + s(1:NH1,j) !Average spectrum enddo - if(nfa.lt.100) nfa=100 - if(nfb.gt.4910) nfb=4910 + nwin=nfb-nfa + if(nfa.lt.100) then + nfa=100 + if(nwin.lt.100) then ! nagain + nfb=nfa+nwin + endif + endif + if(nfb.gt.4910) then + nfb=4910 + if(nwin.lt.100) then + nfa=nfb-nwin + endif + endif call baseline(savg,nfa,nfb,sbase) return diff --git a/lib/ft8_decode.f90 b/lib/ft8_decode.f90 index 26b12d6c9..73d0f8c2a 100644 --- a/lib/ft8_decode.f90 +++ b/lib/ft8_decode.f90 @@ -118,7 +118,7 @@ contains dd1=dd go to 900 endif - if(nzhsym.eq.50 .and. ndec_early.ge.1) then + if(nzhsym.eq.50 .and. ndec_early.ge.1 .and. .not.nagain) then n=47*3456 dd(1:n)=dd1(1:n) dd(n+1:)=iwave(n+1:) @@ -131,9 +131,10 @@ contains endif ifa=nfa ifb=nfb - if(nagain) then - ifa=nfqso-10 - ifb=nfqso+10 + if(nzhsym.eq.50 .and. nagain) then + dd=iwave + ifa=nfqso-20 + ifb=nfqso+20 endif ! For now: diff --git a/translations/wsjtx_da.ts b/translations/wsjtx_da.ts index bb7744752..ecb74c401 100644 --- a/translations/wsjtx_da.ts +++ b/translations/wsjtx_da.ts @@ -247,7 +247,7 @@ <html><head/><body><p>Right-click here for available actions.</p></body></html> - <html><head/><body> <p> Højreklik her for tilgængelige muligheder. </p> </body> </html> + <html><head/><body><p> Højreklik her for tilgængelige muligheder.</p></body></html> @@ -318,7 +318,7 @@ New Call - Ny kaldesignal + Nyt kaldesignal @@ -2197,7 +2197,7 @@ Fejl(%2): %3 &Decode - &Dekod + &Dekode @@ -2492,7 +2492,7 @@ Gul er for lavt Fast - Fast + Hurtig @@ -5578,7 +5578,7 @@ Fejl(%2): %3 Monitor returns to last used frequency - Montor til seneste brugte frekvens + Monitor til seneste brugte frekvens @@ -5673,7 +5673,7 @@ den stille periode, når dekodningen er udført. Serial Port Parameters - Seriek Port Parametre + Seriel Port Parametre @@ -5774,7 +5774,7 @@ den stille periode, når dekodningen er udført. Default - Deafult + Default diff --git a/widgets/colorhighlighting.cpp b/widgets/colorhighlighting.cpp index 6ad0bd4da..e7e9deddb 100644 --- a/widgets/colorhighlighting.cpp +++ b/widgets/colorhighlighting.cpp @@ -1,7 +1,7 @@ #include "colorhighlighting.h" #include -#include +#include #include "SettingsGroup.hpp" #include "models/DecodeHighlightingModel.hpp" @@ -113,16 +113,16 @@ void ColorHighlighting::set_items (DecodeHighlightingModel const& highlighting_m default: continue; } - auto palette = example->parentWidget ()->palette (); + auto style_sheet = example->parentWidget ()->styleSheet (); if (Qt::NoBrush != item.background_.style ()) { - palette.setColor (QPalette::Window, item.background_.color ()); + style_sheet += QString {"; background-color: #%1"}.arg (item.background_.color ().rgb (), 8, 16, QLatin1Char {'0'}); } if (Qt::NoBrush != item.foreground_.style ()) { - palette.setColor (QPalette::WindowText, item.foreground_.color ()); + style_sheet += QString {"; color: #%1"}.arg (item.foreground_.color ().rgb (), 8, 16, QLatin1Char {'0'}); } - example->setPalette (palette); + example->setStyleSheet (style_sheet); example->setEnabled (item.enabled_); label->setText (DecodeHighlightingModel::highlight_name (item.type_)); label->setEnabled (item.enabled_); diff --git a/widgets/mainwindow.cpp b/widgets/mainwindow.cpp index ad8837b57..1bfd9c584 100644 --- a/widgets/mainwindow.cpp +++ b/widgets/mainwindow.cpp @@ -1604,7 +1604,7 @@ void MainWindow::dataSink(qint64 frames) m_saveWAVWatcher.setFuture (QtConcurrent::run (std::bind (&MainWindow::save_wave_file, this, m_fnameWE, &dec_data.d2[0], samples, m_config.my_callsign(), m_config.my_grid(), m_mode, m_nSubMode, m_freqNominal, m_hisCall, m_hisGrid))); - if (m_mode=="WSPR" or m_mode=="FST4W") { + if (m_mode=="WSPR") { QString c2name_string {m_fnameWE + ".c2"}; int len1=c2name_string.length(); char c2name[80]; @@ -1667,7 +1667,7 @@ QString MainWindow::save_wave_file (QString const& name, short const * data, int auto comment = QString {"Mode=%1%2; Freq=%3%4"} .arg (mode) .arg (QString {(mode.contains ('J') && !mode.contains ('+')) - || mode.startsWith ("FST4") || mode.startsWith ("QRA") + || mode.startsWith ("FST4") || mode.startsWith ('Q') ? QString {"; Sub Mode="} + QString::number (int (samples / 12000)) + QChar {'A' + sub_mode} : QString {}}) .arg (Radio::frequency_MHz_string (frequency)) @@ -3574,7 +3574,16 @@ void MainWindow::readFromStdout() //readFromStdout decodedtext.deCallAndGrid(/*out*/deCall,grid); { auto t = Radio::base_callsign (ui->dxCallEntry->text ()); - if ((t == deCall || ui->dxCallEntry->text () == deCall || !t.size ()) && rpt.size ()) m_rptRcvd = rpt; + auto const& dx_call = decodedtext.call (); + if (rpt.size () // report in message + && (m_baseCall == Radio::base_callsign (dx_call) // for us + || "DE" == dx_call) // probably for us + && (t == deCall // DX station base call is QSO partner + || ui->dxCallEntry->text () == deCall // DX station full call is QSO partner + || !t.size ())) // not in QSO + { + m_rptRcvd = rpt; + } } // extract details and send to PSKreporter int nsec=QDateTime::currentMSecsSinceEpoch()/1000-m_secBandChanged; @@ -4158,7 +4167,14 @@ void MainWindow::guiUpdate() } } - m_currentMessage = QString::fromLatin1(msgsent); + { + auto temp = m_currentMessage; + m_currentMessage = QString::fromLatin1(msgsent); + if (m_currentMessage != temp) // check if tx message changed + { + statusUpdate (); + } + } m_bCallingCQ = CALLING == m_QSOProgress || m_currentMessage.contains (QRegularExpression {"^(CQ|QRZ) "}); if(m_mode=="FT8" or m_mode=="FT4") { @@ -8337,7 +8353,8 @@ void MainWindow::statusUpdate () const m_hisGrid, m_tx_watchdog, submode != QChar::Null ? QString {submode} : QString {}, m_bFastMode, static_cast (m_config.special_op_id ()), - ftol, tr_period, m_multi_settings->configuration_name ()); + ftol, tr_period, m_multi_settings->configuration_name (), + m_currentMessage); } void MainWindow::childEvent (QChildEvent * e)