!******************************************************************************!
! Tests for FFT command
!
! Arguments: None
!
! @bug      NXM-2407, others...
! @bug      NXM-4052  FFT needs testing for /MAG, /LOG, /DBF, and plain cross
! @since    NeXtMidas 1.9.2
! @author:  JC4 / J Bauer / J Hallam
!******************************************************************************!

startmacro
  call setDatDir

  result eflag 0

  ! Allow some of the tests to run in a thinned NeXtMidas by skipping only ones needing missing dependencies - 4.0.0
  invoke compareExists reg.shell.M.dictionary.isDictionaryEntry(COMPARE)

  res prefix "test_fft_"

  set wavefile  "^{prefix}sin1"
  set wavefile2 "^{prefix}sin2"
  set fftfile1  "^{prefix}out1"
  set fftfile2  "^{prefix}out2"

  info "Should see warnings when no output is written to output files"

  ! Test FFT options
  if compareExists then
    call test_basic "^wavefile" "^fftfile1" "^fftfile2"
  endif
  call test_navg_1  "^wavefile"  "^fftfile1"
  call test_rfft_bad "^wavefile"  "^fftfile1" "^fftfile2"
  call test_partial_switch "^wavefile"  "^fftfile1"
  call test_hcb_propagation wavefile fftfile1 wavefile2 fftfile2
  call test_1d
  call test_dbf_log_mag
  call test_cross

  ! Cleanup test files
  files/e ^{prefix}*

  !call additional testing here
  %test_fft_navg !since NXM 3.9.0 for issue NXM-3210

endmacro

!******************************************************************************!
! Main process message for this macro. Should be right after the ENDMACRO.
!******************************************************************************!
procedure processMessage m:msg
  if msg.name eqs "MAIN" then
    assert/text="^reg.main.name: User indicated tests" msg.data eqss "PASS"
    pipe stop
  else
    !say "Unhandled message name: ^msg.name from fid: ^msg.fid data: ^msg.data"
  endif
return

!******************************************************************************!
!
!  Trap exceptions during FFT testing, and ensure they correspond to
!  expected error conditions
!
procedure processException m:emsg

  if eflag == 1 then
    assert/text="RFFT called with odd number of elements" "MidasException" SUBS ^emsg.data AND "Invalid FFT size" SUBS ^emsg.data
  elseif eflag == 2 then
    assert/text="FFT called with one input and CROSS parameter" "MidasException" SUBS ^emsg.data AND "CROSS parameter is invalid" SUBS ^emsg.data
  else
    res emsg
    res emsg.data
    assert/text="UNEXPECTED FFT exception" false
  endif

return

!******************************************************************************!
! Set the dat directory
!******************************************************************************!
procedure setDatDir
  invoke nxmMajor env.nmversion.subString(0,1)
  invoke major java.lang.Integer.valueOf(nxmMajor)
  if major GE 4 then
    invoke s:datDir           nxm.sys.test.DatLocator.getDatDirLocation()
    invoke s:datDirSlash      nxm.sys.test.DatLocator.getDatDirSlashLocation()
    invoke z:sysDatFull       nxm.sys.test.DatLocator.sysDatFull()
    invoke z:sysTestDatExists nxm.sys.test.DatLocator.sysTestDatExists()
  else
    set s:datDir           "nxm.sys.dat"
    set s:datDirSlash      "nxm/sys/dat"
    set z:sysDatFull       true
    set z:sysTestDatExists false
  endif
return

!******************************************************************************!
!  Basic tests for FFT
!******************************************************************************!
procedure test_basic fn:input fn:output1 fn:output2

  WAVEFORM,OUT=^input,FORM=SF,ELEM=1e6,SHAPE=SIN,AMP=1,FREQ=.01,PHASE=0,START=0,DELTA=1
  FFT,IN1=^input,OUT1=^output1,NFFT=1K,WIN=HANN,OVER=0,NAVG=1 /psd
  FFT,IN1=^input,OUT1=^output2,NFFT=1K,WIN=HANN,OVER=0,NAVG=10 /psd

  statis ^output1 max=max1
  statis ^output2 max=max2

  calc maxdiff max2 max1 - ABS
  sedit maxdiff maxdiffPretty "NFORM" "#.#######"
  assert/text="^reg.main.name: averaging - peaks should be similar. diff = ^maxdiffPretty" maxdiff LT 0.01
  !!!info "^reg.main.name: JGS -- what difference should be expected"
  
  WAVEFORM,OUT=^input,FORM=SF,ELEM=1e5,SHAPE=WHITE,AMP=1,FREQ=.01,PHASE=0,START=0,DELTA=1
  FFT,IN1=^input,OUT1=^output1,NFFT=1e5,WIN=HANN,OVER=0,NAVG=1
  FFT,IN1=^input,OUT1=^output2,NFFT=-1 ,WIN=HANN,OVER=0,NAVG=1
  COMPARE ^output1 ^output2 MAX_OUT=temp_max MIN_OUT=temp_min
  assert/text="^reg.main.name: Testing nfft=-1 " temp_max eq 0 and temp_min eq 0

return

!******************************************************************************!
!
!  DR 1318  Test to make sure only output one frame if there is
!           partial data at the end of an input file with NAVG = -1
!
procedure test_navg_1 fn:input fn:output

  WAVEFORM,OUT=^input,FORM=SF,ELEM=7000,SHAPE=SIN,AMP=1,FREQ=.01,PHASE=0,START=0,DELTA=1
  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=-1

  status ^output size=frames
  assert/text="^reg.main.name: DR 1318 - should only be one frame (got ^frames)" frames EQ 1

return

!******************************************************************************!
!
!  DR 980  Test /PARTIAL switch
!
procedure test_partial_switch fn:input fn:output
  WAVEFORM,OUT=^input,FORM=SF,ELEM=700,SHAPE=SIN,AMP=1,FREQ=.01,PHASE=0,START=0,DELTA=1
  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=-1
  status ^output size=frames
  assert/text="^reg.main.name: no /PARTIAL switch - should be one frame (got ^frames)" frames EQ 1

  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=-1 /PARTIAL=START
  status ^output size=frames
  assert/text="^reg.main.name: /PARTIAL=START - should be one frame (got ^frames)" frames EQ 1

  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=-1 /PARTIAL=NONE
  status ^output size=frames
  assert/text="^reg.main.name: /PARTIAL=NONE - should be no frames (got ^frames)" frames EQ 0

  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=-1 /PARTIAL=ALL
  status ^output size=frames
  assert/text="^reg.main.name: /PARTIAL=ALL - should be one frame (got ^frames)" frames EQ 1

  WAVEFORM,OUT=^input,FORM=SF,ELEM=7000,SHAPE=SIN,AMP=1,FREQ=.01,PHASE=0,START=0,DELTA=1
  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=4
  status ^output size=frames
  assert/text="^reg.main.name: no /PARTIAL switch #2 - should be one frame (got ^frames)" frames EQ 1

  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=4 /PARTIAL=StArT
  status ^output size=frames
  assert/text="^reg.main.name: /PARTIAL=StArT #2 - should be one frame (got ^frames)" frames EQ 1

  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=4 /PARTIAL=none
  status ^output size=frames
  assert/text="^reg.main.name: /PARTIAL=none #2 - should be one frame (got ^frames)" frames EQ 1

  FFT IN1=^input,OUT1=^output,NFFT=1k,OVER=0,NAVG=4 /PARTIAL=aLL
  status ^output size=frames
  assert/text="^reg.main.name: /PARTIAL=aLL #2 - should be two frames (got ^frames)" frames EQ 2

return


!******************************************************************************!
!
!  DR 2101  FFT: needs to propagate keywords from inputs to outputs
!  DR 2106  DataFile constructor with type, format, and hcbin to propagate header does not set type and format
!
procedure test_hcb_propagation fn:input fn:output fn:input2 fn:output2
  timex now curTime
  set key    "TESTKEY"
  set value  "Test Value"
  set tcprec "1e-9"
  WAVEFORM OUT=^input FORM=SF ELEM=1K SHAPE=SIN AMP=1 FREQ=.01 PHASE=0 START=0 DELTA=1
  header input timecode=^curTime
  keyword input "PUT" key value
  keyword/scope=main input "PUT" "TC_PREC" tcprec

  WAVEFORM OUT=^input2 FORM=SF ELEM=1K SHAPE=SIN AMP=1 FREQ=.01 PHASE=0 START=0 DELTA=1
  set key2    "TESTKEY2"
  set value2  "Test Value from input2"
  set tcprec2 "1e-10"
  timex now curTime2
  header input2 timecode=^curTime2
  keyword input2 "PUT" key2 value2
  keyword/scope=main input2 "PUT" "TC_PREC" tcprec2

  FFT IN1=^input OUT1=^output NFFT=1k OVER=0 NAVG=-1 IN2=input2 OUT2=output2
  status  output timecode=tc
  keyword output "GET" key out1value
  keyword output "GET" "TC_PREC" out1tcprec
  assert/text="^reg.main.name: TimeCode propagated from input 1 to output 1" tc eq curTime
  assert/text="^reg.main.name: TC_PREC keyword (main) propagated from input 1 to output 1" tcprec eqs out1tcprec
  assert/text="^reg.main.name: ^key keyword (extended) propagated from input 1 to output 1" value eqs out1value /cs

  status  output2 timecode=tc2
  keyword output2 "GET" key2 out2value
  keyword output2 "GET" "TC_PREC" out2tcprec
  assert/text="^reg.main.name: TimeCode propagated from input 2 to output 2" tc2 eq curTime2
  assert/text="^reg.main.name: TC_PREC keyword (main) propagated from input 2 to output 2" tcprec2 eqs out2tcprec
  assert/text="^reg.main.name: ^key keyword (extended) propagated from input 2 to output 2" value2 eqs out2value /cs

return

!******************************************************************************!
!
!  Test various bad FFT parameters
!
procedure test_rfft_bad fn:input fn:output fn:output2

  WAVEFORM,OUT=^input,FORM=SF,ELEM=7000,SHAPE=SIN,AMP=1,FREQ=.01,PHASE=0,START=0,DELTA=1

  !! Test calling RFFT with an odd number of elements gives an error, not an exception
  set eflag 1
  FFT IN1=^input,OUT1=^output,NFFT=101
  !! Test calling FFT with one input and CROSS output gives an error, not an exception
  set eflag 2
  FFT IN1=^input,OUT1=^output,CROSS=^output2
  set eflag 0

return

!******************************************************************************!
! Test Y Axis readout when /1D is used (Bug 2495)
!
procedure test_1d
  res l:elems 4k
  res l:nfft 1k
  calc l:expectedSize nfft 2 / 1 + 
  waveform ram:test1d elem=^elems
  fft/psd/1d ram:test1d ram:test_psd1d nfft=1k
  status ram:test_psd1d yunitsname=myUnits type=myType size=mySize

  assert/text="^reg.main.name: YUnits not labeled when using /1D" myUnits eqs "NONE"
  assert/text="^reg.main.name: File type==1000 when using /1D" myType eq 1000
  assert/text="^reg.main.name: File Size==(nfft/2)+1 when using /1D" mySize eq expectedSize

return

!******************************************************************************!
! Test and verify fft /dbf, /log, and /mag switches
!******************************************************************************!
procedure test_dbf_log_mag
  if ^{env.NMROOT} EQS "classpath:" then
    res fm_file "fm_capture_t1000_ram.tmp{AUX=RAM}"
    file copy "^{datDir}.fm_capture_t1000.prm" fm_file
    file unprotect fm_file
  else
    res fm_file "^{datDir}.fm_capture_t1000.prm"
  endif

  res fm_dbf_fft "^{prefix}dbf_fm.tmp"
  res fm_log_fft "^{prefix}log_fm.tmp"
  res fm_mag_fft "^{prefix}mag_fm.tmp"

  res fm_plain_fft "^{prefix}plain_fm.tmp" ! only used for calculating expected output
  res exp_dbf_fft  "^{prefix}dbf_exp.tmp"
  res exp_log_fft  "^{prefix}log_exp.tmp"
  res exp_mag_fft  "^{prefix}mag_exp.tmp"

  fft/dbf in1=fm_file out1=fm_dbf_fft
  fft/log in1=fm_file out1=fm_log_fft
  fft/mag in1=fm_file out1=fm_mag_fft

  ! Get the expected output using FCALC
  fft in1=fm_file out1=fm_plain_fft
  fcalc ^exp_dbf_fft ^fm_plain_fft DB
  fcalc ^exp_log_fft ^fm_plain_fft LOG/B 10 *   ! FFT/LOG is 20LOG (i.e. 10 * 10LOG)
  fcalc ^exp_mag_fft ^fm_plain_fft MAG2

  res z:dbfInTol false
  if/TOL=1 fm_dbf_fft FEQ/D/T exp_dbf_fft then
    res z:dbfInTol true
  endif
  assert/text="^reg.main.name: FFT/DBF data within 1%" dbfInTol ISTRUE
  assert/text="^reg.main.name: FFT/LOG data EQ" fm_log_fft FEQ/D/T exp_log_fft
  assert/text="^reg.main.name: FFT/MAG data EQ" fm_mag_fft FEQ/D/T exp_mag_fft
return

!******************************************************************************!
! Test and verify fft cross
!******************************************************************************!
procedure test_cross
  res sine_plain_fft  "^{prefix}plain_sine.tmp"
  res cos_plain_fft   "^{prefix}plain_cos.tmp"
  res cross_plain_fft "^{prefix}plain_cross.tmp"
  res exp_cross       "^{prefix}cross_exp.tmp"

  waveform out=sine_wave shape=sine form=cf freq=2 delta=1/100
  waveform out=cos_wave shape=cos form=cf freq=5 delta=1/100

  fft in1=sine_wave in2=cos_wave out1=sine_plain_fft &
      out2=cos_plain_fft cross=cross_plain_fft

  ! Get the expected <cross> using FCALC
  fcalc exp_cross sine_plain_fft cos_plain_fft ~*
  assert/text="^reg.main.name: FFT Cross Spectral Density data EQ" cross_plain_fft FEQ/D/T exp_cross

  erase sine_wave cos_wave
return
