\\ GAPEQ.SEQ  Gaplength equalization     jm  93-10-16 18:07

Run from F&SFLT2, which includes sfloat, & many necessary utilities jm
94-09-29 16:07

 To make turnkey program called GapEq.exe:
Copy this file to tgapeq.seq. Change the value of NotTurnkey (just below)
in that file to false.
At DOS prompt, type
fforgap - fload tgapeq.seq  ' GLCalc is default  turnkey  gapeq   <rtn>

{
true  value NotTurnkey

NotTurnkey #if
               anew gaplen
           #then
floats
y-m-d                  \ date format
}

"Closing" is used with Forth, to give instrucions on "where to go from end of
Intro or end or GLCalc." (When Intro runs within GLCalc, the "Closing"
screen is immediately erased by the continuing program).
   But in turnkey, Closing becomes "bye", to return to DOS

{

NotTurnkey
#if
: Closing    ( --- )
\unless   staton
      dark
      8 0 do cr loop
      ."                      You are now in Forth."
cr cr ."    Press    F1-key           to get help with F-PC Forth,"
   cr ."    type     intro <rtn>      to see the information screen again,"
   cr ."    type    glcalc <rtn>      to run the calculation program again,"
   cr ."  or type      bye <rtn>      to quit back to DOS." cr cr
;

#else
: Closing
   dark  bye ;
#then

}

{
: (intro)
\unless  statoff
dark
." GAPLOSS & EQUALIZATION DESIGN PROGRAM FOR AUDIO MAGNETIC TAPE "
." REPRODUCERS" cr

." John G. (Jay) McKnight, Magnetic Reference Laboratory, 229 Polaris Av, "
cr
." Suite 4, Mountain View, CA 95014, USA. Phone 1650 965 8187, FAX 1650 965 "
." 8548."  cr
." email mrltapes@flash.net    www.flash.net/~mrltapes    94-03-30, 98-08-18"
cr
."   This program calculates the gap loss from a magnetic tape reproducing"
cr
." head, helps you design a 2-pole low-pass filter that will compensate" cr
." that gap loss, and makes a table of the results. It implements the"   cr
." formulas in the author's paper: 'Gap-length Response In Magnetic"    cr
." Reproducers: Calculation, Measurement, and Compensation', Journal of" cr
." the Audio Engineering Society, Vol  Nr   pp (    -  ), in preparation."
cr
."   Inputs: tape speed in millimeters per second, [mm/s], and mechanical"
cr
." (optical) gaplength in micrometers, [um]. Computes and displays the gap"
cr
." null frequency, suggests a filter resonance frequency, asks you to input"
cr
." that (or another) resonance frequency. Asks you for the maximum positive"
cr
." deviation from flat response that you want in the design bandwidth"  cr
." (which is automatically chosen according to the gap null frequency.)" cr
." Computes the Q for the low-pass filter such that the positive deviation"
cr
." equals the value input. Displays the results, including the values you"
cr
." input, the filter test parameters, and a table of frequencies, with the"
cr
." gap response level, the equalizer response level, and the error level."
cr
." Then asks whether you want to print those results (default: no); and" cr
." whether you want to input new values and recompute (default), or quit." cr
."   To give you a feel for the program, each of the inputs starts with a"
cr
." default value. Just <rtn> on each for a demonstration."

cr ."                      Press any key to continue."
key  drop
;

NotTurnkey
#if
   : intro (intro) Closing ;
#else
   : intro (intro) ;
   #then
}

Input tape speed [mm/s].
{
fvariable tapespeed
190.5 tapespeed f!     \ default

: EnterTapespeed
   cr ." Enter the tape speed in mm/s (default "
   Tapespeed  f@ 1 5 f.r ."  mm/s)  "
   f#in  fdup  f0>   \ ignore if negative or f0.0 (no entry)
   if
      Tapespeed f!
   else
      fdrop
   then  ;
}

Input the gap length [um].
{
fvariable gaplength
5.00  gaplength f!     \ default

: EnterGaplength
   cr ." Enter the gaplength in um (default "
   Gaplength  f@ 2 5 f.r ."  um)  "
   f#in  fdup  f0>   \ ignore if negative or f0.0 (no entry)
     if
        Gaplength f!
     else
        fdrop
     then  ;
}



Calculate & Store the Null Freq
{
fvariable NullFreq

: CalcNullFreq  ( F: --- r )
     Tapespeed f@ GapLength f@ f/ 0.00114 f/ NullFreq f!  ;
}

Input the equalizer resonance frequency [Hz].
{
fvariable ResonanceFreq
25000.0 ResonanceFreq f!     \ default

: EnterResonanceFreq
   cr ." Resonance Freq should be LESS THAN the Null Freq of "
            NullFreq f@  fdup 0 7 f.r ."  Hz"
   cr ."   Optimum Resonance Frequency is about "
            0.75 f*  0 8 f.r  ."  Hz"
   cr ." Enter the Resonance Frequency (default "
            ResonanceFreq  f@ 0 7 f.r ."  Hz)  "
   f#in  fdup  f0>   \ ignore if negative or f0.0 (no entry)
   if
      ResonanceFreq f!
   else
      fdrop
   then
   ResonanceFreq f@ NullFreq f@ f>   if  cr cr
   ." WARNING: You have entered a resonance frequency greater than the null "
cr ." frequency. This is allowable, but you will see that the resulting "
cr ." equalization is not a good fit to the gaploss response."
   key drop
   then  ;
}

Input the maximum level error, in dB.
This is converted to the "ripple", which is the  maximum response error ratio
(example: 0.1 dB level error becomes ripple of 1.0116)
{
fvariable ripple
1.0116 ripple f!     \ default, corresp to 0.1 dB

fvariable LevelError
0.10 LevelError f!      \ default

: EnterLevelError
   cr ." Enter the maximum level error in dB (default "
   LevelError f@ 2 4 f.r ."  dB)  "
   f#in  fdup f0>  \ ignore if negative or f0.0, which "no entry" leaves
      if
         fdup
         20.0 f/ falog ripple f!   \ convert to ratio & store
         LevelError f!
      else
         fdrop
      then  ;
}

Table of 21 1/3rd & 1/6th octave Preferred Frequencies
    21 is the max number of lines on the screen after heading is printed.
{
defer Freqs

create FreqsHi
 1000 ,  1250 ,  1600 ,  2000 ,  2500 ,  3150 ,  4000 ,  5000 ,  6300 ,
 7000 ,  8000 ,  9000 , 10000 , 11000 , 12500 ,
14000 , 16000 , 18000 , 20000 , 22400 , 25000 ,

create FreqsMed
  500 ,   630 ,   800 ,  1000 ,  1250 ,  1600 ,  2000 ,  2500 ,  3150 ,
 3500 ,  4000 ,  4500 ,  5000 ,  5500 ,  6300 ,
 7000 ,  8000 ,  9000 , 10000 , 11000 , 12500 ,

create FreqsLo
  250 ,   315 ,   400 ,   500 ,   630 ,   800 ,  1000 ,  1250 ,  1600 ,
 1800 ,  2000 ,  2240 ,  2500 ,  2800 ,  3150 ,
 3500 ,  4000 ,  4500 ,  5000 ,  5500 ,  6300 ,
}

Auto-range frequency table according to the calculated NullFreq:
if > 12.5 kHz, FreqsHi; if < 6.3 kHz, FreqsLo; if between, FreqsMid
{
: SetFreqTable  ( --- )
   NullFreq f@ 12500.0 f> if
                           ['] FreqsHi is Freqs
                          else
                            NullFreq f@ 6300.0 f< if
                                                    ['] FreqsLo is Freqs
                                                  else
                                                    ['] FreqsMed is Freqs
                                                  then
                        then  ;

}

{
: GetParameters  ( --- )
   fclear
   dark
."  GAPLOSS EQUALIZATION DESIGN PROGRAM FOR AUDIO MAGNETIC TAPE REPRODUCERS"
cr cr
."    The first time you run this program, some default values are provided"
cr  ." so you can see how the program works, if you would like." cr cr
."    When you put your own values in, they become the default values for"
cr ." the following run. So just press <rtn> to use the displayed (previous)"
cr ." value, and type in a new value <rtn> to try a different value."
cr  cr
   EnterTapeSpeed cr
   EnterGapLength cr
   CalcNullFreq
   SetFreqTable
   EnterResonanceFreq  cr
   EnterLevelError cr
   ;
}

{
: GetFreq    2 * Freqs + @ ifloat ;
}

Calculate x =
 freq [Hz] * gaplength [um] * 0.001 [mm/um] / (tapespeed [mm/s]
{
: Calcx  ( F: freq --- x )
   0.001 f*   Gaplength f@ f*   Tapespeed f@ f/ ;
}


Calculate the gap response function. If x < 0.68, use sinc 1.11 pi x, else
use S2(x).
{
: CalcGapResp ( F:  freq --- GR(x)
   calcx fdup 0.68 f<
      if    1.11 f* sinc_pi_x
      else  S2(x)
      then
   ;
 }

{
fvariable Q
0.7 Q f!    \ default
}

{
: CalcEqResp    ( F: freq --- resp )
   ResonanceFreq f@ f/
   fsqr  fdup
   Q f@ fsqr 1/f 2.0  f-  f*
   fswap   fsqr
   f+  f1.0 f+
   fsqrt 1/f  ;
}

For each set of parameters, calculate the response at audio frequencies from
1000 Hz to 20.0 kHz (steps 0 to 19 ). Initialize maxresp at 0.0 . At each
frequency, savemax stores the greater of that response and maxresp to
maxresp.

{
fvariable maxresp

: savemax    ( F: r --- )
   maxresp f@  fmax
   maxresp  f! ;

: CalcMaxResponse   \ calc response vs freq, & save max error
      F0.0 maxresp f!    \  reset each pass
      19 0 do
         i GetFreq fdup
         CalcGapResp
         fswap  CalcEqResp f*
         savemax
      loop  ;
}

{
: IncreaseQ10%
   Q f@
   1.10 f*
   Q f! ;

: DecreaseQOneRipple
   Q f@
   ripple f@  f/ Q f! ;

: IncreaseQOneHalfRipple
   Q f@
   ripple f@  fsqrt  f* Q f! ;
}

{
: CalculateQ   ( --- )
   cr  ."                   ******  Calculating  ****** "

   0.707 Q f!    \ starting point: Max Q for which max response is 0.0 dB
   begin
      CalcMaxResponse
      maxresp f@  ripple f@ f<                    \  maxresp < ripple
      Q f@ 20.0 f< dup
      not if cr cr
         ."                Stopped at Q = 20. Press any key" key drop then
     and                       \  maxripple < ripple and Q < 20 : try again
    while
      IncreaseQ10%
   repeat

   begin
      CalcMaxResponse
      maxresp f@  ripple f@ f>                    \  maxresp > ripple
    while
      DecreaseQOneRipple
   repeat

    IncreaseQOneHalfRipple       \ final Q value
    CalcMaxResponse              \ using final Q value
;
}


{
: ListFilterTestParams    ( --- )
50 12 at  ."    Filter test parameters:"
50 14 at  ." Resp at Max Resp ="
      Q f@ fsqr  2.0 f* fdup      \ 2Q**2  2Q**2
      2.0 f* f1.0 f- fsqrt       \ 2Q**2  sqrt(4Q**2 - 1)
      f/  VRatio>Level  2 9 f.r ."  dB"
50 13 at   ." Freq of Max Resp ="
      Q f@ fsqr 2.0 f* 1/f    \  1/(2 Q**2)
      f1.0  f\-  fsqrt        \ sqrt(1- 1/(2 Q**2)
      ResonanceFreq f@ f*  0 7 f.r ."  Hz"
   ;

: ListParameters
50 5 at   ."    Tape Speed =" TapeSpeed f@   1 8 f.r  ."  mm/s"
50 6 at   ."    Gap Length =" GapLength f@  2 9  f.r   ."  um"
50 7 at   ."     Null Freq =" NullFreq f@  0 7 f.r  ."  Hz"
50 8  at  ." ResonanceFreq =" ResonanceFreq f@  0 7 f.r  ."  Hz"
50 9  at  ."            Q =" Q f@ fdup  3 6 f.r
                                 ."  (" VRatio>Level 2 5 f.r ."  dB)"
50 10 at  ."    Max +error =" maxresp  f@ VRatio>Level   2 9 f.r  ."  dB "
  ListFilterTestParams   cr
  ;

true value FirstTime

: ListResp
      dark
      true =: FirstTime         \ set flag to true before calculation
." CALCULATION OF GAP LOSS, EQUALIZER RESPONSE, AND DEVIATION FROM FLATNESS"
cr ."     Program by J. McKnight, Magnetic Reference Lab, Mountain View, CA"
 cr
      ." Freq/[Hz]  GL Resp/[dB]  EQ Resp/[dB]  Error/[dB]"
      21 0 do
         cr
         i GetFreq fdup
         NullFreq f@  f>  FirstTime and
         if                                 \ above first null, first time
            false =: FirstTime
            NullFreq f@ 0 7 f.r           \ show null freq & warning
 ."  ------ Frequency of First Null ------- "    cr
         then
         fdup  0 7 f.r                   \ freq
         fdup CalcGapResp   fabs         \ freq  GapResp
         fdup  VRatio>Level 2 12 f.r          \ freq      GapResp
         fswap  CalcEqResp               \ GapResp   eqresp
         fdup  VRatio>Level 2 12 f.r          \  "          "
         f*                              \ error
\            fdup ripple f@ 1/f f< if ( fdrop leave ) ."  " then
         VRatio>Level 2 12 f.r
      loop  ."   "  ;

: GLCalc
  \unless  statoff
  intro
  begin
   GetParameters
   CalculateQ
   ListResp
   ListParameters

52 17 at         ." Print results? " Y/N(N)
     if
        ?printer.ready
        52 17 at ."                             "
        50 18 at ." Printed  " .date ."   " .time

        if
            PrintScreen
            printing on
            FirstTime if cr then
            7 0 do  cr  loop
            printing off
         else
         50 18 at ." Printer not ready. Cancelled. "
         then
     then

 54 20 at ." Do Another?  "  Y/N(Y)
  not until
  closing
   ;
}