!
!  Purpose: Test the THIN command
!   Author: Jay Hallam / Neon Ngo
!------------------------------------------------------------------------------
startmacro S:func[""]
  switch INTERACTIVE interAct GET DEF=TRUE  SDEF=TRUE
  switch BASELINE    baseline GET DEF=FALSE SDEF=TRUE

  call setDatDir

  set testFile "testfile_thin"
  set nelsOrig 4k
  waveform out=testFile ELEM=nelsOrig

if func NEQS "" then
  call ^{func}
else
  call copy
  call useAbsolute
  if (reg.main.M.logger NREXISTS) then
    call useAbscissa                    ! This test should not be run if logging is on - updated in 3.7.1
  endif
  call copyEveryOther
  call upSample
  call checkStride
  call checkElemSize
  call thinFrames
  call addressing
endif

  erase testFile
endmacro

!******************************************************************************!
procedure processMessage m:msg
  if msg.name eqs "TIMER" then
    calc counter counter 1 +
    if counter eq 1 then
      call updateThin
    else
      set curFInc reg.thinned.finc
      set curInc  reg.thinned.inc
      assert/text="^reg.main.name: On-The-Fly Thinning changes" curFinc eq 2 AND curInc eq 3
      pipe stop
    endif

  elseif msg.name eqs "TEXT" then
    say "test_thin TEXT msg.data ^{msg.data}"
    ! test for BUG 2422
    archive off
    ! test for BUG 2421
    assert/text="^reg.main.name: Got expected warning msg for tilde behavior change." expMessageText SUBS msg.data
  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

!******************************************************************************!
procedure copy
  !  test copy capability
  result tempFile "temp_thin"
  thin testFile tempFile
  status tempFile size=nels
  assert/text="^reg.main.name: Copy from one file to another" &
         testfile FEQ tempfile
  if tempFile FEXISTS erase tempFile
return

!******************************************************************************!
procedure useAbsolute
  !  test use of ABSOLUTE indexing
  result tempFile "temp_thin"
  thin testFile tempFile 0 3
  status tempFile size=nels
  assert/text="^reg.main.name: Use ABSOLUTE indexing" &
         nels EQ 3 AND &
         FILE(testfile).data(0) EQ FILE(tempfile).data(0) AND &
         FILE(testfile).data(1) EQ FILE(tempfile).data(1) AND &
         FILE(testfile).data(2) EQ FILE(tempfile).data(2)

  if tempFile FEXISTS erase tempFile
return

!******************************************************************************!
procedure useAbscissa
  !  test use of ABSCISSA indexing
  result tempFile "temp_thin.tmp"
  result tempOut  "temp_thin2.tmp"
  thin testFile tempFile ~1 +20
  status tempFile size=nels xstart=xs
  assert/text="^reg.main.name: Use ABSCISSA indexing" nels EQ 20 AND xs EQ 1

  ! test BUG 2421 Time-based thin using the tilde "~" broken/behavior changed (print warning)
  waveform  tempFile FORM="CI" ELEM=100K DELTA=4.096e-5
  headermod tempFile timecode=2011:06:17::15:51:25.123456789012
  keyword/scope=main tempFile "PUT" "TC_PREC" -2.91550E-07

  info "!!!!! It is ok to see warning about behavior change for abscissa addressing using tilde. !!!!!"
  set expMessageText "WARN: Behavior change since 2.9.1 for abscissa addressing using tilde"
  archive TO MAIN
  thin tempFile tempOut ~1.9394778864401019e9 ~1.939477888564779e9

  erase/warn=N tempFile tempOut
return

!******************************************************************************!
procedure copyEveryOther
  status testfile xdelta=xd
  result tempFile "temp_thin"

  ! Thin 20 secs, every other sample
  set start 1
  set end 21
  thin testFile tempFile ~start ~end 2

  calc nelsExpected end start - xd / 2 /
  status tempFile size=nels xstart=xs

  ! Loop through the elements of the output file and every other elements of the input file
  calc L:iOffset start xd /  ! Started at this element of the input file
  set allGood "TRUE"
  do i 0 nelsExpected-1
    calc L:outIndex i
    calc L:inIndex outIndex 2 * iOffset +
    if FILE(tempfile).data(outIndex) NEQ FILE(testfile).data(inIndex) then
      set allGood "FALSE"
      break
    endif
  enddo
  assert/text="^reg.main.name: ABSCISSA; copy every other element" &
         nels EQ nelsExpected AND xs EQ start AND allGood isTRUE
  erase/warn=n tempFile
return

!******************************************************************************!
procedure upSample
  ! Upsample infile by 8 by inserting 7 zeros between each value.
  set infile "temp_thin_upsample"
  set infile "temp_thin_upsample_out"
  set nelsIn 10
  file open/n/d tag infile
    do i 1 nelsIn
      set tag.data(i-) i
    enddo
  file close tag
  stat infile size=sizeIn
  set upinc 2
  thin infile outfile inc=-upInc
  stat outfile size=sizeOut
  calc expectedSize sizeIn*upInc
  if sizeOut EQ expectedSize then
    set allGood "TRUE"
    do i 0 sizeIn-1
      calc iOut i upInc *
      if FILE(infile).data(i) NEQ FILE(outfile).data(iout)
        set allGood "FALSE"
        break
      endif
    enddo
    assert/text="^reg.main.name: UPSAMPLE"/stat=tempStat sizeOut EQ expectedSize AND &
                                                         allGood isTRUE
  else
    assert/text="^reg.main.name: UPSAMPLE" sizeOut EQ expectedSize
  endif
  erase/warn=n infile outfile
return

!******************************************************************************!
! Test for BUG 1013, where starting from odd offset (1)  with no END offset,
! leaves off the last element
procedure checkStride
  result l:numElements 10
  result l:start       1
  result l:increment   2
  result inFile  "temp_thin_stride_in"
  result outFile "temp_thin_stride_out"

  ! create input file for THIN stride tests
  waveform OUT=inFile FORM=SB ELEM=numElements START=0 UNITS=1 AMP=10

  ! This should have values 1,2,3,4,5,6,7,8,9
  thin IN=inFile OUT=^{outFile}1 START=1 INC=1
  assert/text="^reg.main.name: START 1, STRIDE 1" FILE(^{outFile}1).getSize EQ 9

  ! This should have values 1,3,5,7,9
  thin IN=inFile OUT=^{outFile}2 START=1 INC=2
  assert/text="^reg.main.name: START 1, STRIDE 2" FILE(^{outFile}2).getSize EQ 5

  ! This should have values 1,4,7
  thin IN=inFile OUT=^{outFile}3 START=1 INC=3
  assert/text="^reg.main.name: START 1, STRIDE 3" FILE(^{outFile}3).getSize EQ 3

  ! This should have values 2,5,8
  thin IN=inFile OUT=^{outFile}4 START=2 INC=3
  assert/text="^reg.main.name: START 2, STRIDE 3" FILE(^{outFile}4).getSize EQ 3

  ! This should have values 2,4,6,8
  thin IN=inFile OUT=^{outFile}5 START=2 INC=2
  assert/text="^reg.main.name: START 2, STRIDE 2" FILE(^{outFile}5).getSize EQ 4

  ! This should have values 2,3,4,5,6,7,8,9
  thin IN=inFile OUT=^{outFile}6 START=2 INC=1
  assert/text="^reg.main.name: START 2, STRIDE 1" FILE(^{outFile}6).getSize EQ 8

  ! test size and contents
  thin inFile outFile start ,, increment

  status outFile size=size
  ! for 10 elements, this should be 5
  calc expectedSize numElements start - increment / .1 + ROUND

  set allGood "TRUE"
  do i 0 size-1
    calc L:inIndex i increment * start +
    if FILE(outfile).data(i) NEQ FILE(inFile).data(inIndex) then
      set allGood "FALSE"
      ! say "bad result at i = ^i  inIndex=^inIndex"
      break
    endif
  enddo

  assert/text="^reg.main.name: copy every other element starting from 1 till END" &
    expectedSize EQ size AND allGood isTRUE

  ! cleanup
  erase/warn=n inFile
  files/e ^{outFile}*
return

!******************************************************************************!
!  Test for BUG 1995: Thin adding elements
!
procedure checkElemSize

  ! apenny only has 128 elements, so the output should have 128...
  thin ^{datDir}.apenny.prm apen 0 200 1
  status ^{datDir}.apenny.prm size=size
  status apen   size=nels
  assert/text="^reg.main.name: Attempt to make output file larger than the input" &
     size eq nels

  erase/quiet/warn=n apen
return

!******************************************************************************!
!  Test for BUG 2280: Thin whole frames
procedure thinFrames

  set format sf
  set sr 1e4
  set over 0
  set sfreq sr/10
  set amp 1e4
  set counter 0

  pipe on
    waveform/id=wave/throttle=real _wave format 10e10 cos freq=sfreq amp=amp delta=1/sr
    fft/dbf _wave _waveb{form=sf} nfft=1k over=over
    thin/id=thinned _waveb _thinned fstart=95 fend=115 finc=1

    set curFInc reg.thinned.finc
    set curInc  reg.thinned.inc
    set this.timer(0) .5
  pipe off

return

!******************************************************************************!
procedure updateThin

  set reg.thinned.finc 2
  set reg.thinned.inc 3

return

!******************************************************************************!
! Test case for BUG 2195 THIN: issue with abscissa addressing
! by testing new /addressing=index,abscissa,timecode switch
procedure addressing
  timex day beginningOfToday soy=soy
  set  numSecs   130.0
  set  abscStart 50
  calc tcStart beginningOfToday abscStart +
  calc tcEnd   tcStart          numSecs   +
  result tempFile "ram:temp_thin"

  ! #1 test (absolute) INDEX addressing
  thin/addressing="INDEX" testFile{xu=time,timecode=^beginningOfToday} tempFile 35 100
  status tempFile size=nels1 xstart=xs1
  assert/text="^reg.main.name: INDEX addressing - output size (^nels1)" nels1 EQ 65
  assert/text="^reg.main.name: INDEX addressing - output xstart (^xs1)"   xs1 EQ 35
  erase/warn=n tempFile

  ! #2 test abscissa only addressing, the timecode SHOULD NOT be used
  thin/addressing="ABSCISSA" testFile{xu=time,timecode=^beginningOfToday} tempFile 25.0 125.0
  status tempFile size=nels2 xstart=xs2
  assert/text="^reg.main.name: ABSCISSA only addressing - output size (^nels2)" nels2 EQ 100
  assert/text="^reg.main.name: ABSCISSA only addressing - output xstart (^xs2)"   xs2 EQ 25.0
  erase/warn=n tempFile

  ! #3a test TIMECODE addressing (with timecode set)
  thin/addressing="TIMECODE" testFile{xu=none,timecode=^beginningOfToday} tempFile tcStart tcEnd
  status tempFile size=nels3a xstart=xs3a
  assert/text="^reg.main.name: TIMECODE addressing #1 - output size (^nels3a)" nels3a EQ numSecs
  assert/text="^reg.main.name: TIMECODE addressing #1 - output xstart (^xs3a)"   xs3a EQ abscStart
  erase/warn=n tempFile

  ! #3b test TIMECODE addressing (without timecode set)
  thin/addressing="TIMECODE" testFile{xu=none} tempFile 11.0 31.0
  status tempFile size=nels3b xstart=xs3b
  assert/text="^reg.main.name: TIMECODE addressing #2 - output size (^nels3b)" nels3b EQ 20
  assert/text="^reg.main.name: TIMECODE addressing #2 - output xstart (^xs3b)"   xs3b EQ 11.0
  erase/warn=n tempFile

  ! #4a test AUTO addressing; this should be like ABSCISSA mode (since abscissa units is not time)
  thin/addressing="ABSCISSA_AUTO" testFile{xu=none,timecode=^beginningOfToday} tempFile 12.0 42.0
  status tempFile size=nels4a xstart=xs4a
  assert/text="^reg.main.name: AUTO addressing (ABSCISSA) - output size (^nels4a)" nels4a EQ 30
  assert/text="^reg.main.name: AUTO addressing (ABSCISSA) - output xstart (^xs4a)"   xs4a EQ 12.0
  erase/warn=n tempFile

  ! #4b test AUTO addressing; this should be like TIMECODE addressing (since units is TIME)
  thin/addressing="ABSCISSA_AUTO" testFile{xu=time,timecode=^beginningOfToday} tempFile tcStart tcEnd
  status tempFile size=nels4b xstart=xs4b
  assert/text="^reg.main.name: AUTO addressing (TIMECODE #1) - output size (^nels4b)" nels4b EQ numSecs
  assert/text="^reg.main.name: AUTO addressing (TIMEOCDE #1) - output xstart (^xs4b)"   xs4b EQ abscStart
  erase/warn=n tempFile

  ! next two results are for testing timecodes less than 100e6 (~3 years, 3 months, 3 days, 9+ hours)
  calc smallTcStart soy          abscStart +
  calc smallTcEnd   smallTcStart numSecs   +

  ! #4c test AUTO addressing; this should be like TIMECODE addressing (since units is TIME)
  thin/addressing="ABSCISSA_AUTO" testFile{xu=time,timecode=^soy} tempFile smallTcStart smallTcEnd
  status tempFile size=nels4c xstart=xs4c
  assert/text="^reg.main.name: AUTO addressing (TIMECODE #2) - output size (^nels4c)" nels4c EQ numSecs
  assert/text="^reg.main.name: AUTO addressing (TIMEOCDE #2) - output xstart (^xs4c)"   xs4c EQ abscStart
  erase/warn=n tempFile

  ! test deprecated legacy abscissa addressing
  info "It is ok to see several DEPRECATE messages for DataFile.getIndex() below..."

  ! #5a test LEGACY addressing; this should be like ABSCISSA mode (since abscissa units is not time)
  thin/addressing="ABSCISSA_LEGACY" testFile{xu=none,timecode=^beginningOfToday} tempFile 13.0 53.0
  status tempFile size=nels5a xstart=xs5a
  assert/text="^reg.main.name: LEGACY addressing (ABSCISSA) - output size (^nels5a)" nels5a EQ 40
  assert/text="^reg.main.name: LEGACY addressing (ABSCISSA) - output xstart (^xs5a)"   xs5a EQ 13.0
  erase/warn=n tempFile

  ! #5b test LEGACY addressing; this should be like TIMECODE addressing (since units is TIME and tcStart > 100e6)
  thin/addressing="ABSCISSA_LEGACY" testFile{xu=time,timecode=^beginningOfToday} tempFile tcStart tcEnd
  status tempFile size=nels5b xstart=xs5b
  assert/text="^reg.main.name: LEGACY addressing (TIMECODE #1) - output size (^nels5b)" nels5b EQ numSecs
  assert/text="^reg.main.name: LEGACY addressing (TIMEOCDE #1) - output xstart (^xs5b)"   xs5b EQ abscStart
  erase/warn=n tempFile

  ! #5c test LEGACY addressing; this should be like ABSCISSA addressing (since tcStart and tcEnd <= 100e6, even though units is time)
  ! NTN: this example shows that LEGACY addressing mode is just bogus! and should be removed once we get rid of it
  thin/addressing="ABSCISSA_LEGACY" testFile{xu=time,timecode=^soy} tempFile 14.0 47.0
  status tempFile size=nels5c xstart=xs5c
  assert/text="^reg.main.name: LEGACY addressing (ABSCISSA #2) - output size (^nels5c)" nels5c EQ 33
  assert/text="^reg.main.name: LEGACY addressing (ABSCISSA #2) - output xstart (^xs5c)"   xs5c EQ 14.0
  erase/warn=n tempFile

return
