' Date: Mon, 29 Aug 94 10:50:19 EDT
' From: "Dan Schaaf" <D.Schaaf@zds.com>
' Subject: Corrected TX16w Filter program

' program for ibm-pc's to read Yamaha filter files and display
' impulse response and frequncy response.
' Uses fft from cooley, lewis and welch via loy

' corrected 8/29/94 for mirror image of impulse about first parameter
' added sweep of filter valiables
' added level data in first 4 bits of filter data


ON ERROR GOTO 30000

CONST pi = 3.14159
  
  points% = 256
  ringer% = 512 * 3 / points% / 2   'graphic scale correction

  SCREEN 12
bing:  CLS
10
  FILES "*.t??"
11
  WINDOW SCREEN (1, 1)-(480, 640)
green:
  PRINT
  IF goofy$ <> "" THEN PRINT "Enter no name to re-uses "; goofy$; " or"
  INPUT "Enter full name of new filter file: ", g$
  IF g$ = "" GOTO glee
  goofy$ = UCASE$(g$)
  CLOSE #1
20
  FILES goofy$
21
  OPEN goofy$ FOR RANDOM ACCESS READ AS #1 LEN = 1

  FIELD 1, 1 AS a$

  GET #1: b$ = a$: GET #1: b$ = b$ + a$
  IF b$ <> "LM" THEN PRINT : PRINT goofy$; "     >>>>>> Not Yamaha file  <<<<<<<": PRINT : GOTO green

  column$ = ""
   FOR l% = &HFF1 TO &HFF9
    GET 1, l%
    IF a$ <> " " THEN column$ = column$ + UCASE$(a$)
   NEXT l%

  Row$ = ""
   FOR l% = &HFE1 TO &HFE9
    GET 1, l%
    IF a$ <> " " THEN Row$ = Row$ + UCASE$(a$)
   NEXT l%


glee:
 CLS : colour% = 2
 GOSUB grid
gree:

 LOCATE 1, 1
 PRINT : PRINT
 LOCATE 1, 1

 PRINT "Enter "; Row$; "(1-11) of "; goofy$; " (0 for "; Row$; "sweep):";
 INPUT " ", b%: b% = b% - 1
 IF b% > 10 THEN GOTO gree

 PRINT "Enter "; column$; "(1 - 11) of "; goofy$; " (0 for "; column$; "sweep):";
 INPUT " ", co%: co% = co% - 1

 IF co% < 0 AND b% < 0 THEN GOTO bing
 
 IF co% > 10 GOTO gree

 IF b% >= 0 AND co% >= 0 THEN GOSUB big.bag: GOTO gree

 IF co% < 0 THEN
  FOR co% = 0 TO 10
   GOSUB big.bag
  NEXT co%
  GOTO gree
 END IF

 IF b% < 0 THEN
  PRINT Row$; " sweep"
  FOR b% = 0 TO 10
   GOSUB big.bag
  NEXT b%
 
  GOTO gree
 END IF

 GOTO gree

big.bag:
   info% = b% + co% * 11
   REDIM af8(256, 2)
   GOSUB get.data
   GOSUB fft
   GOSUB plot
   colour% = (colour% AND &HF) + 1: IF colour% = 8 THEN colour% = 9
RETURN

fft:

jF8% = 1

 FOR iF8% = 1 TO points% - 1

  IF iF8% < jF8% THEN
    SWAP af8(jF8%, 1), af8(iF8%, 1): SWAP af8(jF8%, 2), af8(iF8%, 2)
  END IF

  Kf8% = points% \ 2' 128

fink:
  IF Kf8% < jF8% THEN jF8% = jF8% - Kf8%: Kf8% = Kf8% \ 2: GOTO fink

  jF8% = jF8% + Kf8%

 NEXT iF8%

 FOR Lf8% = 1 TO 8
  lef8% = 2 ^ Lf8%
  leIf8% = lef8% \ 2
  U1f8 = 1
  u2F8 = 0
  W1f8 = COS(pi / leIf8%)
  w2F8 = SIN(pi / leIf8%)

 FOR jF8% = 1 TO leIf8%
   FOR iF8% = jF8% TO points% STEP lef8%
   
    iPf8% = iF8% + leIf8%
    temp1 = af8(iPf8%, 1) * U1f8: temp1 = temp1 - af8(iPf8%, 2) * u2F8
    temp2 = af8(iPf8%, 1) * u2F8: temp2 = temp2 + af8(iPf8%, 2) * U1f8

    af8(iPf8%, 1) = af8(iF8%, 1) - temp1
    af8(iPf8%, 2) = af8(iF8%, 2) - temp2
    af8(iF8%, 1) = af8(iF8%, 1) + temp1
    af8(iF8%, 2) = af8(iF8%, 2) + temp2


   NEXT iF8%
  
   temp9 = U1f8
   U1f8 = U1f8 * W1f8: U1f8 = U1f8 - u2F8 * w2F8
   temp0 = u2F8
   u2F8 = temp9 * w2F8
   u2F8 = u2F8 + temp0 * W1f8

 NEXT jF8%
 NEXT Lf8%

RETURN

get.data:
 show.y% = 140
  LINE (1, show.y%)-(1, show.y%)
l% = 0: Level% = 0
 GET #1, 16 + 32 * info%

 WHILE NOT EOF(1)
   l% = l% + 1:  IF l% > 16 THEN GOTO bail
 
  GET #1
   b$ = a$
  GET #1
   b$ = a$ + b$

  LOCATE 1, 1: PRINT l%


  k% = CVI(b$)
  IF l% = 1 THEN Level% = k% \ &H1000': LOCATE 16: PRINT Level%
  k% = k% AND &HFFF
  IF k% AND &H800 THEN k% = k% OR &HF000

 
  af8(15 + l%, 1) = 2 * k%
  af8(17 - l%, 1) = 2 * k%
 
  LINE -(l% * 6, show.y% + k% \ 16), colour%

 WEND
bail:
 LOCATE 1, 1: PRINT "Doing:"; info% + 1; "                               "
 PRINT "                                          "
 PRINT goofy$; " Impulse Response of";
 PRINT 1 + (info% MOD 11); Row$;
 PRINT co% + 1; column$
RETURN

plot:

 LOCATE 14: PRINT "Frequency Response:"

 LINE (12, 600 - 230)-(12, 600 - 230)

 FOR l% = 1 TO points% \ 2
  master = SQR(af8(l%, 1) * af8(l%, 1) + af8(l%, 2) * af8(l%, 2))
  LINE -(l% * ringer% + 10, 600 - LOG(master + .001) * 30 + 20 * Level%), colour%
 NEXT l%

RETURN

grid:

 muck% = 0
 LINE (12, 600 - 230)-(12, 600 - 230)
 FOR l% = 1 TO points% \ 2 + 1 STEP 16
  IF muck% = 7 THEN muck% = 8 ELSE muck% = 7
  LINE (10 + ringer% * l%, 600)-(10 + ringer% * l%, 310), muck%, , &HFEFF
 NEXT l%

 muck% = 0
 LINE (12, 600 - 230)-(12, 600 - 230)
 FOR l% = 0 TO 261 STEP 30
  IF muck% = 7 THEN muck% = 8 ELSE muck% = 7
  LINE (12, 350 + l%)-(400, 350 + l%), muck%, , &HEFEF
 NEXT l%

 RETURN' grid

30000
IF ERL = 20 THEN PRINT : PRINT goofy$; " not found": PRINT : goofy$ = "": RESUME green
IF ERL = 10 THEN PRINT : PRINT "No files *.t* files found": PRINT : END