(FILECREATED "20-Jul-84 23:39:22" {ERIS}<SPEECH>SPECTRUM>BLOCKFLOAT.;74 45027
changes to: (FNS NEWSCROLL UPDATE.SCALED.WINDOW.EXTENT SPECTRUMSCALEDREDISPLAY
SPEECHDEMOSCALEDWINDOWINIT ConvertWindowToFFTCoords SPEECHDEMOINIT)
(VARS GWIDTH SAMPLESPERFFT BLOCKFLOATCOMS FFTSHIFT THRESHPAIRS)
(MACROS ConvertWindowToFFTCoords)
previous date: "17-Jul-84 18:53:29" {ERIS}<SPEECH>WORK>BLOCKFLOAT.;1)
(* Copyright (c) 1984 by I. All rights reserved.)
(PRETTYCOMPRINT BLOCKFLOATCOMS)
(RPAQQ BLOCKFLOATCOMS ((* support fns)
(FNS * BLOCKSUPPORTFNS)
(* UFNs)
(FNS * BLOCKFNS)
(* window support fns)
(FNS * BLOCKWINDOWFNS)
(VARS FFTSHIFT (SPECTRUMMENU)
THRESHPAIRS
(HALFTONE (ARRAY 256 'WORD 0 0)))
(P (NEWTHRESH THRESHPAIRS HALFTONE))
(* declarations for new opcodes)
(PROP DOPVAL \BLKEXPONENT \BLKFLOATP2COMP \BLKFTIMES \BLKMAG \BLKPERM
\BLKSMALLP2FLOAT IBLT \FFTSTEP)
(VARS GRAPHOFFSET GWIDTH \FFTTABLESIZE PI SAMPLESPERFFT SCALE SpeechThresholds
WAVEFORMEND)
(INITVARS (WAVE))
(RECORDS FFTTABLE)
(MACROS ARRAYBASE ConvertWindowToFFTCoords)))
(* support fns)
(RPAQQ BLOCKSUPPORTFNS (DRAW.THRESHOLDS GET.WAVE.AND.READ KAISERMENUINIT MAKE.THRESHOLD.WINDOW SD
ARRAYBASE CORRECT NEWSCROLL NEWTHRESH PCORRECT
UPDATE.SCALED.WINDOW.EXTENT USE.FILTER \CHECKARRAYINDEX
FFTTABLEINIT FIN FIN2 INITFFT PERMINIT READWAVE
SPECTRUMSCALEDREDISPLAY SPEECHDEMO SPEECHDEMOSCALEDWINDOWINIT
SPEECHMENUINIT FFTSTEP SPEECHDEMOINIT TRYIT BASEADDROFY
ConvertWindowToFFTCoords SETCOMPLEX SD2))
(DEFINEQ
(DRAW.THRESHOLDS
[LAMBDA (W) (* hdj "11-Jul-84 17:36")
(PROG [(HALFTONEARRAY (GETWINDOWPROP W (QUOTE HALFTONEARRAY]
(for INDEX from 0 to 255 do (DRAWLINE INDEX (ITIMES 10 (ELT HALFTONEARRAY INDEX))
INDEX 0 1 NIL W])
(GET.WAVE.AND.READ
[LAMBDA NIL (* hdj "11-Jul-84 18:35")
(* *)
(PROG [(FILENAME (MKATOM (PROMPTFORWORD "Wave file name? "]
(READWAVE WAVE 0 (IMIN (ARRAYSIZE WAVE)
(GETFILEINFO FILENAME (QUOTE LENGTH)))
FILENAME 0])
(KAISERMENUINIT
[LAMBDA NIL (* hdj "11-Jul-84 17:00")
(ADDMENU [OR KAISERMENU (SETQ KAISERMENU (create MENU
TITLE ← "Filters:"
ITEMS ←(QUOTE ((Narrow-band (USE.FILTER
(QUOTE Narrow-band)
)
"Chooses narrow-band filter")
(Wide-band (USE.FILTER
(QUOTE Wide-band))
"Chooses wide-band filter"]
(CREATEW])
(MAKE.THRESHOLD.WINDOW
[LAMBDA (HALFTONEARRAY WINDOW) (* hdj "11-Jul-84 17:42")
(* *)
(PUTWINDOWPROP WINDOW (QUOTE TITLE)
"Threshold histogram")
(PUTWINDOWPROP WINDOW (QUOTE REPAINTFN)
(QUOTE DRAW.THRESHOLDS))
(PUTWINDOWPROP WINDOW (QUOTE HALFTONEARRAY)
HALFTONEARRAY)
(REDISPLAYW WINDOW])
(SD
[LAMBDA NIL (* edited: "24-Jun-84 22:54")
(SPEECHDEMO PASSES])
(ARRAYBASE
[LAMBDA (AR) (* lmm "28-Mar-84 17:05")
(\GETBASEPTR AR 0])
(CORRECT
[LAMBDA (X) (* scp "21-Jun-84 22:39")
(COND
((ILESSP X 128)
(IPLUS X 128))
(T (IDIFFERENCE 256 X])
(NEWSCROLL
[LAMBDA (WINDOW XDELTA YDELTA CONTINUOUSFLG) (* hdj "20-Jul-84 23:09")
(* NON-standard scrolling function that scrolls by
blting existing bits and then calling the windows
repaintfn to repaint the newly exposed bits.)
(PROG ((EXTENT (GETWINDOWPROP WINDOW 'EXTENT))
(BOTTOM.X.SCALE.OFFSET (GETWINDOWPROP WINDOW 'BOTTOM.X.SCALE.OFFSET))
(LEFT.Y.SCALE.OFFSET (GETWINDOWPROP WINDOW 'LEFT.Y.SCALE.OFFSET))
(Y.AXIS.LINE.WIDTH (GETWINDOWPROP WINDOW 'Y.AXIS.LINE.WIDTH))
(DATAREGION (GETWINDOWPROP WINDOW 'DATAREGION))
(DATALEFT (GETWINDOWPROP WINDOW 'DATALEFT))
R CRHEIGHT REGIONTOREDISPLAY CRWIDTH CRLEFT CRBOTTOM WHOLEHEIGHT WHOLEWIDTH LEFT.DATA.POS)
(SETQ LEFT.DATA.POS (IPLUS LEFT.Y.SCALE.OFFSET Y.AXIS.LINE.WIDTH))
(SETQ R (DSPCLIPPINGREGION NIL WINDOW))
(SETQ WHOLEHEIGHT (fetch (REGION HEIGHT) of R))
(SETQ CRLEFT DATALEFT)
(SETQ CRBOTTOM (fetch (REGION BOTTOM) of R))
(SETQ CRWIDTH (fetch (REGION WIDTH) of R))
(SETQ CRHEIGHT (fetch (REGION HEIGHT) of R))
(* only one of XDELTA or YDELTA should be non-zero but do both anyway. When both can be non-zero%, this code
should avoid calling the repaintfn on the part of the object that is scrolled on by R but then scrolled off by Y.)
(* do R first because in the common case of printing it
is faster to do it first.)
[COND
((FLOATP XDELTA) (* thumb scroll%, XDELTA gives the fraction of the way
from the left margin the cursor was.)
(COND
[(AND EXTENT (NEQ (fetch (REGION WIDTH) of EXTENT)
-1))
(PROG (OLDX NEWX) (* if there is an extent%, calculate a value of XDELTA
that moves to the proper place.
If there is not%, Don%'t do anything.)
[SETQ NEWX (IPLUS (fetch (REGION LEFT) of EXTENT)
(FIXR (FTIMES XDELTA (IDIFFERENCE (fetch (REGION WIDTH)
of EXTENT)
(fetch (REGION WIDTH)
of R]
(SETQ XDELTA (IDIFFERENCE DATALEFT NEWX]
(T (SETQ XDELTA 0]
[COND
(CONTINUOUSFLG (* if continuous set it scroll by the linefeed height
(no particularly good reason why the linefeed height but
why not))
(COND
((EQ XDELTA 0))
[(IGREATERP XDELTA 0) (* linefeed height is normally negative.)
(SETQ XDELTA (IMINUS (DSPLINEFEED NIL WINDOW]
(T (SETQ XDELTA (DSPLINEFEED NIL WINDOW]
(COND
((AND (NEQ XDELTA 0)
(COND
((AND EXTENT (NEQ (fetch (REGION WIDTH) of EXTENT)
-1)) (* limit amount by the extent)
(* for now limit right extent to right of window ETC. ie
keep it always visible.)
(SETQ XDELTA (IMIN (IDIFFERENCE CRLEFT (fetch (REGION LEFT) of EXTENT))
(IMAX (IDIFFERENCE (IPLUS CRLEFT CRWIDTH)
(fetch (REGION PRIGHT) of EXTENT))
XDELTA))) (* make sure it is still not 0)
(NEQ XDELTA 0))
(T T)))
[COND
[(IGREATERP XDELTA 0) (* Right button%, moving bits to the right)
(* IPLUS Y.AXIS.LINE.WIDTH CRLEFT LEFT.Y.SCALE.OFFSET)
(* IMINUS Y.AXIS.LINE.WIDTH)
(BITBLT WINDOW LEFT.DATA.POS 0 WINDOW (IPLUS LEFT.DATA.POS XDELTA)
0 CRWIDTH CRHEIGHT 'INPUT 'REPLACE)
(SETQ REGIONTOREDISPLAY (CREATEREGION (fetch (REGION LEFT) of DATAREGION)
(fetch (REGION BOTTOM) of DATAREGION)
(IMIN (fetch (REGION WIDTH) of DATAREGION)
XDELTA)
(fetch (REGION HEIGHT) of DATAREGION]
(T (BITBLT WINDOW (IDIFFERENCE LEFT.DATA.POS XDELTA)
0 WINDOW LEFT.DATA.POS 0 CRWIDTH CRHEIGHT 'INPUT 'REPLACE)
(SETQ REGIONTOREDISPLAY (CREATEREGION (IPLUS (fetch (REGION LEFT) of DATAREGION)
(fetch (REGION WIDTH) of DATAREGION)
XDELTA)
(fetch (REGION BOTTOM) of DATAREGION)
(IMIN (fetch (REGION WIDTH) of DATAREGION)
(IMINUS XDELTA))
(fetch (REGION HEIGHT) of DATAREGION]
(* change the extent so that the scroll-slug moves in
the scroll bar)
(add (fetch (REGION LEFT) of EXTENT)
XDELTA) (* Put in the left edge of the image)
[WINDOWPROP WINDOW 'DATALEFT (SETQ DATALEFT (IMAX 0 (IDIFFERENCE DATALEFT XDELTA]
(DSPFILL REGIONTOREDISPLAY WHITESHADE 'REPLACE WINDOW)
(SCALED.WINDOW.SCROLL.PAINTFN WINDOW REGIONTOREDISPLAY DATALEFT)))
(* If button isn%'t down%, redisplay the bottom scale.)
(if (OR (NOT CONTINUOUSFLG)
(MOUSESTATE UP))
then (SCALED.WINDOW.PRINT.SCALES WINDOW REGIONTOREDISPLAY DATALEFT])
(NEWTHRESH
[LAMBDA (THRESHPAIRS HALFTONEARRAY) (* hdj "11-Jul-84 17:14")
(* *)
(PROG ((OLDHILOC 0))
(for PAIR in THRESHPAIRS
do (for INDEX from OLDHILOC to (CAR PAIR) do (SETA HALFTONEARRAY INDEX (CDR PAIR)))
(SETQ OLDHILOC (ADD1 (CAR PAIR])
(PCORRECT
[LAMBDA (X) (* scp " 7-Jun-84 17:01")
(COND
((ZEROP X)
X)
(T (CORRECT X])
(UPDATE.SCALED.WINDOW.EXTENT
[LAMBDA (SCWINDOW) (* hdj "20-Jul-84 18:36")
(PROG ((FILELENGTH (IMIN (GETFILEINFO (GETWINDOWPROP SCWINDOW 'FILENAME)
'LENGTH)
(ARRAYSIZE WAVE)))
WindowToDataFactor)
(SETQ WindowToDataFactor (FQUOTIENT GWIDTH FFTSHIFT))
(PUTWINDOWPROP SCWINDOW 'WindowToDataFactor WindowToDataFactor)
(PUTWINDOWPROP SCWINDOW 'EXTENT (CREATEREGION 0 0 (NumberofStripes SCWINDOW FILELENGTH)
-1])
(USE.FILTER
[LAMBDA (FILTER) (* hdj "10-Jul-84 18:15")
(* * choose which to use in spectrogram)
(PROG (PASSES SHUFFLEARRAY BARHEIGHT WEIGHTS)
(SELECTQ FILTER
(Narrow-band (SETQ PASSES 6)
(SETQ SHUFFLEARRAY SHUFFLE6)
(SETQ BARHEIGHT 3)
(SETQ WEIGHTS KAISER6))
(Wide-band (SETQ PASSES 8)
(SETQ SHUFFLEARRAY SHUFFLE8)
(SETQ BARHEIGHT 1)
(SETQ WEIGHTS KAISER8))
(HELP))
(SETQ SHUFFLE SHUFFLEARRAY)
(PUTWINDOWPROP SPECTRUMWINDOW (QUOTE PASSES)
PASSES)
(PUTWINDOWPROP SPECTRUMWINDOW (QUOTE BARHEIGHT)
BARHEIGHT)
(PUTWINDOWPROP SPECTRUMWINDOW (QUOTE BWINDOWWEIGHTSSHUFFLED)
(ARRAYBASE WEIGHTS])
(\CHECKARRAYINDEX
[LAMBDA (ARRAY INDEX) (* hdj " 6-Jun-84 15:34")
(COND
((IGREATERP INDEX (SUB1 (ARRAYSIZE ARRAY)))
(ERROR "Count too large for array size" ARRAY])
(FFTTABLEINIT
[LAMBDA (FFTBUF1 FFTBUF2 PASSES) (* edited: "22-Jun-84 02:54")
(PROG ((\FFTTABLES (ARRAY PASSES (QUOTE POINTER)))
M N N2 LEXP LE1 NV2 UR UI WR WI ASOURCE ADEST)
(SETQ N (EXPT 2 PASSES))
(SETQ N2 (TIMES N 2))
(SETQ NV2 (IQUOTIENT N 2))
(SETQ M PASSES) (* Compute M = log (N))
[for PASS from 1 to M
do (* Loop thru stages)
(SETQ LEXP (EXPT 2 PASS))
(SETQ LE1 (IQUOTIENT LEXP 2))
(SETQ UR 1.0)
(SETQ UI 0.0)
(SETQ WR (COS (FQUOTIENT PI LE1)
T))
(SETQ WI (SIN (FQUOTIENT PI LE1)
T))
(COND
((ODDP PASS)
(SETQ ASOURCE FFTBUF1)
(SETQ ADEST FFTBUF2))
(T (SETQ ASOURCE FFTBUF2)
(SETQ ADEST FFTBUF1)))
(SETA \FFTTABLES PASS (create FFTTABLE
TWIDDLE ←(FMINUS WR)
ITWIDDLE ← WI
SOURCE ← ASOURCE
ABDEST ← ADEST
CDDEST ←(\ADDBASE ADEST N2)
(* midpoint of dest array)
TCNT ←(ITIMES 4 (IQUOTIENT NV2 LE1))
HCNT ←(ITIMES 4 (SUB1 LE1)
(IQUOTIENT NV2 LE1))
LCNT ←(ITIMES 4 (SUB1 (IQUOTIENT NV2 LE1)))
DELTA ← WR
IDELTA ←(FMINUS WI]
(RETURN \FFTTABLES])
(FIN
[LAMBDA (A) (* hdj " 6-Jun-84 23:52")
(FIX2FLOAT A PA)
(INSPECT PA])
(FIN2
[LAMBDA NIL (* scp " 7-Jun-84 01:05")
(FIN FFTBUF1)
(FIN FFTBUF2])
(INITFFT
[LAMBDA (FFTBUF1 FFTBUF2) (* scp " 6-Jun-84 10:23")
(PROG (M N N2 LEXP LE1 NV2 UR UI WR WI ASOURCE ADEST)
(SETQ N2 512)
(SETQ \FFTARRAY2 (ARRAY N2 (QUOTE FIXP)))
(SETQ N (IQUOTIENT N2 2))
(SETQ NV2 (IQUOTIENT N 2))
(SETQ M 8) (* Compute M = log (N))
(SETQ \FFTTABLES (ARRAY M (QUOTE POINTER)))
[for PASS from 1 to M
do (* Loop thru stages)
(SETQ LEXP (EXPT 2 PASS))
(SETQ LE1 (IQUOTIENT LEXP 2))
(SETQ UR 1.0)
(SETQ UI 0.0)
(SETQ WR (COS (FQUOTIENT PI LE1)
T))
(SETQ WI (SIN (FQUOTIENT PI LE1)
T))
(COND
((EVENP PASS)
(SETQ ASOURCE FFTBUF1)
(SETQ ADEST FFTBUF2))
(T (SETQ ASOURCE FFTBUF2)
(SETQ ADEST FFTBUF1)))
(SETA \FFTTABLES PASS (create FFTTABLE
TWIDDLE ←(FMINUS WR)
ITWIDDLE ← WI
SOURCE ←(ARRAYBASE ASOURCE)
ABDEST ←(ARRAYBASE ADEST)
CDDEST ←(\ADDBASE (ARRAYBASE ADEST)
N2)
(* midpoint of dest array)
TCNT ←(ITIMES 4 (IQUOTIENT NV2 LE1))
HCNT ←(ITIMES 4 (SUB1 LE1)
(IQUOTIENT NV2 LE1))
LCNT ←(ITIMES 4 (SUB1 (IQUOTIENT NV2 LE1)))
DELTA ← WR
IDELTA ←(FMINUS WI]
(RETURN \FFTTABLES])
(PERMINIT
[LAMBDA (PASSES) (* hdj "21-Jun-84 19:16")
(PROG (I J K N NV2 PERM)
(SETQ N (EXPT 2 PASSES))
(SETQ NV2 (IQUOTIENT N 2))
(SETQ PERM (ARRAY 256 (QUOTE WORD)
0 0))
(for I from 0 to (SUB1 256) do (SETA PERM I I))
(SETQ J 1) (* Interchange elements)
(SETQ I 1) (* in bit-reversed order)
(repeatwhile (ILESSP I N)
do (COND
((ILESSP I J)
(SETQ TEMP (ELT PERM (SUB1 I)))
(SETA PERM (SUB1 I)
(ELT PERM (SUB1 J)))
(SETA PERM (SUB1 J)
TEMP)))
(SETQ K NV2)
(while (ILESSP K J)
do (SETQ J (IDIFFERENCE J K))
(SETQ K (IQUOTIENT K 2)))
(SETQ J (IPLUS J K))
(SETQ I (ADD1 I)))
(RETURN PERM])
(READWAVE
[LAMBDA (ARRAY INDEX NUMBEROFBYTES FILE FIRSTBYTE) (* pkh: "12-Jul-84 23:59")
(* * read successive bytes into array from stream)
(PROG ((STREAM (OPENSTREAM FILE 'INPUT))
DATABYTE)
(replace (STREAM ENDOFSTREAMOP) of STREAM with 'NILL)
(FOR X FROM (ARRAYORIG ARRAY) TO (IPLUS (IDIFFERENCE (ARRAYSIZE ARRAY)
1)
(ARRAYORIG ARRAY))
DO (SETA ARRAY X 128))
(SETFILEPTR STREAM FIRSTBYTE)
[for BYTE from INDEX to (IPLUS INDEX NUMBEROFBYTES -1)
do (SETQ DATABYTE (\BIN STREAM))
(if (NULL DATABYTE)
then (RETURN))
(SETA ARRAY BYTE (if (ILESSP DATABYTE 128)
then (IPLUS DATABYTE 128)
else (IDIFFERENCE 256 DATABYTE]
(CLOSEF STREAM])
(SPECTRUMSCALEDREDISPLAY
[LAMBDA (WINDOW REGION DATALEFT) (* hdj "20-Jul-84 15:29")
(PROG ((PASSES (GETWINDOWPROP WINDOW 'PASSES))
(DATAREGION (GETWINDOWPROP WINDOW 'DATAREGION))
(LEFT (fetch (REGION LEFT) of REGION))
(WIDTH (IDIFFERENCE (fetch (REGION WIDTH) of REGION)
(SUB1 GWIDTH)))
(BHALFTONE (ARRAYBASE HALFTONE))
(BASE (BASEADDROFY WINDOW 0))
[DD (fetch IMAGEDATA of (GETWINDOWPROP WINDOW 'DSP]
(WINDOWWIDTHINWORDS 64)
(BWINDOWWEIGHTSSHUFFLED (GETWINDOWPROP WINDOW 'BWINDOWWEIGHTSSHUFFLED))
(BARHEIGHT (GETWINDOWPROP WINDOW 'BARHEIGHT))
(WindowToDataFactor (GETWINDOWPROP WINDOW 'WindowToDataFactor))
(BOTTOM.X.SCALE.OFFSET (GETWINDOWPROP WINDOW 'BOTTOM.X.SCALE.OFFSET))
(GWIDTH (GETWINDOWPROP WINDOW 'BARWIDTH))
WINDOWBASE XPOS ARRAYLENGTH HALFARRAYLENGTH)
[SETQ DATALEFT (OR DATALEFT (GETWINDOWPROP WINDOW 'DATALEFT]
(SETQ ARRAYLENGTH (EXPT 2 PASSES))
(TOTOPW WINDOW)
[SETQ WINDOWBASE (\ADDBASE BASE (IMINUS (ITIMES (IPLUS (HALF BOTTOM.X.SCALE.OFFSET)
128)
64]
(SETQ XPOS (IPLUS DATALEFT (fetch (REGION LEFT) of REGION)))
(for DATAPTR from (FIX (FTIMES (FQUOTIENT FFTSHIFT GWIDTH)
XPOS))
to (FIX (FTIMES (FQUOTIENT FFTSHIFT GWIDTH)
(IPLUS XPOS WIDTH)))
by FFTSHIFT as WINDOWPTR from (fetch (REGION LEFT) of REGION) by GWIDTH
do (SETQ HALFARRAYLENGTH (HALF ARRAYLENGTH))
(\BLKPERM (\ADDBASE BWAVE DATAPTR)
BSHUFFLE BSUBWAVESHUFFLEDSMALLP ARRAYLENGTH)
(\BLKSMALLP2FLOAT BSUBWAVESHUFFLEDSMALLP BSUBWAVESHUFFLEDFLOATP ARRAYLENGTH)
(\BLKFTIMES BSUBWAVESHUFFLEDFLOATP BWINDOWWEIGHTSSHUFFLED BSUBWAVEWEIGHTEDFLOATP
ARRAYLENGTH)
(\BLKFLOATP2COMP BSUBWAVEWEIGHTEDFLOATP BFFTBUF1 ARRAYLENGTH)
(for PASS from 1 to PASSES do (FFTSTEP (ELT FFTTABLE PASS)))
(\BLKMAG BFFTBUF1 BMAGNITUDESQUARED HALFARRAYLENGTH)
(\BLKEXPONENT BMAGNITUDESQUARED BLOGMAGNITUDE HALFARRAYLENGTH)
(IBLT BLOGMAGNITUDE BHALFTONE (\DSPTRANSFORMX WINDOWPTR DD)
WINDOWBASE WINDOWWIDTHINWORDS BARHEIGHT GWIDTH HALFARRAYLENGTH])
(SPEECHDEMO
[LAMBDA (PASSES) (* hdj " 2-Jul-84 20:01")
(PROG ((ARRAYLENGTH (EXPT 2 PASSES))
HALFARRAYLENGTH)
(for WSTART from (ITIMES WAVEFORMSTART SAMPLESPERFFT) to (ITIMES WAVEFORMEND SAMPLESPERFFT)
by SAMPLESPERFFT as GSTART from 0 by GWIDTH
do (SETQ HALFARRAYLENGTH (HALF ARRAYLENGTH))
(\BLKPERM (\ADDBASE BWAVE WSTART)
BSHUFFLE BSUBWAVESHUFFLEDSMALLP ARRAYLENGTH)
(\BLKSMALLP2FLOAT BSUBWAVESHUFFLEDSMALLP BSUBWAVESHUFFLEDFLOATP ARRAYLENGTH)
(\BLKFTIMES BSUBWAVESHUFFLEDFLOATP BWINDOWWEIGHTSSHUFFLED BSUBWAVEWEIGHTEDFLOATP
ARRAYLENGTH)
(\BLKFLOATP2COMP BSUBWAVEWEIGHTEDFLOATP BFFTBUF1 ARRAYLENGTH)
(for PASS from 1 to PASSES do (FFTSTEP (ELT FFTTABLE PASS)))
(\BLKMAG BFFTBUF1 BMAGNITUDESQUARED HALFARRAYLENGTH)
(\BLKEXPONENT BMAGNITUDESQUARED BLOGMAGNITUDE HALFARRAYLENGTH)
(if T
then (BLKGRAPH LOGMAGNITUDE GSTART GBITMAP HALFARRAYLENGTH)
else (BLKGRAPH3 BLOGMAGNITUDE (ARRAYBASE HALFTONE)
GSTART SCRBASE 64 1 GWIDTH HALFARRAYLENGTH])
(SPEECHDEMOSCALEDWINDOWINIT
[LAMBDA (FILENAME NUMPASSES FIRSTBYTE) (* hdj "20-Jul-84 15:26")
(SPEECHDEMOINIT FILENAME NUMPASSES FIRSTBYTE)
(PROG [(WINDOW (CREATEW (CREATEREGION 15 200 700 170)
(CONCAT "Spectrogram of " FILENAME)))
(FILELENGTH (IMIN (GETFILEINFO FILENAME 'LENGTH)
(ARRAYSIZE WAVE]
(DSPRESET WINDOW)
(DSPLINEFEED -20 WINDOW) (* believe it or not%, this is what sets the
continuous-scroll delta)
(PUTWINDOWPROP WINDOW 'PASSES NUMPASSES)
(PUTWINDOWPROP WINDOW 'FILENAME FILENAME)
(UPDATE.SCALED.WINDOW.EXTENT WINDOW)
(PUTWINDOWPROP WINDOW 'BARWIDTH 4)
(PUTWINDOWPROP WINDOW 'BARHEIGHT 1)
(PUTWINDOWPROP WINDOW 'BWINDOWWEIGHTSSHUFFLED (ARRAYBASE KAISER8))
(SCALED.WINDOW.SETUP WINDOW 0 5000 30 30 'SPECTRUMSCALEDREDISPLAY NIL NIL 'NEWSCROLL])
(SPEECHMENUINIT
[LAMBDA NIL (* hdj "11-Jul-84 18:36")
(ADDMENU (OR SPECTRUMMENU (SETQ SPECTRUMMENU (create MENU
TITLE ← "Spectrogram knobs:"
ITEMS ←(QUOTE (("Narrow band"
(USE.FILTER (QUOTE
Narrow-band))
"Chooses narrow-band filter")
("Wide band"
(USE.FILTER (QUOTE
Wide-band))
"Chooses wide-band filter")
("Read wave" (
GET.WAVE.AND.READ)
"Reads a new wave"])
(FFTSTEP
[LAMBDA (FFTTABLE) (* edited: "25-Jun-84 01:24")
(\BLT \FFTTABLE FFTTABLE \FFTTABLESIZE)
(\FFTSTEP \FFTTABLE (fetch (FFTTABLE LCNT) of FFTTABLE))
(\PUTBASEPTR (LOCF (fetch (FFTTABLE SOURCE) of \FFTTABLE))
0 NIL)
(\PUTBASEPTR (LOCF (fetch (FFTTABLE ABDEST) of \FFTTABLE))
0 NIL)
(\PUTBASEPTR (LOCF (fetch (FFTTABLE CDDEST) of \FFTTABLE))
0 NIL])
(SPEECHDEMOINIT
[LAMBDA (WAVEFILE PASSES FIRSTBYTE) (* hdj "18-Jul-84 15:59")
(SETQ SHUFFLE6 (PERMINIT 6))
(SETQ SHUFFLE8 (PERMINIT 8))
(SETQ SHUFFLE (COND
((EQ PASSES 6)
SHUFFLE6)
(T SHUFFLE8)))
(SETQ SUBWAVESHUFFLEDSMALLP (ARRAY 256 'WORD 0 0))
(SETQ SUBWAVESHUFFLEDFLOATP (ARRAY 256 'FLOATP 0.0 0))
(SETQ SUBWAVEWEIGHTEDFLOATP (ARRAY 256 'FLOATP 0.0 0))
(SETQ SUBWAVEWEIGHTEDCOMPLEX (ARRAY 512 'FLOATP 0.0 0))
(SETQ FFTBUF1 (ARRAY 512 'FLOATP 0 0 256))
(SETQ FFTBUF2 (ARRAY 512 'FLOATP 0 0 256))
(SETQ MAGNITUDESQUARED (ARRAY 128 'FLOATP 0.0 0))
(SETQ LOGMAGNITUDE (ARRAY 128 'WORD 0 0 256))
(OR WAVE (PROGN (SETQ WAVE (ARRAY 50000 'WORD 0 0))
(READWAVE WAVE 0 35000 WAVEFILE FIRSTBYTE)))
(SETQ WINDOWWEIGHTSSHUFFLED (COND
((EQ PASSES 6)
KAISER6)
(T KAISER8)))
(SETQ \FFTTABLE (create FFTTABLE))
(SETQ WAVEFORMSTART 1)
(OR WAVEFORMEND (SETQ WAVEFORMEND (PLUS WAVEFORMSTART 300)))
(SETQ BSHUFFLE (ARRAYBASE SHUFFLE))
(SETQ BWAVE (ARRAYBASE WAVE))
(SETQ BSUBWAVESHUFFLEDSMALLP (ARRAYBASE SUBWAVESHUFFLEDSMALLP))
(SETQ BSUBWAVESHUFFLEDFLOATP (ARRAYBASE SUBWAVESHUFFLEDFLOATP))
(SETQ BWINDOWWEIGHTSSHUFFLED (ARRAYBASE WINDOWWEIGHTSSHUFFLED))
(SETQ BSUBWAVEWEIGHTEDFLOATP (ARRAYBASE SUBWAVEWEIGHTEDFLOATP))
(SETQ BSUBWAVEWEIGHTEDCOMPLEX (ARRAYBASE SUBWAVEWEIGHTEDCOMPLEX))
(SETQ BHALFTONE (ARRAYBASE HALFTONE))
(SETQ BLOGMAGNITUDE (ARRAYBASE LOGMAGNITUDE))
(SETQ BFFTBUF1 (ARRAYBASE FFTBUF1))
(SETQ BFFTBUF2 (ARRAYBASE FFTBUF2))
(SETQ BMAGNITUDESQUARED (ARRAYBASE MAGNITUDESQUARED))
(SETQ FFTTABLE (FFTTABLEINIT BFFTBUF1 BFFTBUF2 PASSES])
(TRYIT
[LAMBDA (NPASSES FIRSTBYTE) (* edited: "24-Jun-84 22:17")
(SPEECHDEMOINIT (QUOTE {ERIS}<SPEECH>WAVE>AUSTIN1.WAVE)
(SETQ PASSES (OR NPASSES 8))
(OR FIRSTBYTE 15050))
(SPEECHDEMO PASSES])
(BASEADDROFY
[LAMBDA (WINDOW Y) (* hdj " 3-Jul-84 14:57")
(PROG [(BM (DSPDESTINATION NIL WINDOW))
(DD (fetch IMAGEDATA of (GETWINDOWPROP WINDOW (QUOTE DSP]
(RETURN (\ADDBASE (fetch (BITMAP BITMAPBASE) of BM)
(LLSH (SUB1 (\SFInvert BM (\DSPTRANSFORMY Y DD)))
6])
(ConvertWindowToFFTCoords
[LAMBDA (WINDOWPTR WindowToDataFactor) (* hdj "20-Jul-84 11:09")
(* * converts window x-coord to file coord)
(FTIMES WINDOWPTR WindowToDataFactor])
(SETCOMPLEX
[LAMBDA (PTR R I) (* scp "21-Jun-84 22:41")
(\BLT PTR (\DTEST R (QUOTE FLOATP))
2)
(\BLT (\ADDBASE PTR 2)
(\DTEST I (QUOTE FLOATP))
2])
(SD2
[LAMBDA (FILENAME NUMPASSES FIRSTBYTE) (* hdj " 2-Jul-84 20:28")
(* SPEECHDEMOINIT FILENAME NUMPASSES FIRSTBYTE)
(SPEECHDEMOWINDOWINIT (SETQ GBITMAP (CREATEW (CREATEREGION 3 36 1017 216)
(CONCAT "... Spectrogram ...")))
FILENAME NUMPASSES FIRSTBYTE])
)
(* UFNs)
(RPAQQ BLOCKFNS (\FLOATBLT1.UFN \FLOATBLT2.UFN \IBLT.UFN BLKGRAPH3 BLKGRAPH4 BLKMAG BLKSMALLP2FLOAT
BLKFLOATP2COMP BLKFTIMES BLKPERM BLKEXPONENT BLKGRAPH BLKGRAPH2))
(DEFINEQ
(\FLOATBLT1.UFN
[LAMBDA (SOURCE DEST KOUNT OP) (* hdj "18-Jun-84 16:15")
(* * single-source version of floating-point array ops)
(SELECTC OP
(0 (BLKEXPONENT SOURCE DEST KOUNT))
(1 (BLKMAG SOURCE DEST KOUNT))
(2 (BLKSMALLP2FLOAT SOURCE DEST KOUNT))
(3 (BLKFLOATP2COMP SOURCE DEST KOUNT))
(SHOULDNT "illegal op to \FLOATBLT1.UFN"])
(\FLOATBLT2.UFN
[LAMBDA (SOURCE1 SOURCE2 DEST KOUNT OP) (* hdj "21-Jun-84 19:55")
(SELECTC OP
(0 (BLKFTIMES SOURCE1 SOURCE2 DEST KOUNT))
(1 (BLKPERM SOURCE1 SOURCE2 DEST KOUNT))
(SHOULDNT "illegal OP to \FLOATBLT2.UFN"])
(\IBLT.UFN
[LAMBDA (ValueArray TextureArray XCoord BitmapAddr BitmapWidth ValHeight ValWidth Kount)
(* hdj " 2-Jul-84 17:52")
(* * ValueArray -
an array of 128 elements, 8 bits each)
(* * TextureArray -
an array of 256 elements, each a texture)
(* * XCoord -
bit offset from left of destination bitmap)
(* * BitmapAddr -
destination)
(* * BitmapWidth -
width of dest bitmap in words)
(* * ValHeight -
height of bar)
(* * ValWidth -
width of bar)
(* * Kount -
how many elements of ValueArray to graph)
(PROG (TEXTURE (BITMAPOFFSET BitmapAddr))
(for val from (SUB1 Kount) to 0 by -1
do (SETQ TEXTURE (\GETBASE TextureArray (\GETBASE ValueArray val)))
(for X from 1 to ValHeight
do (\PUTBASEBITS BITMAPOFFSET XCoord ValWidth TEXTURE)
(SETQ BITMAPOFFSET (\ADDBASE BITMAPOFFSET BitmapWidth])
(BLKGRAPH3
[LAMBDA (ValueArray TextureArray XCoord BitmapAddr BitmapWidth ValHeight ValWidth Kount)
(* hdj " 2-Jul-84 17:52")
(* * ValueArray -
an array of 128 elements, 8 bits each)
(* * TextureArray -
an array of 256 elements, each a texture)
(* * XCoord -
bit offset from left of destination bitmap)
(* * BitmapAddr -
destination)
(* * BitmapWidth -
width of dest bitmap in words)
(* * ValHeight -
height of bar)
(* * ValWidth -
width of bar)
(* * Kount -
how many elements of ValueArray to graph)
(PROG (TEXTURE (BITMAPOFFSET BitmapAddr))
(for val from (SUB1 Kount) to 0 by -1
do (SETQ TEXTURE (\GETBASE TextureArray (\GETBASE ValueArray val)))
(for X from 1 to ValHeight
do (\PUTBASEBITS BITMAPOFFSET XCoord ValWidth TEXTURE)
(SETQ BITMAPOFFSET (\ADDBASE BITMAPOFFSET BitmapWidth])
(BLKGRAPH4
[LAMBDA (ValueArray TextureArray XCoord WINDOW ValHeight ValWidth Kount)
(* hdj " 3-Jul-84 15:51")
(PROG ((BASE (BASEADDROFY WINDOW 0))
[DD (fetch IMAGEDATA of (GETWINDOWPROP WINDOW (QUOTE DSP]
(WINDOWWIDTHINWORDS 64)
X)
(SETQ X (\DSPTRANSFORMX GSTART DD))
(BLKGRAPH3 ValueArray TextureArray X (\ADDBASE BASE (IMINUS 8192))
WINDOWWIDTHINWORDS ValHeight ValWidth Kount])
(BLKMAG
[LAMBDA (complexArray magnitudeArray kount) (* hdj "21-Jun-84 18:53")
(* \CHECKARRAYINDEX magnitudeArray
(SUB1 kount))
(for magnitude from 0 to (SUB1 kount) bind complexcount real imag
do (SETQ complexcount (LLSH magnitude 2))
(SETQ real (\GETBASEFLOATP complexArray complexcount))
(SETQ imag (\GETBASEFLOATP complexArray (IPLUS complexcount 2)))
(\PUTBASEFLOATP magnitudeArray (LLSH magnitude 1)
(FPLUS (FTIMES real real)
(FTIMES imag imag])
(BLKSMALLP2FLOAT
[LAMBDA (source destination kkount) (* edited: "22-Jun-84 04:21")
(* * convert an array of SMALLPs to FLOATPs)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for NN from 0 to (SUB1 kkount) do (\PUTBASEFLOATP destination (LLSH NN 1)
(FLOAT (\GETBASE source NN])
(BLKFLOATP2COMP
[LAMBDA (source destination kount) (* hdj "21-Jun-84 19:03")
(* * moves the contents of a Real array into a Complex array; sets imaginary part to 0)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for sourceElt from 0 to (SUB1 kount) do (SETCOMPLEX (\ADDBASE destination (LLSH sourceElt 2))
(\GETBASEFLOATP source (LLSH sourceElt 1))
0.0])
(BLKFTIMES
[LAMBDA (SOURCE1 SOURCE2 DEST KOUNT) (* hdj "21-Jun-84 19:11")
(* \CHECKARRAYINDEX DEST (SUB1 KOUNT))
(for INDEX from 0 to (LLSH (SUB1 KOUNT)
1)
by 2 do (\PUTBASEFLOATP DEST INDEX (FTIMES (\GETBASEFLOATP SOURCE1 INDEX)
(\GETBASEFLOATP SOURCE2 INDEX])
(BLKPERM
[LAMBDA (orig permutations destination kount) (* hdj "21-Jun-84 19:26")
(* * destination (x) ← orig (perm (x)))
(* * args are arrays of smallps (words))
(* * must fold initial into offset for compatibility with microcode)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for X from 0 to (SUB1 kount) do (\PUTBASE destination X (\GETBASE orig (\GETBASE permutations X])
(BLKEXPONENT
[LAMBDA (source destination kount) (* edited: "24-Jun-84 23:44")
(* * extract the exponent of each element of source, stick it in destination)
(* \CHECKARRAYINDEX destination
(SUB1 kount))
(for X from 0 to (SUB1 kount) do (\PUTBASE destination X (fetch (FLOATP EXPONENT)
of (\GETBASEFLOATP source
(LLSH X 1])
(BLKGRAPH
[LAMBDA (ARRAY X BITMAP KOUNT) (* hdj "25-Jun-84 22:58")
(* * draws contents of ARRAY at position X in BITMAP)
(\CHECKARRAYINDEX ARRAY (SUB1 KOUNT))
(for Y from 0 to (SUB1 KOUNT) bind DOTS LEFTOFFSET
do (SETQ DOTS (ELT SpeechThresholds (ELT ARRAY Y)))
(SETQ LEFTOFFSET (LRSH (IDIFFERENCE GWIDTH DOTS)
1))
(for XL from LEFTOFFSET to (IPLUS DOTS LEFTOFFSET -1) do (BITMAPBIT BITMAP
(IPLUS X XL)
Y 1])
(BLKGRAPH2
[LAMBDA (ValueArray ThreshArray XCoord BitmapAddr BitmapWidth ValHeight ValWidth Kount)
(* hdj "27-Jun-84 17:38")
(* * ValueArray -
an array of 128 elements, 8 bits each)
(* * ThreshArray -
an array of 256 elements, each a texture)
(* * XCoord -
bit offset from left of destination bitmap)
(* * BitmapAddr -
destination)
(* * ValHeight -
height of bar)
(* * ValWidth -
width of bar)
(* * Kount -
how many elements of ValueArray to graph)
(PROG ((BBTTABLE (NCREATE (QUOTE PILOTBBT)))
GRAY)
(SETQ GRAY (fetch (BITMAP BITMAPBASE) of \SYSBBTEXTURE))
(replace (PILOTBBT PBTFLAGS) of BBTTABLE with 0)
(replace (PILOTBBT PBTSOURCE) of BBTTABLE with GRAY)
(replace (PILOTBBT PBTDEST) of BBTTABLE with BitmapAddr)
(replace (PILOTBBT PBTDESTBPL) of BBTTABLE with BitmapWidth)
(replace (PILOTBBT PBTSOURCEBPL) of BBTTABLE with 0)
(replace (PILOTBBT PBTSOURCEBIT) of BBTTABLE with 0)
(replace (PILOTBBT PBTDESTBIT) of BBTTABLE with XCoord)
(replace (PILOTBBT PBTWIDTH) of BBTTABLE with ValWidth)
(replace (PILOTBBT PBTHEIGHT) of BBTTABLE with ValHeight)
(replace (PILOTBBT PBTOPERATION) of BBTTABLE with 2)
(* 2 means "OR")
(replace (PILOTBBT PBTSOURCETYPE) of BBTTABLE with 0)
(* 0 means "nothing special")
(replace (PILOTBBT PBTUSEGRAY) of BBTTABLE with T)
(replace (PILOTBBT PBTGRAYOFFSET) of BBTTABLE with 0)
(replace (PILOTBBT PBTGRAYWIDTHLESSONE) of BBTTABLE with 15)
(replace (PILOTBBT PBTGRAYHEIGHTLESSONE) of BBTTABLE with 0)
(for val from Kount to 0 by -1
do (\PUTBASE GRAY 0 (ELT ThreshArray (ELT ValueArray val)))
(\DOPILOTBITBLT BBTTABLE])
)
(* window support fns)
(RPAQQ BLOCKWINDOWFNS (COPYWAVEARRAY RESETHALFTONE SPECTRUMSCALEDREDISPLAY SPECTRUMREDISPLAY
SPEECHDEMOWINDOWINIT SPEECHDEMOSCALEDWINDOWINIT))
(DEFINEQ
(COPYWAVEARRAY
[LAMBDA NIL (* pkh: "13-Jul-84 00:13")
(* * read successive bytes into array from stream)
(* PROG ((STREAM (OPENSTREAM FILE (QUOTE INPUT))) DATABYTE) (replace (STREAM ENDOFSTREAMOP) of STREAM with
(QUOTE NILL)) (FOR X FROM (ARRAYORIG ARRAY) TO (IPLUS (IDIFFERENCE (ARRAYSIZE ARRAY) 1) (ARRAYORIG ARRAY)) DO
(SETA ARRAY X 128)) (SETFILEPTR STREAM FIRSTBYTE) (for BYTE from INDEX to (IPLUS INDEX NUMBEROFBYTES -1) do
(SETQ DATABYTE (\BIN STREAM)) (if (NULL DATABYTE) then (RETURN)) (SETA ARRAY BYTE (if (ILESSP DATABYTE 128) then
(IPLUS DATABYTE 128) else (IDIFFERENCE 256 DATABYTE)))) (CLOSEF STREAM))
(FOR X FROM (ARRAYORIG WAVE) TO (IPLUS (IDIFFERENCE (ARRAYSIZE WAVE)
1)
(ARRAYORIG WAVE))
DO (SETA WAVE X 128))
(FOR X FROM 1 TO 700 DO (SETA WAVE X (CORRECT (ELT SPEECH.*WAVE* X])
(RESETHALFTONE
[LAMBDA (MID) (* pkh: "13-Jul-84 00:20")
(FOR I FROM 0 TO 255 DO (SETA HALFTONE I (COND
((ILESSP I (SUB1 MID))
0)
((EQ I (SUB1 MID))
4)
((EQ I MID)
10)
((EQ I (ADD1 MID))
21)
(T 31])
(SPECTRUMSCALEDREDISPLAY
[LAMBDA (WINDOW REGION DATALEFT) (* hdj "20-Jul-84 15:29")
(PROG ((PASSES (GETWINDOWPROP WINDOW 'PASSES))
(DATAREGION (GETWINDOWPROP WINDOW 'DATAREGION))
(LEFT (fetch (REGION LEFT) of REGION))
(WIDTH (IDIFFERENCE (fetch (REGION WIDTH) of REGION)
(SUB1 GWIDTH)))
(BHALFTONE (ARRAYBASE HALFTONE))
(BASE (BASEADDROFY WINDOW 0))
[DD (fetch IMAGEDATA of (GETWINDOWPROP WINDOW 'DSP]
(WINDOWWIDTHINWORDS 64)
(BWINDOWWEIGHTSSHUFFLED (GETWINDOWPROP WINDOW 'BWINDOWWEIGHTSSHUFFLED))
(BARHEIGHT (GETWINDOWPROP WINDOW 'BARHEIGHT))
(WindowToDataFactor (GETWINDOWPROP WINDOW 'WindowToDataFactor))
(BOTTOM.X.SCALE.OFFSET (GETWINDOWPROP WINDOW 'BOTTOM.X.SCALE.OFFSET))
(GWIDTH (GETWINDOWPROP WINDOW 'BARWIDTH))
WINDOWBASE XPOS ARRAYLENGTH HALFARRAYLENGTH)
[SETQ DATALEFT (OR DATALEFT (GETWINDOWPROP WINDOW 'DATALEFT]
(SETQ ARRAYLENGTH (EXPT 2 PASSES))
(TOTOPW WINDOW)
[SETQ WINDOWBASE (\ADDBASE BASE (IMINUS (ITIMES (IPLUS (HALF BOTTOM.X.SCALE.OFFSET)
128)
64]
(SETQ XPOS (IPLUS DATALEFT (fetch (REGION LEFT) of REGION)))
(for DATAPTR from (FIX (FTIMES (FQUOTIENT FFTSHIFT GWIDTH)
XPOS))
to (FIX (FTIMES (FQUOTIENT FFTSHIFT GWIDTH)
(IPLUS XPOS WIDTH)))
by FFTSHIFT as WINDOWPTR from (fetch (REGION LEFT) of REGION) by GWIDTH
do (SETQ HALFARRAYLENGTH (HALF ARRAYLENGTH))
(\BLKPERM (\ADDBASE BWAVE DATAPTR)
BSHUFFLE BSUBWAVESHUFFLEDSMALLP ARRAYLENGTH)
(\BLKSMALLP2FLOAT BSUBWAVESHUFFLEDSMALLP BSUBWAVESHUFFLEDFLOATP ARRAYLENGTH)
(\BLKFTIMES BSUBWAVESHUFFLEDFLOATP BWINDOWWEIGHTSSHUFFLED BSUBWAVEWEIGHTEDFLOATP
ARRAYLENGTH)
(\BLKFLOATP2COMP BSUBWAVEWEIGHTEDFLOATP BFFTBUF1 ARRAYLENGTH)
(for PASS from 1 to PASSES do (FFTSTEP (ELT FFTTABLE PASS)))
(\BLKMAG BFFTBUF1 BMAGNITUDESQUARED HALFARRAYLENGTH)
(\BLKEXPONENT BMAGNITUDESQUARED BLOGMAGNITUDE HALFARRAYLENGTH)
(IBLT BLOGMAGNITUDE BHALFTONE (\DSPTRANSFORMX WINDOWPTR DD)
WINDOWBASE WINDOWWIDTHINWORDS BARHEIGHT GWIDTH HALFARRAYLENGTH])
(SPECTRUMREDISPLAY
[LAMBDA (WINDOW REGION) (* hdj "10-Jul-84 18:18")
(PROG ((PASSES (GETWINDOWPROP WINDOW 'PASSES))
(LEFT (fetch (REGION LEFT) of REGION))
(RIGHT (IDIFFERENCE (fetch (REGION RIGHT) of REGION)
GWIDTH))
(BHALFTONE (ARRAYBASE HALFTONE))
(BASE (BASEADDROFY WINDOW 0))
[DD (fetch IMAGEDATA of (GETWINDOWPROP WINDOW 'DSP]
(WINDOWWIDTHINWORDS 64)
(BWINDOWWEIGHTSSHUFFLED (GETWINDOWPROP WINDOW 'BWINDOWWEIGHTSSHUFFLED))
(BARHEIGHT (GETWINDOWPROP WINDOW 'BARHEIGHT))
(GWIDTH (GETWINDOWPROP WINDOW 'BARWIDTH))
WINDOWBASE ARRAYLENGTH HALFARRAYLENGTH)
(SETQ ARRAYLENGTH (EXPT 2 PASSES))
(SETQ WINDOWBASE (\ADDBASE BASE (IMINUS 8192)))
(for WSTART from (ITIMES SAMPLESPERFFT (ConvertWindowToFFTCoords LEFT GWIDTH))
to (ITIMES SAMPLESPERFFT (ConvertWindowToFFTCoords RIGHT GWIDTH)) by SAMPLESPERFFT
as GSTART from LEFT by GWIDTH
do (SETQ HALFARRAYLENGTH (HALF ARRAYLENGTH))
(\BLKPERM (\ADDBASE BWAVE WSTART)
BSHUFFLE BSUBWAVESHUFFLEDSMALLP ARRAYLENGTH)
(\BLKSMALLP2FLOAT BSUBWAVESHUFFLEDSMALLP BSUBWAVESHUFFLEDFLOATP ARRAYLENGTH)
(\BLKFTIMES BSUBWAVESHUFFLEDFLOATP BWINDOWWEIGHTSSHUFFLED BSUBWAVEWEIGHTEDFLOATP
ARRAYLENGTH)
(\BLKFLOATP2COMP BSUBWAVEWEIGHTEDFLOATP BFFTBUF1 ARRAYLENGTH)
(for PASS from 1 to PASSES do (FFTSTEP (ELT FFTTABLE PASS)))
(\BLKMAG BFFTBUF1 BMAGNITUDESQUARED HALFARRAYLENGTH)
(\BLKEXPONENT BMAGNITUDESQUARED BLOGMAGNITUDE HALFARRAYLENGTH)
(IBLT BLOGMAGNITUDE BHALFTONE (\DSPTRANSFORMX GSTART DD)
WINDOWBASE WINDOWWIDTHINWORDS BARHEIGHT GWIDTH HALFARRAYLENGTH])
(SPEECHDEMOWINDOWINIT
[LAMBDA (FILENAME NUMPASSES FIRSTBYTE) (* pkh: "16-Jul-84 14:56")
(SPEECHDEMOINIT FILENAME NUMPASSES FIRSTBYTE)
(PROG ((WINDOW (CREATEW (CREATEREGION 50 80 940 160)
"Spectrogram")))
(DSPRESET WINDOW)
(PUTWINDOWPROP WINDOW 'PASSES NUMPASSES)
(PUTWINDOWPROP WINDOW 'EXTENT (CREATEREGION 0 0 (IMIN (IQUOTIENT (GETFILEINFO FILENAME
'LENGTH)
(ITIMES SAMPLESPERFFT
GWIDTH))
(ARRAYSIZE WAVE))
-1))
(PUTWINDOWPROP WINDOW 'REPAINTFN 'SPECTRUMREDISPLAY)
(PUTWINDOWPROP WINDOW 'SCROLLFN 'SCROLLBYREPAINTFN)
(PUTWINDOWPROP WINDOW 'BARWIDTH 4)
(PUTWINDOWPROP WINDOW 'BARHEIGHT 1)
(PUTWINDOWPROP WINDOW 'BWINDOWWEIGHTSSHUFFLED (ARRAYBASE KAISER8))
(SPECTRUMREDISPLAY WINDOW (GETWINDOWPROP WINDOW 'REGION])
(SPEECHDEMOSCALEDWINDOWINIT
[LAMBDA (FILENAME NUMPASSES FIRSTBYTE) (* hdj "20-Jul-84 15:26")
(SPEECHDEMOINIT FILENAME NUMPASSES FIRSTBYTE)
(PROG [(WINDOW (CREATEW (CREATEREGION 15 200 700 170)
(CONCAT "Spectrogram of " FILENAME)))
(FILELENGTH (IMIN (GETFILEINFO FILENAME 'LENGTH)
(ARRAYSIZE WAVE]
(DSPRESET WINDOW)
(DSPLINEFEED -20 WINDOW) (* believe it or not%, this is what sets the
continuous-scroll delta)
(PUTWINDOWPROP WINDOW 'PASSES NUMPASSES)
(PUTWINDOWPROP WINDOW 'FILENAME FILENAME)
(UPDATE.SCALED.WINDOW.EXTENT WINDOW)
(PUTWINDOWPROP WINDOW 'BARWIDTH 4)
(PUTWINDOWPROP WINDOW 'BARHEIGHT 1)
(PUTWINDOWPROP WINDOW 'BWINDOWWEIGHTSSHUFFLED (ARRAYBASE KAISER8))
(SCALED.WINDOW.SETUP WINDOW 0 5000 30 30 'SPECTRUMSCALEDREDISPLAY NIL NIL 'NEWSCROLL])
)
(RPAQQ FFTSHIFT 100)
(RPAQQ SPECTRUMMENU NIL)
(RPAQQ THRESHPAIRS ((143 . 0)
(144 . 2)
(146 . 9)
(255 . 15)))
(RPAQ HALFTONE (ARRAY 256 'WORD 0 0))
(NEWTHRESH THRESHPAIRS HALFTONE)
(* declarations for new opcodes)
(PUTPROPS \BLKEXPONENT DOPVAL (3 FLOATBLT1 0))
(PUTPROPS \BLKFLOATP2COMP DOPVAL (3 FLOATBLT1 3))
(PUTPROPS \BLKFTIMES DOPVAL (4 FLOATBLT2 0))
(PUTPROPS \BLKMAG DOPVAL (3 FLOATBLT1 1))
(PUTPROPS \BLKPERM DOPVAL (4 FLOATBLT2 1))
(PUTPROPS \BLKSMALLP2FLOAT DOPVAL (3 FLOATBLT1 2))
(PUTPROPS IBLT DOPVAL (8 IBLT))
(PUTPROPS \FFTSTEP DOPVAL (2 FFTSTEP))
(RPAQQ GRAPHOFFSET 140)
(RPAQQ GWIDTH 4)
(RPAQQ \FFTTABLESIZE 32)
(RPAQQ PI 3.141592)
(RPAQQ SAMPLESPERFFT 256)
(RPAQQ SCALE 10)
(RPAQ SpeechThresholds (READARRAY 256 (QUOTE FIXP) 0))
(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 2 2 3 3 4 4 5 5 6 6
6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6
6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6
6 NIL
)
(RPAQQ WAVEFORMEND 301)
(RPAQ? WAVE )
[DECLARE: EVAL@COMPILE
(DATATYPE FFTTABLE ((TWIDDLE FLOATP)
(ITWIDDLE FLOATP (* imaginary part of TWIDDLE))
(SOURCE XPOINTER (* virtual address of source array base))
(ABDEST XPOINTER (* virtual address of destination array base)
)
(CDDEST XPOINTER (* midpoint in destination array))
(TCNT WORD (* count of butterfiles with same twiddle x4)
)
(HCNT WORD (* (mod cnt tcnt) high portion of count of butterflies
remaining x4))
(NIL 2 FLOATP (* must have floating complex zero here))
(DELTA FLOATP (* packed complex root of unity to change twiddle)
)
(IDELTA FLOATP (* imaginary part of DELTA))
(LCNT WORD (* (remainder cnt tcnt) low portion of count of
butterflies remaining x4))
(PAD 11 WORD (* padding so that FFTTABLE will never cross page
boundary.))))
]
(/DECLAREDATATYPE 'FFTTABLE
'(FLOATP FLOATP XPOINTER XPOINTER XPOINTER WORD WORD FLOATP FLOATP FLOATP FLOATP
WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD))
(DECLARE: EVAL@COMPILE
(PUTPROPS ARRAYBASE DMACRO (OPENLAMBDA (AR)
(fetch (ARRAYP BASE)
of AR)))
(PUTPROPS ConvertWindowToFFTCoords MACRO [LAMBDA (WINDOWPTR WindowToDataFactor)
(* * converts window x-coord to file coord)
(FTIMES WINDOWPTR WindowToDataFactor])
)
(PUTPROPS BLOCKFLOAT COPYRIGHT ("I" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1701 24761 (DRAW.THRESHOLDS 1711 . 2019) (GET.WAVE.AND.READ 2021 . 2338) (
KAISERMENUINIT 2340 . 2842) (MAKE.THRESHOLD.WINDOW 2844 . 3219) (SD 3221 . 3352) (ARRAYBASE 3354 .
3483) (CORRECT 3485 . 3666) (NEWSCROLL 3668 . 9148) (NEWTHRESH 9150 . 9491) (PCORRECT 9493 . 9654) (
UPDATE.SCALED.WINDOW.EXTENT 9656 . 10171) (USE.FILTER 10173 . 10953) (\CHECKARRAYINDEX 10955 . 11176)
(FFTTABLEINIT 11178 . 12590) (FIN 12592 . 12730) (FIN2 12732 . 12877) (INITFFT 12879 . 14376) (
PERMINIT 14378 . 15285) (READWAVE 15287 . 16134) (SPECTRUMSCALEDREDISPLAY 16136 . 18378) (SPEECHDEMO
18380 . 19523) (SPEECHDEMOSCALEDWINDOWINIT 19525 . 20485) (SPEECHMENUINIT 20487 . 21084) (FFTSTEP
21086 . 21550) (SPEECHDEMOINIT 21552 . 23321) (TRYIT 23323 . 23584) (BASEADDROFY 23586 . 23944) (
ConvertWindowToFFTCoords 23946 . 24170) (SETCOMPLEX 24172 . 24387) (SD2 24389 . 24759)) (24955 34360 (
\FLOATBLT1.UFN 24965 . 25399) (\FLOATBLT2.UFN 25401 . 25680) (\IBLT.UFN 25682 . 26802) (BLKGRAPH3
26804 . 27924) (BLKGRAPH4 27926 . 28436) (BLKMAG 28438 . 29045) (BLKSMALLP2FLOAT 29047 . 29488) (
BLKFLOATP2COMP 29490 . 30012) (BLKFTIMES 30014 . 30421) (BLKPERM 30423 . 30973) (BLKEXPONENT 30975 .
31477) (BLKGRAPH 31479 . 32038) (BLKGRAPH2 32040 . 34358)) (34550 41790 (COPYWAVEARRAY 34560 . 35545)
(RESETHALFTONE 35547 . 35899) (SPECTRUMSCALEDREDISPLAY 35901 . 38143) (SPECTRUMREDISPLAY 38145 . 39907
) (SPEECHDEMOWINDOWINIT 39909 . 40826) (SPEECHDEMOSCALEDWINDOWINIT 40828 . 41788)))))
STOP