(FILECREATED " 5-Aug-84 03:33:57" {ERIS}<SPEECH>WORK>BLOCKFLOAT.;28 48367
changes to: (FNS SDINIT)
previous date: " 3-Aug-84 16:44:12" {ERIS}<SPEECH>WORK>BLOCKFLOAT.;27)
(* 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 NTP OSCILLOSCOPEREGION SAMPLESPERSECOND SINGLEHEIGHT
SPECWREGION (BARHEIGHTMENU)
(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 CORRECT ConvertWindowToFFTCoords FFTSTEP)))
(* support fns)
(RPAQQ BLOCKSUPPORTFNS (DOUBLEPERMINIT DRAW.THRESHOLDS GET.BARHEIGHT GET.WAVE.AND.READ KAISERMENUINIT
MAKE.THRESHOLD.WINDOW SD SDINIT ARRAYBASE CH CORRECT NEWSCROLL
NEWTHRESH PCORRECT UPDATE.SCALED.WINDOW.EXTENT USE.FILTER
\CHECKARRAYINDEX FFTTABLEINIT FIN FIN2 FIXME FX INITFFT
PERMINIT READWAVE SPEECHDEMO SPEECHMENUINIT FFTSTEP
SPEECHDEMOINIT TRYIT BASEADDROFY ConvertWindowToFFTCoords
SETCOMPLEX SD2))
(DEFINEQ
(DOUBLEPERMINIT
[LAMBDA (PASSES) (* hdj "29-Jul-84 15:08")
(PROG ((PERM (PERMINIT PASSES))
(DPERM (ARRAY 512 'WORD 0 0))
(N (EXPT 2 PASSES)))
(for I from 0 to (SUB1 N)
do (SETA DPERM (IPLUS I I)
(ELT PERM I))
(SETA DPERM (IPLUS I I 1)
(IPLUS (ELT PERM I)
FFTSHIFT)))
(RETURN DPERM])
(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.BARHEIGHT
[LAMBDA NIL (* hdj " 1-Aug-84 21:05")
(PROG (BARHEIGHT BARHEIGHTWINDOW)
(SETQ BARHEIGHT (MENU BARHEIGHTMENU))
(SETQ BARHEIGHTWINDOW (GETWINDOWPROP SPECW 'BARHEIGHTWINDOW))
(if (FMEMB BARHEIGHT '(1 2))
then (PUTWINDOWPROP SPECW 'BARHEIGHT BARHEIGHT)
(CLEARW BARHEIGHTWINDOW)
(PRINT BARHEIGHT BARHEIGHTWINDOW)
(REDISPLAYW SPECW])
(GET.WAVE.AND.READ
[LAMBDA NIL (* hdj " 2-Aug-84 00:20")
(* *)
(PROG ((FILENAME (MKATOM (PROMPTFORWORD "Wave file name? ")))
LEN)
(SETQ LEN (GETFILEINFO FILENAME 'LENGTH))
(READWAVE WAVE 0 (IMIN (ARRAYSIZE WAVE)
LEN)
FILENAME 0)
(PUTWINDOWPROP SPECW 'TITLE (CONCAT "Spectrogram of " FILENAME ": " (FQUOTIENT LEN
SAMPLESPERSECOND)
" seconds of speech"))
(PUTWINDOWPROP SPECW 'DATALEFT 0)
(replace (REGION LEFT) of (GETWINDOWPROP SPECW 'EXTENT) with 0)
(REDISPLAYW SPECW])
(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])
(SDINIT
[LAMBDA (FILENAME) (* hdj " 5-Aug-84 03:29")
(* * create spectrogram and oscilloscope windows and stick them together)
(PROG (SPECTROGRAMW OSCILLOGRAMW)
(SETQ SPECTROGRAMW (SPEECHDEMOSCALEDWINDOWINIT FILENAME 8 0))
[PUTWINDOWPROP SPECTROGRAMW 'MINSIZE (CONS (fetch (REGION WIDTH) of SPECWREGION)
(HALF (fetch (REGION HEIGHT) of SPECWREGION]
(PUTWINDOWPROP SPECTROGRAMW 'MAXSIZE (CONS (fetch (REGION WIDTH) of SPECWREGION)
(fetch (REGION HEIGHT) of SPECWREGION)))
(SETQ OSCILLOGRAMW (SDF WAVE))
(PUTWINDOWPROP OSCILLOGRAMW 'MINSIZE (CONS (fetch (REGION WIDTH) of OSCILLOSCOPEREGION)
(fetch (REGION HEIGHT) of OSCILLOSCOPEREGION)))
(PUTWINDOWPROP OSCILLOGRAMW 'MAXSIZE (CONS (fetch (REGION WIDTH) of OSCILLOSCOPEREGION)
(fetch (REGION HEIGHT) of OSCILLOSCOPEREGION)))
(ATTACHWINDOW OSCILLOGRAMW SPECTROGRAMW 'BOTTOM 'JUSTIFY 'HERE)
(SHRINKW SPECTROGRAMW NIL (create POSITION
XCOORD ← 0
YCOORD ← 0))
(SETQ WAVEW (CREATEW (CREATEREGION 100 100 530 256)
"Wave display window"))
(WAVEEDITMENUINIT])
(ARRAYBASE
[LAMBDA (AR) (* lmm "28-Mar-84 17:05")
(\GETBASEPTR AR 0])
(CH
[LAMBDA NIL (* hdj "29-Jul-84 11:29")
(CHANGEBACKGROUND])
(CORRECT
[LAMBDA (X) (* hdj " 2-Aug-84 01:54")
(COND
((ILESSP X 128)
(IPLUS X 128))
(T (IDIFFERENCE 256 X])
(NEWSCROLL
[LAMBDA (WINDOW XDELTA YDELTA CONTINUOUSFLG) (* edited: " 3-Aug-84 00:45")
(* NON-standard scrolling function that scrolls by
blting existing bits and then calling the 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))
X CRHEIGHT REGIONTOREDISPLAY CRWIDTH CRBOTTOM WHOLEHEIGHT WHOLEWIDTH LEFT.DATA.POS)
(SETQ LEFT.DATA.POS (IPLUS LEFT.Y.SCALE.OFFSET Y.AXIS.LINE.WIDTH))
(SETQ X (DSPCLIPPINGREGION NIL WINDOW))
(SETQ WHOLEHEIGHT (fetch (REGION HEIGHT) of X))
(SETQ CRBOTTOM (fetch (REGION BOTTOM) of X))
(SETQ CRWIDTH (fetch (REGION WIDTH) of X))
(SETQ CRHEIGHT (fetch (REGION HEIGHT) of X)) (* do X 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.)
(PROMPTPRINT "Sorry, thumb-scrolling isn't implemented yet")
(RETURN)
(* COND ((AND EXTENT (NEQ (fetch (REGION WIDTH) of EXTENT) -1)) (PROG (NEWX) (SETQ NEWX (IPLUS
(fetch (REGION LEFT) of EXTENT) (FIXR (FTIMES XDELTA (IDIFFERENCE (fetch (REGION WIDTH) of EXTENT)
(fetch (REGION WIDTH) of X)))))) (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 DATALEFT (IMAX (IDIFFERENCE (IPLUS DATALEFT CRWIDTH)
(fetch (REGION WIDTH)
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 DATALEFT 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)
(PUTWINDOWPROP WINDOW 'DATALEFT (SETQ DATALEFT (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) (* edited: " 2-Aug-84 15:52")
(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 (ITIMES (IQUOTIENT FILELENGTH FFTSHIFT)
GWIDTH)
-1])
(USE.FILTER
[LAMBDA (FILTER) (* hdj " 1-Aug-84 20:41")
(* * choose which to use in spectrogram)
(PROG ((FILTERWINDOW (GETWINDOWPROP SPECW 'FILTERWINDOW))
PASSES SHUFFLEARRAY WEIGHTS)
(SELECTQ FILTER
(Narrow-band (SETQ PASSES 6)
(SETQ SHUFFLEARRAY SHUFFLE6)
(SETQ WEIGHTS KAISER6))
(Wide-band (SETQ PASSES 8)
(SETQ SHUFFLEARRAY SHUFFLE8)
(SETQ WEIGHTS KAISER8))
(HELP FILTER "is not a known type of filter."))
(SETQ SHUFFLE SHUFFLEARRAY)
(PUTWINDOWPROP SPECW 'PASSES PASSES)
(PUTWINDOWPROP SPECW 'BWINDOWWEIGHTSSHUFFLED (ARRAYBASE WEIGHTS))
(CLEARW FILTERWINDOW)
(printout FILTERWINDOW FILTER])
(\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])
(FIXME
[LAMBDA NIL (* hdj "29-Jul-84 11:23")
(PROG ((W (WHICHW))
B)
(SETQ B (GETWINDOWPROP W 'BORDER))
(PUTWINDOWPROP W 'BORDER 0)
(PUTWINDOWPROP W 'BORDER B])
(FX
[LAMBDA NIL (* hdj "29-Jul-84 13:17")
(FIXME) (* hdj "29-Jul-84 11:31")
(CH])
(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])
(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])
(SPEECHMENUINIT
[LAMBDA NIL (* edited: " 2-Aug-84 20:57")
[SETQ SPECTRUMMENU (create MENU
TITLE ← "Spectrogram controls:"
MENUROWS ← 4
ITEMS ← '(("Read a new wave file" (GET.WAVE.AND.READ)
"Reads a new wave file")
("Set spectrogram bar height" (GET.BARHEIGHT)
"Sets height of each horiz. bar to either 1 or 2"]
(* SETQ SPECTRUMMENU (create MENU TITLE ← "Spectrogram controls:" MENUROWS ← 4 ITEMS ← (QUOTE
(("Use narrow-band filter" (USE.FILTER (QUOTE Narrow-band)) "Chooses narrow-band Kaiser window")
("Use wide-band filter" (USE.FILTER (QUOTE Wide-band)) "Chooses wide-band Kaiser window")
("Read a new wave file" (GET.WAVE.AND.READ) "Reads a new wave file") ("Set spectrogram bar height"
(GET.BARHEIGHT) "Sets height of each horiz. bar to either 1 or 2")))))
(SETQ BARHEIGHTMENU (create MENU
TITLE ← "Choose the bar height:"
ITEMS ← '((1 1 "Sets bar height to 1")
(2 2 "Sets bar height to 2"))
MENUROWS ← 1
ITEMWIDTH ← 80))
NIL])
(FFTSTEP
[LAMBDA (FFTTABLE) (* hdj "23-Jul-84 23:50")
(\BLT \FFTTABLE FFTTABLE \FFTTABLESIZE)
(\FFTSTEP \FFTTABLE (fetch (FFTTABLE LCNT) of FFTTABLE])
(SPEECHDEMOINIT
[LAMBDA (WAVEFILE PASSES FIRSTBYTE) (* hdj " 3-Aug-84 16:16")
(SETQ SHUFFLE6 (DOUBLEPERMINIT 6))
(SETQ SHUFFLE8 (DOUBLEPERMINIT 8))
(SETQ SHUFFLE (COND
((EQ PASSES 6)
SHUFFLE6)
(T SHUFFLE8)))
(SETQ SUBWAVESHUFFLEDSMALLP (ARRAY 512 'WORD 0 0))
(SETQ SUBWAVESHUFFLEDFLOATP (ARRAY 512 'FLOATP 0.0 0))
(SETQ SUBWAVEWEIGHTEDFLOATP (ARRAY 512 '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 FFTOUT (ARRAY 512 'FLOATP 0 0 256))
(SETQ MAGNITUDESQUARED (ARRAY 256 'FLOATP 0.0 0))
(SETQ LOGMAGNITUDE (ARRAY 256 'WORD 0 0))
(SETQ WAVE (ARRAY 50000 'WORD 0 0))
(READWAVE WAVE 0 50000 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)))
(PROGN (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 BFFTOUT (ARRAYBASE FFTOUT)) (* pointer to last complex (i.e. last quadword of array)
)
(SETQ BFFTBUF1 (ARRAYBASE FFTBUF1))
(SETQ BFFTBUF2 (ARRAYBASE FFTBUF2))
(SETQ BFFTBUF1END (\ADDBASE BFFTBUF1 (IDIFFERENCE (LLSH 4 PASSES)
4)))
(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) (* edited: " 3-Aug-84 00:51")
(DECLARE (LOCALVARS . T))
(PROG ((PASSES (GETWINDOWPROP WINDOW 'PASSES))
(DATAREGION (GETWINDOWPROP WINDOW 'DATAREGION))
(LEFT (fetch (REGION LEFT) of REGION))
(BHALFTONE (ARRAYBASE HALFTONE))
(BLOGMAGNITUDE1 (\ADDBASE BLOGMAGNITUDE 1))
(BASE (BASEADDROFY WINDOW 0))
[DD (fetch IMAGEDATA of (GETWINDOWPROP WINDOW 'DSP]
(SCREENWIDTHINWORDS 64)
(BWINDOWWEIGHTSSHUFFLED (GETWINDOWPROP WINDOW 'BWINDOWWEIGHTSSHUFFLED))
(BFFTTABLE (ARRAYBASE FFTTABLE))
(BARHEIGHT (GETWINDOWPROP WINDOW 'BARHEIGHT))
(WindowToDataFactor (GETWINDOWPROP WINDOW 'WindowToDataFactor))
(BOTTOM.X.SCALE.OFFSET (GETWINDOWPROP WINDOW 'BOTTOM.X.SCALE.OFFSET))
(GWIDTH (GETWINDOWPROP WINDOW 'BARWIDTH))
PASSESMINUS1 START END WINDOWBASE XPOS BARHEIGHT TWICEFFTSHIFT TWICEGWIDTH
TWICEARRAYLENGTH ARRAYLENGTH HALFARRAYLENGTH TBL1 TBL2 TBL3 TBL4 TBL5 TBL6 TBL7 TBL8)
(SETQ TWICEFFTSHIFT (IPLUS FFTSHIFT FFTSHIFT))
(SETQ ARRAYLENGTH (LLSH 1 PASSES))
(SETQ TWICEARRAYLENGTH (IPLUS ARRAYLENGTH ARRAYLENGTH))
(SETQ TWICEGWIDTH (IPLUS GWIDTH GWIDTH)) (* SETQ WIDTH (IDIFFERENCE (fetch
(REGION WIDTH) of REGION) (SUB1 TWICEGWIDTH)))
(SETQ WIDTH (IMIN (fetch (REGION WIDTH) of REGION)
(IDIFFERENCE (fetch (REGION WIDTH) of DATAREGION)
TWICEGWIDTH)))
(SETQ TBL1 (\GETBASEPTR BFFTTABLE 0))
(SETQ TBL2 (\GETBASEPTR BFFTTABLE 2))
(SETQ TBL3 (\GETBASEPTR BFFTTABLE 4))
(SETQ TBL4 (\GETBASEPTR BFFTTABLE 6))
(SETQ TBL5 (\GETBASEPTR BFFTTABLE 8))
(SETQ TBL6 (\GETBASEPTR BFFTTABLE 10))
(SETQ TBL7 (\GETBASEPTR BFFTTABLE 12))
(SETQ TBL8 (\GETBASEPTR BFFTTABLE 14))
(SETQ BARHEIGHT (GETWINDOWPROP WINDOW 'BARHEIGHT))
(SETQ PASSESMINUS1 (SUB1 PASSES))
[SETQ DATALEFT (OR DATALEFT (GETWINDOWPROP WINDOW 'DATALEFT]
(* = (EXPT 2 PASSES))
(TOTOPW WINDOW)
(SETQ HALFARRAYLENGTH (HALF ARRAYLENGTH))
[SETQ WINDOWBASE (\ADDBASE BASE (IMINUS (ITIMES (IPLUS (HALF BOTTOM.X.SCALE.OFFSET)
(ITIMES BARHEIGHT HALFARRAYLENGTH))
64]
(SETQ XPOS (IPLUS DATALEFT (fetch (REGION LEFT) of REGION)))
(SETQ START (FIX (FTIMES (FQUOTIENT FFTSHIFT GWIDTH)
XPOS)))
[SETQ END (FIX (FTIMES (FQUOTIENT FFTSHIFT GWIDTH)
(IPLUS XPOS WIDTH]
(for DATAPTR from START to END by TWICEFFTSHIFT as WINDOWPTR from LEFT by TWICEGWIDTH
do (\BLKPERM (\ADDBASE BWAVE DATAPTR)
BSHUFFLE BSUBWAVESHUFFLEDSMALLP TWICEARRAYLENGTH)
(\BLKSMALLP2FLOAT BSUBWAVESHUFFLEDSMALLP BSUBWAVESHUFFLEDFLOATP TWICEARRAYLENGTH)
(\BLKFTIMES BSUBWAVESHUFFLEDFLOATP BWINDOWWEIGHTSSHUFFLED BFFTBUF1 TWICEARRAYLENGTH)
(FFTSTEP TBL1)
(FFTSTEP TBL2)
(FFTSTEP TBL3)
(FFTSTEP TBL4)
(FFTSTEP TBL5)
(FFTSTEP TBL6)
(FFTSTEP TBL7)
(FFTSTEP TBL8)
(\BLKSEP BFFTBUF1END BFFTBUF1 BFFTOUT HALFARRAYLENGTH)
(\BLKMAG BFFTOUT BMAGNITUDESQUARED ARRAYLENGTH)
(\BLKEXPONENT BMAGNITUDESQUARED BLOGMAGNITUDE ARRAYLENGTH)
(* IBLT BLOGMAGNITUDE BHALFTONE
(\DSPTRANSFORMX WINDOWPTR DD) WINDOWBASE
SCREENWIDTHINWORDS BARHEIGHT GWIDTH HALFARRAYLENGTH)
(IBLT2 BLOGMAGNITUDE BHALFTONE (\DSPTRANSFORMX WINDOWPTR DD)
WINDOWBASE SCREENWIDTHINWORDS BARHEIGHT GWIDTH HALFARRAYLENGTH)
(IBLT2 BLOGMAGNITUDE1 BHALFTONE (IPLUS (\DSPTRANSFORMX WINDOWPTR DD)
GWIDTH)
WINDOWBASE SCREENWIDTHINWORDS BARHEIGHT GWIDTH HALFARRAYLENGTH])
(SPECTRUMREDISPLAY
[LAMBDA (WINDOW REGION) (* hdj "23-Jul-84 16:23")
(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))
(BFFTTABLE (ARRAYBASE FFTTABLE))
(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 0 to (SUB1 PASSES) do (FFTSTEP (\GETBASEPTR BFFTTABLE
(LLSH PASS 1]
(\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 " 2-Aug-84 11:27")
(PROG ((WINDOW (CREATEW SPECWREGION (CONCAT "Spectrogram of " FILENAME)))
(FILTERWINDOW (CREATEW (CREATEREGION 0 0 120 35)
"Filter in use:"))
(BARHEIGHTWINDOW (CREATEW (CREATEREGION 0 0 110 35)
"Bar height:"))
(BARHEIGHTFONT (FONTCREATE 'HELVETICA 36 'MRR))
FILELENGTH)
(SETQ SPECW WINDOW) (* global SPECW -
losing!)
(PUTWINDOWPROP WINDOW 'BARHEIGHTWINDOW BARHEIGHTWINDOW)
(PUTWINDOWPROP WINDOW 'FILTERWINDOW FILTERWINDOW)
(PUTWINDOWPROP BARHEIGHTWINDOW 'MINSIZE (CONS 110 35))
(PUTWINDOWPROP FILTERWINDOW 'MINSIZE (CONS 120 35))
(SPEECHDEMOINIT FILENAME NUMPASSES FIRSTBYTE)
(SETQ FILELENGTH (IMIN (GETFILEINFO FILENAME 'LENGTH)
(ARRAYSIZE WAVE)))
(SPEECHMENUINIT)
(DSPFONT BARHEIGHTFONT BARHEIGHTWINDOW)
(ATTACHMENU SPECTRUMMENU WINDOW 'TOP 'LEFT)
(ATTACHWINDOW FILTERWINDOW (WFROMMENU SPECTRUMMENU)
'RIGHT NIL 'HERE)
(ATTACHWINDOW BARHEIGHTWINDOW FILTERWINDOW 'RIGHT NIL 'HERE)
(CLEARW FILTERWINDOW)
(PRIN1 'Wide-band FILTERWINDOW)
(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 2)
(CLEARW BARHEIGHTWINDOW)
(PRIN1 2 BARHEIGHTWINDOW)
(PUTWINDOWPROP WINDOW 'BWINDOWWEIGHTSSHUFFLED (ARRAYBASE KAISER8))
(SCALED.WINDOW.SETUP WINDOW 0 5000 30 30 'SPECTRUMSCALEDREDISPLAY NIL NIL 'NEWSCROLL)
(PUTWINDOWPROP WINDOW 'RESHAPEFN 'DON%'T)
(RETURN WINDOW])
)
(RPAQQ FFTSHIFT 100)
(RPAQQ NTP ((145 . 0)
(146 . 2)
(148 . 9)
(255 . 15)))
(RPAQQ OSCILLOSCOPEREGION (15 0 700 170))
(RPAQQ SAMPLESPERSECOND 10000)
(RPAQQ SINGLEHEIGHT 170)
(RPAQQ SPECWREGION (15 200 700 340))
(RPAQQ BARHEIGHTMENU NIL)
(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 CORRECT MACRO [LAMBDA (X)
(COND
((ILESSP X 128)
(IPLUS X 128))
(T (IDIFFERENCE 256 X])
(PUTPROPS ConvertWindowToFFTCoords MACRO [LAMBDA (WINDOWPTR WindowToDataFactor)
(* * converts window x-coord to file coord)
(FTIMES WINDOWPTR WindowToDataFactor])
(PUTPROPS FFTSTEP DMACRO [LAMBDA (FFTTABLE)
(* edited: "25-Jun-84 01:24")
(\BLT \FFTTABLE FFTTABLE \FFTTABLESIZE)
(\FFTSTEP \FFTTABLE (fetch (FFTTABLE LCNT)
of FFTTABLE])
)
(PUTPROPS BLOCKFLOAT COPYRIGHT ("I" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1611 24659 (DOUBLEPERMINIT 1621 . 2039) (DRAW.THRESHOLDS 2041 . 2349) (GET.BARHEIGHT
2351 . 2814) (GET.WAVE.AND.READ 2816 . 3478) (KAISERMENUINIT 3480 . 3982) (MAKE.THRESHOLD.WINDOW 3984
. 4359) (SD 4361 . 4492) (SDINIT 4494 . 5809) (ARRAYBASE 5811 . 5940) (CH 5942 . 6064) (CORRECT 6066
. 6247) (NEWSCROLL 6249 . 11207) (NEWTHRESH 11209 . 11550) (PCORRECT 11552 . 11713) (
UPDATE.SCALED.WINDOW.EXTENT 11715 . 12256) (USE.FILTER 12258 . 13037) (\CHECKARRAYINDEX 13039 . 13260)
(FFTTABLEINIT 13262 . 14674) (FIN 14676 . 14814) (FIN2 14816 . 14961) (FIXME 14963 . 15217) (FX 15219
. 15426) (INITFFT 15428 . 16925) (PERMINIT 16927 . 17834) (READWAVE 17836 . 18683) (SPEECHDEMO 18685
. 19828) (SPEECHMENUINIT 19830 . 20980) (FFTSTEP 20982 . 21198) (SPEECHDEMOINIT 21200 . 23219) (TRYIT
23221 . 23482) (BASEADDROFY 23484 . 23842) (ConvertWindowToFFTCoords 23844 . 24068) (SETCOMPLEX 24070
. 24285) (SD2 24287 . 24657)) (24853 34258 (\FLOATBLT1.UFN 24863 . 25297) (\FLOATBLT2.UFN 25299 .
25578) (\IBLT.UFN 25580 . 26700) (BLKGRAPH3 26702 . 27822) (BLKGRAPH4 27824 . 28334) (BLKMAG 28336 .
28943) (BLKSMALLP2FLOAT 28945 . 29386) (BLKFLOATP2COMP 29388 . 29910) (BLKFTIMES 29912 . 30319) (
BLKPERM 30321 . 30871) (BLKEXPONENT 30873 . 31375) (BLKGRAPH 31377 . 31936) (BLKGRAPH2 31938 . 34256))
(34448 44537 (COPYWAVEARRAY 34458 . 35443) (RESETHALFTONE 35445 . 35797) (SPECTRUMSCALEDREDISPLAY
35799 . 39724) (SPECTRUMREDISPLAY 39726 . 41563) (SPEECHDEMOWINDOWINIT 41565 . 42482) (
SPEECHDEMOSCALEDWINDOWINIT 42484 . 44535)))))
STOP