10 REM                    *** FIR DEVELOPMENT PACKAGE ***
20 REM
30 REM   This program module will generate the necessary FIR coefficients
40 REM   using a Rectangular, Hanning, Hamming, and Blackman window
50 REM   sequence.  The user can then define the output path to either
60 REM   the screen, line printer, or an external file which can then
70 REM   be merged with a FIR program to implement the filter.
80 REM
90 REM   NOTE: The Kaiser window sequence is located in a separate module.
100 REM
110 DIM C(256),H(256),CARY(256),CHEX$(256)
120 PI=3.1415927#
130 CLS
140 KEY OFF
150 REM                     *** Generate Main Menu ***
160 REM
170 LOCATE 3:PRINT TAB(27);"FIR DEVELOPMENT PACKAGE"
180 LOCATE 8
190 PRINT TAB(33);"Main Menu"
200 PRINT TAB(33);"---------"
210 PRINT
220 PRINT TAB(33);"1....RECTANGULAR":PRINT
230 PRINT TAB(33);"2....HANNING":PRINT
240 PRINT TAB(33);"3....HAMMING":PRINT
250 PRINT TAB(33);"4....BLACKMAN":PRINT
260 PRINT TAB(33);"5....KAISER":PRINT
270 PRINT TAB(33);"6....Exit to DOS"
280 PRINT
290 INPUT "        Enter window desired (number only) --> ",WIN
300 XPOS=10
310 IF WIN = 6 THEN CLS:SYSTEM
320 IF WIN = 1 THEN WIN$="RECTANGULAR":XPOS=8
330 IF WIN = 2 THEN WIN$="HANNING"
340 IF WIN = 3 THEN WIN$="HAMMING"
350 IF WIN = 4 THEN WIN$="BLACKMAN"
360 IF WIN = 5 THEN LOAD"firproga.bas",R
370 IF WIN < 1 OR WIN > 6 THEN 130
380 REM                  *** Generate filter type menu ***
390 CLS
400 LOCATE 4
410 PRINT TAB(XPOS);"***  FIR COEFFICIENT GENERATION USING THE ";WIN$;" WINDOW ***"
420 LOCATE 8
430 PRINT TAB(22);"Selections:"
440 PRINT
450 PRINT TAB(33);"1....LOWPASS"
460 PRINT
470 PRINT TAB(33);"2....HIGHPASS"
480 PRINT
490 PRINT TAB(33);"3....BANDPASS"
500 PRINT
510 PRINT TAB(33);"4 ...BANDSTOP"
520 PRINT
530 PRINT TAB(33);"5....Exit back to Main Menu"
540 PRINT
550 INPUT "        Enter desired filter type (number only) --> ",TYPE
560 IF TYPE = 5 THEN 130
570 IF TYPE = 1 THEN GOSUB 2000:GOTO 620         'Lowpass Prompts Routine
580 IF TYPE = 2 THEN GOSUB 2120:GOTO 620         'Highpass Prompts Routine
590 IF TYPE=3 OR TYPE=4 THEN GOSUB 2240:GOTO 620 'Bandpass/stop Prompts Routine
600 IF TYPE < 1 OR TYPE > 5 THEN 390
610 GOTO 130
620 REM      *** Prompt for general information and output specifications ***
630 LOCATE 12
640 PRINT "                                                                    "
650 MES=0
660 LOCATE 12
670 INPUT "        Enter the sampling frequency (Fs) in Hz --> ",FSAM
680 IF TYPE=1 THEN LCUT=0
690 IF TYPE=2 THEN HCUT=0
700 IF FSAM/2<LCUT OR FSAM/2<HCUT THEN MES=1:GOSUB 4140:GOTO 650  'display error
710 LOCATE 12
720 PRINT "                                                                    "
730 IF TYPE=1 OR TYPE=2 THEN YPOS=4 ELSE YPOS=5
740 LOCATE (YPOS):PRINT TAB(24);"Sampling Frequency (Fs) =";FSAM;"Hz"
750 LOCATE 14
760 PRINT "        Number of Coefficients = (D*Fs)+1"
770 PRINT
780 LOCATE 12
790 INPUT "        Enter the duration of the impulse response (D) in msec --> ",D
800 LOCATE (YPOS+1):PRINT TAB(24);"Impulse Duration =";D;"msec"
810 LOCATE 12
820 FOR I = 1 TO 3
830 PRINT "                                                                               "
840 NEXT I
850 LOCATE 12:INPUT "        Are the above specifications correct (y/n) ? ",RES$
860 IF RES$="n" OR RES$="N" THEN 390
870 REM
880 REM               *** calculate number of coefficients required ***
890 D = D/1000
900 NYQST=FSAM/2
910 Q=CINT((D*FSAM)/2)
920 COEFF=2*Q+1
930 LOW=LCUT/NYQST      'Nu 1
940 IF TYPE=2 THEN GOTO 960     'if highpass then high=1
950 HIGH=HCUT/NYQST     'Nu 2
960 LOCATE 12
970 PRINT "                                                                    "
980 LOCATE 12
990 PRINT "        The calculated # of coefficients for the filter is:";COEFF
1000 PRINT
1010 PRINT "        Enter # of coefficients desired ONLY if greater than";COEFF
1020 INPUT "        otherwise, press <Enter> to continue --> ",TEMP
1030 IF TEMP = 0 THEN 1160
1040 IF TEMP < COEFF THEN 1080
1050 COEFF=TEMP
1060 Q=(COEFF-1)/2
1070 GOTO 1160
1080 FOR BLINK=1 TO 10
1090 LOCATE 20
1100 PRINT TAB(12);"ERROR! : Order will not satisfy specifications - reenter"
1110 FOR DELAY=1 TO 100:NEXT DELAY
1120 LOCATE 20
1130 PRINT "                                                                   "
1140 NEXT BLINK
1150 GOTO 980
1160 CLS
1170 REM
1180 REM
1190 LOCATE 12:PRINT TAB(28)"Please wait ...working"
1200 REM
1210 GOSUB 1420       'Routine to calculate FS coefficients, C'(n)
1220 REM
1230 IF WIN = 2 THEN GOSUB 1640    'Hanning
1240 IF WIN = 3 THEN GOSUB 1760    'Hamming
1250 IF WIN = 4 THEN GOSUB 1880    'Blackman
1260 REM
1270 REM                    *** Rearrange the coefficients ***
1280 FOR N=0 TO Q
1290 H(N)=C(Q-N)
1300 NEXT N
1310 REM                   *** Generate the symmetry about Q ***
1320 FOR N=1 TO Q
1330 H(Q+N)=H(Q-N)    '(i.e., H[i] = C[q]-i)
1340 NEXT N
1350 REM                    *** Convert coefficients to Hex ***
1360 GOSUB 3990   'call hex conversion routine
1370 PRINT
1380 GOSUB 2430   'call output menu routine
1390 REM
1400 END
1410 REM ======================= FS Calculation Routine ========================
1420 REM
1430 C(0)=HIGH-LOW
1440 IF TYPE = 4 THEN C(0) = 1-C(0)   'for bandstop
1450 FOR I=1 TO Q
1460 C(I)=(SIN(HIGH*I*PI)/(I*PI))-(SIN(LOW*I*PI)/(I*PI))   'Fourier Series
1470 IF TYPE = 4 THEN C(I)=-C(I)      'for bandstop
1480 NEXT I
1490 RETURN
1500 REM =======================================================================
1510 REM
1520 REM ================== Rectangular Window Routine =========================
1530 REM
1540 REM        This trivial routine is placed here for documentation
1550 REM        purposes only, it is not called from anywhere within the
1560 REM        main program.
1570 REM
1580 REM        The Rectangular window sequence is given by:
1590 REM
1600 REM           W(n) = 1, |n| <= Q; 0, elsewhere
1610 REM
1620 REM =======================================================================
1630 REM
1640 REM ==================== Hanning Window Routine ===========================
1650 REM
1660 REM        The Hanning window sequence is given by:
1670 REM
1680 REM        W(n) = 0.5 + 0.5cos(nPI/Q), |n| <= Q; 0, elsewhere
1690 REM
1700 FOR I=0 TO Q
1710 C(I)=C(I)*(.5+.5*COS(I*PI/Q))      ' C'(n) = C(n)*W(n)
1720 NEXT I
1730 RETURN
1740 REM =======================================================================
1750 REM
1760 REM ==================== Hamming Window Routine ===========================
1770 REM
1780 REM        The Hamming window sequence is given by:
1790 REM
1800 REM        W(n) = 0.54 + 0.46cos(nPI/Q), |n| <= Q; 0, elsewhere
1810 REM
1820 FOR I=0 TO Q
1830 C(I)=C(I)*(.54+.46*COS(I*PI/Q))     ' C'(n) = C(n)*W(n)
1840 NEXT I
1850 RETURN
1860 REM =======================================================================
1870 REM
1880 REM ====================== Blackman Window Routine ========================
1890 REM
1900 REM        The Blackman window sequence is given by:
1910 REM
1920 REM        W(n) = 0.42 + 0.5cos(2nPI/2Q) + 0.08cos(4nPI/2Q)
1930 REM
1940 FOR I=0 TO Q
1950 C(I)=C(I)*(.42+.5*COS((2*I*PI)/(2*Q))+.08*COS((4*I*PI)/(2*Q)))
1960 NEXT I
1970 RETURN
1980 REM =======================================================================
1990 REM
2000 REM =================== Lowpass Prompts Routine ===========================
2010 TYPE$="LOWPASS"
2020 CLS
2030 LOCATE 1
2040 PRINT "        Specifications:"
2050 PRINT TAB(24);TYPE$
2060 LCUT=0
2070 LOCATE 12:INPUT "        Enter the 3-db cutoff frequency in Hz --> ",HCUT
2080 LOCATE 3:PRINT TAB(24);"Cutoff Frequency =";HCUT;"Hz"
2090 RETURN
2100 REM =======================================================================
2110 REM
2120 REM ==================== Highpass Prompts Routine =========================
2130 TYPE$="HIGHPASS"
2140 CLS
2150 LOCATE 1
2160 PRINT "        Specifications:"
2170 PRINT TAB(24);TYPE$
2180 HIGH=1    'for highpass normalized upper cutoff = 1
2190 LOCATE 12:INPUT "        Enter the 3-db cutoff frequency in Hz --> ",LCUT
2200 LOCATE 3:PRINT TAB(24);"Cutoff Frequency =";LCUT;"Hz"
2210 RETURN
2220 REM =======================================================================
2230 REM