WSJT-X/lib/superfox/foxgen2.f90

subroutine foxgen2(nslots,cmsg,line)

! Called from foxgen() when it's time to encode a SuperFox message and
! generate the waveform to be transmitted.  We need to parse the old-style
! Fox messages and extract the necessary pieces.

!  use packjt77
  character*120 line
  character*40 cmsg(5)                !Old-style Fox messages are here
  character*37 msg
  character*26 sfmsg
  character*13 mycall
  character*4 mygrid
  character*6 hiscall_1,hiscall_2
  character*4 rpt1,rpt2
  character*13 w(19)
  integer nw(19)
  integer ntype        !Message type: 0 Free Text
                       !              1 CQ MyCall MyGrid
                       !              2 Call_1 MyCall RR73
                       !              3 Call_1 MyCall rpt1
                       !              4 Call_1 RR73; Call_2 <MyCall> rpt2
  
  if(nslots.lt.1 .or. nslots.gt.5) return
  k=0
  do i=1,nslots
     hiscall_1=''
     hiscall_2=''
     mycall=''
     mygrid=''
     rpt1=''
     rpt2=''
     msg=cmsg(i)(1:37)
     call split77(msg,nwords,nw,w)
     ntype=0
     if(msg(1:3).eq.'CQ ') then
        ntype=1
        mycall=w(2)(1:12)
        mygrid=w(3)(1:4)
     else if(index(msg,';').gt.0) then
        ntype=4
        hiscall_1=w(1)(1:6)
        hiscall_2=w(3)(1:6)
        rpt1='RR73'
        rpt2=w(5)(1:4)
        mycall=w(4)(2:nw(4)-1)
     else if(index(msg,' RR73').gt.0) then
        ntype=2
        hiscall_1=w(1)(1:6)
        mycall=w(2)(1:12)
        rpt1='RR73'
     else if(nwords.eq.3 .and. nw(3).eq.3 .and. &
          (w(3)(1:1).eq.'-' .or. w(3)(1:1).eq.'+')) then
        ntype=3
        hiscall_1=w(1)(1:6)
        mycall=w(2)(1:12)
        rpt1=w(3)(1:4)
     endif
!     write(*,3001) ntype,cmsg(i),hiscall_1,rpt1,hiscall_2,rpt2,  &
!          mycall(1:6),mygrid
!3001 format(i1,2x,a37,1x,a6,1x,a4,1x,a6,1x,a4,1x,a6,1x,a4)

     k=k+1
     if(ntype.le.3) call sfox_assemble(ntype,k,msg(1:26),mycall,mygrid,line)
     if(ntype.eq.4) then
        sfmsg=w(1)(1:nw(1))//' '//mycall(1:len(trim(mycall))+1)//'RR73'
        call sfox_assemble(2,k,sfmsg,mycall,mygrid,line)
        sfmsg=w(3)(1:nw(3))//' '//mycall(1:len(trim(mycall))+1)//w(5)(1:3)
        k=k+1
        call sfox_assemble(3,k,sfmsg,mycall,mygrid,line)
     endif

  enddo

  call sfox_assemble(ntype,11,msg(1:26),mycall,mygrid,line)   !k=11 to finish up

  return
end subroutine foxgen2

subroutine split77(msg,nwords,nw,w)

! Convert msg to upper case; collapse multiple blanks; parse into words.

  character*37 msg
  character*13 w(19)
  character*1 c,c0
  character*6 bcall_1
  logical ok1
  integer nw(19)
    
  iz=len(trim(msg))
  j=0
  k=0
  n=0
  c0=' '
  w='             '
  do i=1,iz
     if(ichar(msg(i:i)).eq.0) msg(i:i)=' '
     c=msg(i:i)                                 !Single character
     if(c.eq.' ' .and. c0.eq.' ') cycle         !Skip leading/repeated blanks
     if(c.ne.' ' .and. c0.eq.' ') then
        k=k+1                                   !New word
        n=0
     endif
     j=j+1                                      !Index in msg
     n=n+1                                      !Index in word
     if(c.ge.'a' .and. c.le.'z') c=char(ichar(c)-32)  !Force upper case
     msg(j:j)=c
     if(n.le.13) w(k)(n:n)=c                    !Copy character c into word
     c0=c
  enddo
  iz=j                                          !Message length
  nwords=k                                      !Number of words in msg
  if(nwords.le.0) go to 900
  do i=1,nwords
     nw(i)=len(trim(w(i)))
  enddo
  msg(iz+1:)='                                     '
  if(nwords.lt.3) go to 900
  call chkcall(w(3),bcall_1,ok1)
  if(ok1 .and. w(1)(1:3).eq.'CQ ') then
     w(1)='CQ_'//w(2)(1:10)             !Make "CQ " into "CQ_"
     w(2:12)=w(3:13)                    !Move all remaining words down by one
     nwords=nwords-1
  endif

900 return
end subroutine split77