(FILECREATED "11-Jun-85 13:52:03" {ERIS}<LISPCORE>BUSMASTER>NEWRTSD.;2 48085
changes to: (VARS HALFTONE)
previous date: "10-Jan-85 18:11:31" {ERIS}<LISPCORE>BUSMASTER>NEWRTSD.;1)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NEWRTSDCOMS)
(RPAQQ NEWRTSDCOMS ((FILES PCDAC)
(TEMPLATES GETWINDOWPROP PUTWINDOWPROP WINDOWPROP)
(PROP DOPVAL \FFTSTEP)
(FNS FFTSTEP PLAY RECORD.IT RTSDINIT FFTTABLEINIT RTSDMAKEWINDOW RTSD RTSD.DOUBLEPERMINIT
RTSD.MAKEMENU RTSD.PERMINIT RTSD.PLAY RTSD.RECORD RTSD.SHOWLEFTLEGEND
RTSD.WHENSELECTEDFN RTSDRIGHTBUTTONFN BASEADDROFY SPECTRO \ARRAYCHECK)
(MACROS ARRAYBASE FFTSTEP)
(CONSTANTS SCREENWIDTHINWORDS)
(VARS ARRAYCHECKFLG KAISER8 HALFTONE PI RTSDRightMenu \FFTTABLESIZE)
(RECORDS FFTTABLE)
(ADVISE PCDAC.READERROR)))
(FILESLOAD PCDAC)
(SETTEMPLATE (QUOTE GETWINDOWPROP)
(QUOTE (EVAL PROP . PPE)))
(SETTEMPLATE (QUOTE PUTWINDOWPROP)
(QUOTE (EVAL PROP EVAL)))
(SETTEMPLATE (QUOTE WINDOWPROP)
(QUOTE (EVAL PROP EVAL)))
(PUTPROPS \FFTSTEP DOPVAL (2 FFTSTEP))
(DEFINEQ
(FFTSTEP
[LAMBDA (FFTTABLE) (* hdj "23-Jul-84 23:50")
(\BLT \FFTTABLE FFTTABLE \FFTTABLESIZE)
(\FFTSTEP \FFTTABLE (fetch (FFTTABLE LCNT) of FFTTABLE])
(PLAY
[LAMBDA (BASE SIZE) (* hdj "10-Jan-85 16:52")
(\BUSBLTOUTBYTES BASE 1 0 SIZE])
(RECORD.IT
[LAMBDA (FREQKHZ) (* hdj "10-Jan-85 17:04")
(LET ((PCPAGE 1)
(PCMEMSIZEINWORDS 32768)
(CLOCKRATE (FIX (FQUOTIENT (FQUOTIENT 1.0 (FTIMES FREQKHZ 1000.0))
1.25E-6)))
(DACCHANNEL 0)
(DACGAINCODE 3))
(PCDAC.STOP)
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK CLOCKRATE)
(PCDAC.SETUPDMA PCPAGE 0 PCMEMSIZEINWORDS T T)
(PCDAC.SETA/DPARAMETERS DACGAINCODE DACCHANNEL)
(PCDAC.STARTREADA/D T T])
(RTSDINIT
[LAMBDA NIL (* hdj " 8-Jan-85 17:12")
(* * set up all non-window globals and arrays, and call RTSDMAKEWINDOW)
(* * PASSES=8 is built in as KAISER8 and in RTSD's unfolded inner loop -- that FFTSHIFT = HALFARRAYLENGTH is built
into RTSD's pointer-moving logic -- WAVESIZE has to be a large power of 2, and is built into the i/o synchronization
logic of RTSD -- WAVE has an extra FFTSHIFT = HALFARRAYLENGTH on the end for RTSD's wrapping logic)
(PROG (HALFARRAYLENGTH TWICEARRAYLENGTH ARRAYLENGTH FFTSHIFT WAVESIZE WINDOW PASSES WAVE SHUFFLE
SUBWAVESHUFFLEDSMALLP SUBWAVESHUFFLEDFLOATP WINDOWWEIGHTSSHUFFLED
SUBWAVEWEIGHTEDFLOATP SUBWAVEWEIGHTEDCOMPLEX FFTBUF1 BFFTBUF1 FFTBUF2
BFFTBUF2 FFTOUT MAGNITUDESQUARED LOGMAGNITUDE TICKHEIGHT BARHEIGHT
STRIPEWIDTH NRSTRIPES FFTTABLE INITFREQ)
(* * "initialize constants")
(SETQ INITFREQ 5) (* "initial sampling rate is 5 khz")
(SETQ PASSES 8)
(SETQ ARRAYLENGTH (LLSH 1 PASSES))
(SETQ HALFARRAYLENGTH (LRSH ARRAYLENGTH 1))
(SETQ FFTSHIFT HALFARRAYLENGTH)
(SETQ TWICEARRAYLENGTH (LLSH ARRAYLENGTH 1))
(SETQ WAVESIZE 32768)
(SETQ BARHEIGHT 1)
(SETQ STRIPEWIDTH 4)
(SETQ NRSTRIPES 236)
(SETQ TICKHEIGHT 3)
(* * set up arrays)
(SETQ WAVE (ARRAY (IPLUS WAVESIZE HALFARRAYLENGTH)
(QUOTE WORD)
0 0))
(SETQ SHUFFLE (RTSD.DOUBLEPERMINIT ARRAYLENGTH FFTSHIFT))
(SETQ SUBWAVESHUFFLEDSMALLP (ARRAY TWICEARRAYLENGTH (QUOTE WORD)
0 0))
(SETQ SUBWAVESHUFFLEDFLOATP (ARRAY TWICEARRAYLENGTH (QUOTE FLOATP)
0.0 0))
(SETQ WINDOWWEIGHTSSHUFFLED KAISER8)
(SETQ SUBWAVEWEIGHTEDFLOATP (ARRAY TWICEARRAYLENGTH (QUOTE FLOATP)
0.0 0))
(SETQ SUBWAVEWEIGHTEDCOMPLEX (ARRAY TWICEARRAYLENGTH (QUOTE FLOATP)
0.0 0))
[SETQ BFFTBUF1 (ARRAYBASE (SETQ FFTBUF1 (ARRAY TWICEARRAYLENGTH (QUOTE FLOATP)
0 0 128]
[SETQ BFFTBUF2 (ARRAYBASE (SETQ FFTBUF2 (ARRAY TWICEARRAYLENGTH (QUOTE FLOATP)
0 0 128]
(SETQ FFTOUT (ARRAY TWICEARRAYLENGTH (QUOTE FLOATP)
0 0 128))
(SETQ MAGNITUDESQUARED (ARRAY ARRAYLENGTH (QUOTE FLOATP)
0.0 0))
(SETQ LOGMAGNITUDE (ARRAY ARRAYLENGTH (QUOTE WORD)
0 0))
(SETQ \FFTTABLE (create FFTTABLE))
(SETQ FFTTABLE (FFTTABLEINIT BFFTBUF1 BFFTBUF2 PASSES))
(* * set up a window)
(SETQ WINDOW (RTSDMAKEWINDOW ARRAYLENGTH 2 NRSTRIPES STRIPEWIDTH TICKHEIGHT))
(WINDOWPROP WINDOW (QUOTE TICKHEIGHT)
TICKHEIGHT)
(WINDOWPROP WINDOW (QUOTE BARHEIGHT)
BARHEIGHT)
(WINDOWPROP WINDOW (QUOTE STRIPEWIDTH)
STRIPEWIDTH)
(WINDOWPROP WINDOW (QUOTE NRSTRIPES)
NRSTRIPES)
(WINDOWPROP WINDOW (QUOTE ARRAYLENGTH)
ARRAYLENGTH)
(WINDOWPROP WINDOW (QUOTE FFTSHIFT)
FFTSHIFT)
(WINDOWPROP WINDOW (QUOTE WAVESIZE)
WAVESIZE)
(WINDOWPROP WINDOW (QUOTE WAVE)
WAVE)
(WINDOWPROP WINDOW (QUOTE SHUFFLE)
SHUFFLE)
(WINDOWPROP WINDOW (QUOTE SUBWAVESHUFFLEDSMALLP)
SUBWAVESHUFFLEDSMALLP)
(WINDOWPROP WINDOW (QUOTE SUBWAVESHUFFLEDFLOATP)
SUBWAVESHUFFLEDFLOATP)
(WINDOWPROP WINDOW (QUOTE WINDOWWEIGHTSSHUFFLED)
WINDOWWEIGHTSSHUFFLED)
(WINDOWPROP WINDOW (QUOTE FFTBUF1)
FFTBUF1)
(WINDOWPROP WINDOW (QUOTE FFTBUF2)
FFTBUF2)
(WINDOWPROP WINDOW (QUOTE FFTOUT)
FFTOUT)
(WINDOWPROP WINDOW (QUOTE MAGNITUDESQUARED)
MAGNITUDESQUARED)
(WINDOWPROP WINDOW (QUOTE LOGMAGNITUDE)
LOGMAGNITUDE)
(WINDOWPROP WINDOW (QUOTE HALFTONE)
(COPYALL HALFTONE))
(WINDOWPROP WINDOW (QUOTE FFTTABLE)
FFTTABLE)
(WINDOWPROP WINDOW (QUOTE FREQ)
INITFREQ)
(RETURN WINDOW])
(FFTTABLEINIT
[LAMBDA (FFTBUF1 FFTBUF2 PASSES) (* hdj " 4-Jan-85 18:17")
(PROG ((\FFTTABLES (ARRAY PASSES (QUOTE POINTER)
NIL NIL 8))
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])
(RTSDMAKEWINDOW
[LAMBDA (ARRAYLENGTH BARHEIGHT NRSTRIPES STRIPEWIDTH TICKHEIGHT)
(* hdj " 8-Jan-85 17:12")
(* * window width of 236 stripes is approx 3 sec, and has to be an even number, for RTSD)
(PROG ((WINDOWTITLE "Real Time Spectrogram")
(SCREENWIDTHINDOTS (UNFOLD SCREENWIDTHINWORDS BITSPERWORD))
(WINDOWMARGIN 4)
(WINDOWTITLEBARHEIGHT 12)
(WINDOWBOTTOM 50)
(LEFTLEGENDWWIDTH 40)
BOTTOMLEGENDW LEFTLEGENDW (BOTTOMLEGENDHEIGHT 40)
(HALFARRAYLENGTH (HALF ARRAYLENGTH))
STRIPEHEIGHT X W H WINDOW MENU)
(SETQ STRIPEHEIGHT (ITIMES BARHEIGHT HALFARRAYLENGTH))
(SETQ W (IPLUS (ITIMES WINDOWMARGIN 2)
(ITIMES NRSTRIPES STRIPEWIDTH)))
(SETQ X (IPLUS WINDOWMARGIN LEFTLEGENDWWIDTH 6))
(SETQ H (IPLUS WINDOWTITLEBARHEIGHT WINDOWMARGIN STRIPEHEIGHT TICKHEIGHT WINDOWMARGIN))
(SETQ WINDOW (CREATEW (CREATEREGION X WINDOWBOTTOM W H)
WINDOWTITLE))
(WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION RTSDRIGHTBUTTONFN))
(GETPROMPTWINDOW WINDOW 1)
(SETQ MENU (RTSD.MAKEMENU))
(ATTACHMENU MENU WINDOW (QUOTE TOP))
(SETQ LEFTLEGENDW (CREATEW (CREATEREGION (IDIFFERENCE X LEFTLEGENDWWIDTH)
WINDOWBOTTOM LEFTLEGENDWWIDTH H)))
(ATTACHWINDOW LEFTLEGENDW WINDOW (QUOTE LEFT))
(WINDOWPROP WINDOW (QUOTE LEFTLEGENDW)
LEFTLEGENDW)
(SETQ BOTTOMLEGENDW (CREATEW (CREATEREGION X (IDIFFERENCE WINDOWBOTTOM BOTTOMLEGENDHEIGHT)
W BOTTOMLEGENDHEIGHT)))
(ATTACHWINDOW BOTTOMLEGENDW WINDOW (QUOTE BOTTOM))
(WINDOWPROP WINDOW (QUOTE BOTTOMLEGENDW)
BOTTOMLEGENDW)
(RETURN WINDOW])
(RTSD
[LAMBDA (WINDOW) (* hdj " 8-Jan-85 17:13")
(* * this version has a maximum number of iterations, to cope with a microcode or compiler stack bug -- if stopped
thusly or via the STOP key, stops the DC board and draws vertical line marking end of scan -- FREQKHZ is the
sampling rate, possibly floating point, default 10 -- ERASEWIDTHINSTRIPES is number of stripes to erase at a time,
and MUST BE A POWER OF 2)
(* * window width of 236 stripes is approx 3 sec -- NRSTRIPES has to be an even number, to expedite doing 2 FFTs at
once)
(* * PASSES=8 is built in here, in the unfolded FFT-pass loop -- that FFTSHIFT = HALFARRAYLENGTH is also built in,
in the pointer moving logic)
(* * stopping at maximum number of iterations is controlled by MAXABSOLUTESTRIPE and ABSOLUTESTRIPE)
(* * WAVESIZE is a large power of 2 -- WAVE is FFTSHIFT = HALFARRAYLENGTH longer than WAVESIZE)
(DECLARE (LOCALVARS . T))
(PROG ((MAXABSOLUTESTRIPE 10000)
(PCPAGE 1)
(DACGAINCODE 3)
(DACCHANNEL 0)
(PCMEMSIZEINWORDS 32768)
(ARRAYLENGTH (WINDOWPROP WINDOW (QUOTE ARRAYLENGTH)))
(STRIPEWIDTH (WINDOWPROP WINDOW (QUOTE STRIPEWIDTH)))
(FREQKHZ (WINDOWPROP WINDOW (QUOTE FREQ)))
(PCDAC.DMACHANNEL (fetch (PCDAC.BOARDRECORD PCDACBOARD.DMACHANNEL) of PCDAC.BOARD))
(ERASEWIDTHINSTRIPES 2)
TWICEARRAYLENGTH TWICESTRIPEWIDTH HALFARRAYLENGTH DMAREADADDRESSCMD CLOCKRATE ERASEWIDTH
ERASEMASK TWICEFFTSHIFT BWAVEEND BFFTBUF1END BLOGMAGNITUDE1 HALFPCMEMSIZEINWORDS
WAVEWRITEPTR MAXWAVEWRITEPTR WAVEREADPTR MAXWAVEREADPTR SAMEARRAYLENGTHMASK WINDOWWIDTH
WINDOWHEIGHT WINDOWPTR MAXWINDOWPTR ARRAYLENGTH STRIPEWIDTH FFTSHIFT BWAVE WAVESIZE
BFFTBUF1 BLOGMAGNITUDE NRSTRIPES TICKHEIGHT STRIPEHEIGHT BFFTTABLE BSHUFFLE
BSUBWAVESHUFFLEDSMALLP BSUBWAVESHUFFLEDFLOATP BWINDOWWEIGHTSSHUFFLED BFFTOUT
BMAGNITUDESQUARED BHALFTONE WINDOWDD WINDOWBASE ABSOLUTESTRIPE BARHEIGHT TBL1 TBL2 TBL3
TBL4 TBL5 TBL6 TBL7 TBL8 I)
(* * initialize constants)
(SETQ HALFARRAYLENGTH (HALF ARRAYLENGTH))
(SETQ TWICEARRAYLENGTH (UNFOLD ARRAYLENGTH 2))
(SETQ TWICESTRIPEWIDTH (UNFOLD STRIPEWIDTH 2))
(SETQ FFTSHIFT (WINDOWPROP WINDOW (QUOTE FFTSHIFT)))
[SETQ BWAVE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE WAVE]
(SETQ WAVESIZE (WINDOWPROP WINDOW (QUOTE WAVESIZE)))
[SETQ BFFTBUF1 (ARRAYBASE (WINDOWPROP WINDOW (QUOTE FFTBUF1]
[SETQ BLOGMAGNITUDE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE LOGMAGNITUDE]
(SETQ NRSTRIPES (WINDOWPROP WINDOW (QUOTE NRSTRIPES)))
(SETQ TICKHEIGHT (WINDOWPROP WINDOW (QUOTE TICKHEIGHT)))
(SETQ BARHEIGHT (WINDOWPROP WINDOW (QUOTE BARHEIGHT)))
(SETQ STRIPEHEIGHT (ITIMES BARHEIGHT HALFARRAYLENGTH))
[SETQ BFFTTABLE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE FFTTABLE]
[SETQ BSHUFFLE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE SHUFFLE]
[SETQ BSUBWAVESHUFFLEDSMALLP (ARRAYBASE (WINDOWPROP WINDOW (QUOTE SUBWAVESHUFFLEDSMALLP]
[SETQ BSUBWAVESHUFFLEDFLOATP (ARRAYBASE (WINDOWPROP WINDOW (QUOTE SUBWAVESHUFFLEDFLOATP]
[SETQ BWINDOWWEIGHTSSHUFFLED (ARRAYBASE (WINDOWPROP WINDOW (QUOTE WINDOWWEIGHTSSHUFFLED]
[SETQ BFFTOUT (ARRAYBASE (WINDOWPROP WINDOW (QUOTE FFTOUT]
[SETQ BMAGNITUDESQUARED (ARRAYBASE (WINDOWPROP WINDOW (QUOTE MAGNITUDESQUARED]
[SETQ BHALFTONE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE HALFTONE]
(SETQ WINDOWDD (\GETDISPLAYDATA WINDOW))
[SETQ WINDOWBASE (\ADDBASE (BASEADDROFY WINDOW 0)
(IMINUS (ITIMES (IPLUS STRIPEHEIGHT TICKHEIGHT -1)
SCREENWIDTHINWORDS]
(* DAC clock runs in 1.25 microsecond ticks)
(SETQ CLOCKRATE (FIX (FQUOTIENT (FQUOTIENT 1.0 (FTIMES FREQKHZ 1000.0))
1.25E-6)))
(SETQ DMAREADADDRESSCMD (LLSH PCDAC.DMACHANNEL 1))
(* command to read first low then high byte of dma
channel 1's current-address register)
(SETQ ERASEWIDTH (ITIMES STRIPEWIDTH ERASEWIDTHINSTRIPES))
(SETQ ERASEMASK (SUB1 ERASEWIDTH))
(SETQ TWICEFFTSHIFT (LLSH FFTSHIFT 1))
(SETQ BWAVEEND (\ADDBASE BWAVE WAVESIZE))
(SETQ BFFTBUF1END (\ADDBASE BFFTBUF1 (IDIFFERENCE (ITIMES ARRAYLENGTH 4)
4)))
(SETQ BLOGMAGNITUDE1 (\ADDBASE BLOGMAGNITUDE 1))
(SETQ HALFPCMEMSIZEINWORDS (HALF PCMEMSIZEINWORDS))
(SETQ MAXWAVEWRITEPTR (IDIFFERENCE WAVESIZE FFTSHIFT))
(SETQ MAXWAVEREADPTR (IDIFFERENCE WAVESIZE TWICEFFTSHIFT))
[SETQ SAMEARRAYLENGTHMASK (LOGAND (SUB1 PCMEMSIZEINWORDS)
(LOGNOT (SUB1 ARRAYLENGTH]
(SETQ WINDOWWIDTH (ITIMES NRSTRIPES STRIPEWIDTH))
(SETQ WINDOWHEIGHT (IPLUS TICKHEIGHT STRIPEHEIGHT))
(SETQ MAXWINDOWPTR (IDIFFERENCE WINDOWWIDTH TWICESTRIPEWIDTH))
(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))
(* * initialize window)
(TOTOPW WINDOW)
(DSPRESET WINDOW)
(* * set up DAC and DMA)
(PCDAC.STOP)
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK CLOCKRATE)
(PCDAC.SETUPDMA PCPAGE 0 PCMEMSIZEINWORDS T T)
(PCDAC.SETA/DPARAMETERS DACGAINCODE DACCHANNEL)
(* * beep and start collection -- suck in half the usual amount of data points, to prime WAVE -- we dont have to
mask the dma channel while reading its 2-byte current-address register, because we only care about its high byte)
(BEEPON 500)
(DISMISS 100)
(BEEPOFF)
(PCDAC.STARTREADA/D T T)
(while (ILESSP (BUSDMA.READADDRESS PCDAC.DMACHANNEL)
(LLSH FFTSHIFT 1))
do (PCDAC.SHOWERROR))
(\BUSBLTINBYTES BWAVE PCPAGE 0 FFTSHIFT)
(* * initialize loop -- NOTE that the PC read pointer (in words) is being kept as WAVEWRITEPTR)
(SETQ ABSOLUTESTRIPE 0)
(SETQ WINDOWPTR 0)
(SETQ WAVEREADPTR 0)
(SETQ WAVEWRITEPTR FFTSHIFT)
(* * do until count limit or STOP key)
(until (OR (IGREATERP ABSOLUTESTRIPE MAXABSOLUTESTRIPE)
(KEYDOWNP (QUOTE STOP))
(KEYDOWNP (QUOTE LEFT)))
do
(* * possibly erase ahead)
(if (ZEROP (LOGAND WINDOWPTR ERASEMASK))
then (BITBLT NIL NIL NIL WINDOW WINDOWPTR 0 (IMIN ERASEWIDTH (IDIFFERENCE
WINDOWWIDTH
WINDOWPTR))
WINDOWHEIGHT
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE))
(* * wait for data to be available from the PC memory (which we are using as a circular buffer, with help from the
dma controller) -- that is, wait until the DAC's DMA write pointer into PC memory is not in the ARRAYLENGTH words
circularly at/after our PC memory read pointer -- that is, until the difference between the DAC's DMA write pointer
modulo the size of the PC memory, is not less than ARRAYLENGTH -- NOTE that the PC read pointer
(in words) is being kept as WAVEWRITEPTR -- we use PCINPUT here directly for speed, the effect being the same as a
PCDMA.READADDRESS except for -- NOTE that we don't care about the low byte of the dma address, so we can ignore it,
AND we dont have to mask the dma channel while reading this 2-byte register -- NOTE that a DAC error will stop dma
activity, so we will catch up, so we will then notice the error)
(while [ZEROP (LOGAND SAMEARRAYLENGTHMASK (SETQ I (IDIFFERENCE
(LLSH (PROGN (BUS.INPUT DMAREADADDRESSCMD)
(BUS.INPUT DMAREADADDRESSCMD))
7)
WAVEWRITEPTR]
do (PCDAC.SHOWERROR))
(* * and IF we are half-lapped, that is if the PC memory dma write pointer is within half of the PC memory of
catching up with our PC memory read pointer, THEN draw a "half-lapped" tick -- that is, of the STRIPEWIDTH by
TICKHEIGHT space available under the left stripe, draw the lower left 2x2)
(if (NOT (ZEROP (LOGAND I HALFPCMEMSIZEINWORDS)))
then (BITBLT NIL NIL NIL WINDOW WINDOWPTR 0 2 2 (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE))
(* * get two FFTSHIFTs worth of data from the PC memory -- NOTE that the PC read pointer (in words) is being kept as
WAVEWRITEPTR)
(\BUSBLTINBYTES (\ADDBASE BWAVE WAVEWRITEPTR)
PCPAGE
(LLSH WAVEWRITEPTR 1)
TWICEFFTSHIFT)
(* * IF this block of data wraps around WAVE, then we need a copy of the 2nd FFTSHIFT of it at both ends of WAVE --
the \BUSBLTINBYTES just put a copy just past the end of WAVE, which is where the immediate next double-FFT needs it,
but we also have to copy it to the beginning of WAVE for the next double-FFT after this)
(if (EQ WAVEWRITEPTR MAXWAVEWRITEPTR)
then (\BLT BWAVE BWAVEEND FFTSHIFT))
(* * do double FFT)
(\BLKPERM (\ADDBASE BWAVE WAVEREADPTR)
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)
(* * draw both stripes of data)
(\IBLT2 BLOGMAGNITUDE BHALFTONE (\DSPTRANSFORMX WINDOWPTR WINDOWDD)
WINDOWBASE SCREENWIDTHINWORDS BARHEIGHT STRIPEWIDTH HALFARRAYLENGTH)
(\IBLT2 BLOGMAGNITUDE1 BHALFTONE (\DSPTRANSFORMX (IPLUS WINDOWPTR STRIPEWIDTH)
WINDOWDD)
WINDOWBASE SCREENWIDTHINWORDS BARHEIGHT STRIPEWIDTH HALFARRAYLENGTH)
(* * inc pointers)
(if (EQ WAVEWRITEPTR MAXWAVEWRITEPTR)
then (SETQ WAVEWRITEPTR FFTSHIFT)
else (SETQ WAVEWRITEPTR (PLUS WAVEWRITEPTR TWICEFFTSHIFT)))
(if (EQ WAVEREADPTR MAXWAVEREADPTR)
then (SETQ WAVEREADPTR 0)
else (SETQ WAVEREADPTR (IPLUS WAVEREADPTR TWICEFFTSHIFT)))
(if (EQ WINDOWPTR MAXWINDOWPTR)
then (SETQ WINDOWPTR 0)
else (SETQ WINDOWPTR (IPLUS WINDOWPTR TWICESTRIPEWIDTH)))
(SETQ ABSOLUTESTRIPE (IPLUS ABSOLUTESTRIPE 2)))
(* * draw line marking termination of scan -- and clear tick under the line if any)
(PCDAC.STOP)
(BITBLT NIL NIL NIL WINDOW WINDOWPTR 0 2 2 (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE)
(BITBLT NIL NIL NIL WINDOW WINDOWPTR TICKHEIGHT STRIPEWIDTH STRIPEHEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE])
(RTSD.DOUBLEPERMINIT
[LAMBDA (ARRAYLENGTH FFTSHIFT) (* hdj " 2-Jan-85 15:55")
(PROG ((TWICEARRAYLENGTH (LLSH ARRAYLENGTH 1))
(PERM (RTSD.PERMINIT ARRAYLENGTH))
DPERM)
(SETQ DPERM (ARRAY TWICEARRAYLENGTH (QUOTE WORD)
0 0))
(for I from 0 to (SUB1 ARRAYLENGTH)
do (SETA DPERM (IPLUS I I)
(ELT PERM I))
(SETA DPERM (IPLUS I I 1)
(IPLUS (ELT PERM I)
FFTSHIFT)))
(RETURN DPERM])
(RTSD.MAKEMENU
[LAMBDA NIL (* hdj " 8-Jan-85 17:16")
(SETQ RTSD.FREQMENU (create MENU
ITEMS ←(QUOTE (4 5 6 7 8 9 10))
TITLE ← "Set sampling rate (kHz)"
MENUROWS ← 2))
(SETQ RTSD.HEIGHTMENU (create MENU
ITEMS ←(QUOTE (1 2))
TITLE ← "Set stripe height"
MENUROWS ← 1))
(create MENU
ITEMS ←(QUOTE (("Play" PLAY "")
("Record" RECORD "")
("Real-time spectrum" RTSD "On-the-fly spectrum of signal as it's spoken")
("Spectrum" SPECTRUM "Spectrum of stored signal")
("Sampling rate" FREQ "Set the sampling rate (in KHz)")
("Height" HEIGHT "Set stripe height factor")))
WHENSELECTEDFN ←(FUNCTION RTSD.WHENSELECTEDFN])
(RTSD.PERMINIT
[LAMBDA (ARRAYLENGTH) (* hdj " 2-Jan-85 15:55")
(PROG ((HALFARRAYLENGTH (LRSH ARRAYLENGTH 1))
(PERM (ARRAY ARRAYLENGTH (QUOTE WORD)
0 0))
I J K TEMP)
(for I from 0 to (SUB1 ARRAYLENGTH) do (SETA PERM I I))
(SETQ J 1) (* Interchange elements)
(SETQ I 1) (* in bit-reversed order)
(repeatwhile (ILESSP I ARRAYLENGTH)
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 HALFARRAYLENGTH)
(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])
(RTSD.PLAY
[LAMBDA (WINDOW FREQKHZ STORED?) (* hdj "10-Jan-85 17:03")
(LET ((PCPAGE 1)
(PCMEMSIZEINWORDS 32768)
(CLOCKRATE (FIX (FQUOTIENT (FQUOTIENT 1.0 (FTIMES FREQKHZ 1000.0))
1.25E-6)))
(WAVESIZE (WINDOWPROP WINDOW (QUOTE WAVESIZE)))
[BWAVE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE WAVE]
(DACCHANNEL 0))
(PCDAC.STOP)
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK CLOCKRATE)
(if STORED?
then (\BUSBLTOUTBYTES BWAVE PCPAGE 0 WAVESIZE))
(PCDAC.SETUPDMA PCPAGE 0 PCMEMSIZEINWORDS NIL T)
(PCDAC.SETD/APARAMETERS DACCHANNEL)
(PCDAC.STARTWRITED/A T T])
(RTSD.RECORD
[LAMBDA (WINDOW) (* hdj "10-Jan-85 15:47")
(* * WAVESIZE is a large power of 2 -- WAVE is FFTSHIFT = HALFARRAYLENGTH longer than WAVESIZE)
(DECLARE (SPECVARS . T))
(PROG ((PCPAGE 1)
(DACGAINCODE 3)
(DACCHANNEL 0)
(PCMEMSIZEINWORDS 32768)
(FREQKHZ (WINDOWPROP WINDOW (QUOTE FREQ)))
(PCDAC.DMACHANNEL (fetch (PCDAC.BOARDRECORD PCDACBOARD.DMACHANNEL) of PCDAC.BOARD))
DMAREADADDRESSCMD
(NUMSAMPLES (WINDOWPROP WINDOW (QUOTE NUMSAMPLES)))
CLOCKRATE TWICENUMSAMPLES HALFPCMEMSIZEINWORDS WAVEWRITEPTR MAXWAVEWRITEPTR WAVEREADPTR
MAXWAVEREADPTR SAMEARRAYLENGTHMASK WINDOWPTR MAXWINDOWPTR BWAVE WAVESIZE)
(* * initialize constants)
[SETQ BWAVE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE WAVE]
(SETQ WAVESIZE (WINDOWPROP WINDOW (QUOTE WAVESIZE)))
(* DAC clock runs in 1.25 microsecond ticks)
(SETQ CLOCKRATE (FIX (FQUOTIENT (FQUOTIENT 1.0 (FTIMES FREQKHZ 1000.0))
1.25E-6)))
(SETQ DMAREADADDRESSCMD (LLSH PCDAC.DMACHANNEL 1))
(* command to read first low then high byte of dma
channel 1's current-address register)
(SETQ TWICENUMSAMPLES (LLSH NUMSAMPLES 1))
(SETQ HALFPCMEMSIZEINWORDS (HALF PCMEMSIZEINWORDS))
(SETQ MAXWAVEWRITEPTR (IDIFFERENCE WAVESIZE NUMSAMPLES))
(SETQ MAXWAVEREADPTR (IDIFFERENCE WAVESIZE TWICENUMSAMPLES))
[SETQ SAMEARRAYLENGTHMASK (LOGAND (SUB1 PCMEMSIZEINWORDS)
(LOGNOT (SUB1 NUMSAMPLES]
(* * set up DAC and DMA)
(PCDAC.STOP)
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK CLOCKRATE)
(PCDAC.SETUPDMA PCPAGE 0 PCMEMSIZEINWORDS T T)
(PCDAC.SETA/DPARAMETERS DACGAINCODE DACCHANNEL)
(* * beep and start collection -- suck in half the usual amount of data points, to prime WAVE -- we dont have to
mask the dma channel while reading its 2-byte current-address register, because we only care about its high byte)
(BEEPON 500)
(DISMISS 100)
(BEEPOFF)
(PCDAC.STARTREADA/D T T)
(while (ILESSP (BUSDMA.READADDRESS PCDAC.DMACHANNEL)
(LLSH NUMSAMPLES 1))
do (PCDAC.SHOWERROR))
(\BUSBLTINBYTES BWAVE PCPAGE 0 NUMSAMPLES)
(* * initialize loop -- NOTE that the PC read pointer (in words) is being kept as WAVEWRITEPTR)
(SETQ WINDOWPTR 0)
(SETQ WAVEREADPTR 0)
(SETQ WAVEWRITEPTR NUMSAMPLES)
(* * do until STOP or LEFT)
[until (OR (KEYDOWNP (QUOTE STOP))
(KEYDOWNP (QUOTE LEFT))
(IGEQ WAVEWRITEPTR MAXWAVEWRITEPTR))
do
(* * wait for data to be available from the PC memory (which we are using as a circular buffer, with help from the
dma controller) -- that is, wait until the DAC's DMA write pointer into PC memory is not in the NUMSAMPLES words
circularly at/after our PC memory read pointer -- that is, until the difference between the DAC's DMA write pointer
modulo the size of the PC memory, is not less than NUMSAMPLES -- NOTE that the PC read pointer
(in words) is being kept as WAVEWRITEPTR -- we use \BUSBLTINBYTES here directly for speed, the effect being the same
as a PCDMA.READADDRESS except for -- NOTE that we don't care about the low byte of the dma address, so we can ignore
it, AND we dont have to mask the dma channel while reading this 2-byte register -- NOTE that a DAC error will stop
dma activity, so we will catch up, so we will then notice the error)
(while (ZEROP (LOGAND SAMEARRAYLENGTHMASK (IDIFFERENCE (LLSH (PROGN (BUS.INPUT
DMAREADADDRESSCMD)
(BUS.INPUT
DMAREADADDRESSCMD))
7)
WAVEWRITEPTR)))
do (PCDAC.SHOWERROR))
(* * get data from the PC memory -- NOTE that the PC read pointer (in words) is being kept as WAVEWRITEPTR)
(\BUSBLTINBYTES (\ADDBASE BWAVE WAVEWRITEPTR)
PCPAGE
(LLSH WAVEWRITEPTR 1)
NUMSAMPLES)
(* * inc pointers)
(SETQ WAVEWRITEPTR (PLUS WAVEWRITEPTR TWICENUMSAMPLES))
(if (EQ WAVEREADPTR MAXWAVEREADPTR)
then (SETQ WAVEREADPTR 0)
else (SETQ WAVEREADPTR (IPLUS WAVEREADPTR TWICENUMSAMPLES]
(* * draw line marking termination of scan -- and clear tick under the line if any)
(PCDAC.STOP])
(RTSD.SHOWLEFTLEGEND
[LAMBDA (WINDOW) (* hdj " 7-Jan-85 23:17")
(LET [(FREQ (WINDOWPROP WINDOW (QUOTE FREQ)))
(HEIGHTFACTOR (WINDOWPROP WINDOW (QUOTE BARHEIGHT)))
(HEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
(LEFTLEGENDW (WINDOWPROP WINDOW (QUOTE LEFTLEGENDW)))
(FONT (FONTCREATE (QUOTE (GACHA 8 MRR]
(DSPRESET LEFTLEGENDW)
(DSPFONT FONT LEFTLEGENDW)
(MOVETO 0 (ITIMES HEIGHTFACTOR (HALF HEIGHT))
LEFTLEGENDW)
(PRIN3 (CONCAT (FQUOTIENT FREQ 2)
"kHz")
LEFTLEGENDW)
(BITBLT NIL NIL NIL LEFTLEGENDW 0 (IPLUS (FONTPROP FONT (QUOTE HEIGHT))
(ITIMES HEIGHTFACTOR (HALF HEIGHT)))
NIL NIL (QUOTE TEXTURE)
(QUOTE PAINT)
BLACKSHADE])
(RTSD.WHENSELECTEDFN
[LAMBDA (ITEM MENU BUTTON) (* hdj " 8-Jan-85 17:16")
(LET [(MAINWINDOW (MAINWINDOW (WFROMMENU MENU)))
(MENUITEM (if (ATOM ITEM)
then ITEM
else (CADR ITEM]
(SELECTQ MENUITEM
(PLAY NIL)
(RECORD NIL)
(RTSD (RTSD MAINWINDOW))
[SPECTRUM (SPECTRO MAINWINDOW (CREATEREGION 0 0 (WINDOWPROP MAINWINDOW (QUOTE WIDTH))
(WINDOWPROP MAINWINDOW (QUOTE HEIGHT]
[HEIGHT (LET ((HEIGHT (MENU RTSD.HEIGHTMENU)))
(if HEIGHT
then (WINDOWPROP MAINWINDOW (QUOTE BARHEIGHT)
HEIGHT)
(printout (GETPROMPTWINDOW MAINWINDOW)
T "Spectrogram stripe factor is now " HEIGHT)
(RTSD.SHOWLEFTLEGEND MAINWINDOW)
else (printout (GETPROMPTWINDOW MAINWINDOW)
T "Spectrogram stripe factor is " (WINDOWPROP MAINWINDOW
(QUOTE
BARHEIGHT))
" - unchanged"]
[FREQ (LET ((FREQ (MENU RTSD.FREQMENU)))
(if FREQ
then (WINDOWPROP MAINWINDOW (QUOTE FREQ)
FREQ)
(printout (GETPROMPTWINDOW MAINWINDOW)
T "Sampling rate is now " FREQ " kiloHertz")
(RTSD.SHOWLEFTLEGEND MAINWINDOW)
else (printout (GETPROMPTWINDOW MAINWINDOW)
T "Sampling rate is " (WINDOWPROP MAINWINDOW (QUOTE FREQ))
" kiloHertz - unchanged"]
NIL])
(RTSDRIGHTBUTTONFN
[LAMBDA (WINDOW) (* hdj " 1-Jan-85 12:29")
(* Sets up Menu, and then does usual right window
stuff, augmented by UpdateHistoryWindow)
[OR (type? MENU (EVALV (QUOTE RTSDRightMenu)))
(SETQ RTSDRightMenu (create MENU
ITEMS ←(QUOTE ((Close (QUOTE CLOSEW)
"Closes a window")
(Snap (QUOTE SNAPW)
"Saves a snapshot of a region of the screen.")
(Paint (QUOTE PAINTW)
"Starts a painting mode in which the mouse can
be used to draw pictures or make notes on windows.
Includes a HARDCOPY command.")
(Clear (QUOTE CLEARW)
"Clears a window to its gray.")
(Bury (QUOTE BURYW)
"Puts a window on the bottom.")
(Redisplay (QUOTE REDISPLAYW)
"Redisplays a window using its REPAINTFN.")
(Move (QUOTE MOVEW)
"Moves a window by a corner.")
(Shrink (QUOTE SHRINKW)
"Replaces this window with its icon (or title if it doesn't have an icon."]
(TOTOPW WINDOW)
(PROG (COM)
(RETURN (COND
((SETQ COM (MENU RTSDRightMenu))
(APPLY* COM WINDOW)
T])
(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])
(SPECTRO
[LAMBDA (WINDOW REGION DATALEFT) (* hdj " 8-Jan-85 17:05")
(DECLARE (SPECVARS . T))
(PROG (WINDOWDD XPOS START END FFTSHIFT STRIPEWIDTH WIDTH LEFT BWAVE BSHUFFLE
BSUBWAVESHUFFLEDSMALLP TWICEARRAYLENGTH BSUBWAVESHUFFLEDFLOATP
BWINDOWWEIGHTSSHUFFLED BFFTBUF1 TBL1 TBL2 TBL3 TBL4 TBL5 TBL6 TBL7 TBL8
BFFTBUF1END BFFTOUT HALFARRAYLENGTH BMAGNITUDESQUARED ARRAYLENGTH BLOGMAGNITUDE
BHALFTONE WINDOWBASE BARHEIGHT BLOGMAGNITUDE1 BFFTTABLE TWICEFFTSHIFT
TWICESTRIPEWIDTH TICKHEIGHT WAVESIZE STRIPEHEIGHT)
(* (SETQ XPOS (IPLUS DATALEFT
(fetch (REGION LEFT) of REGION))))
(SETQ WIDTH (fetch (REGION WIDTH) of REGION))
(SETQ LEFT (fetch (REGION LEFT) of REGION))
(SETQ FFTSHIFT (WINDOWPROP WINDOW (QUOTE FFTSHIFT)))
(SETQ ARRAYLENGTH (WINDOWPROP WINDOW (QUOTE ARRAYLENGTH)))
(SETQ STRIPEWIDTH (WINDOWPROP WINDOW (QUOTE STRIPEWIDTH)))
(SETQ TWICESTRIPEWIDTH (UNFOLD STRIPEWIDTH 2))
(SETQ XPOS (fetch (REGION LEFT) of REGION))
(SETQ START (FIX (FTIMES (FQUOTIENT FFTSHIFT STRIPEWIDTH)
XPOS)))
[SETQ END (FIX (FTIMES (FQUOTIENT FFTSHIFT STRIPEWIDTH)
(IPLUS XPOS WIDTH]
(SETQ HALFARRAYLENGTH (HALF ARRAYLENGTH))
(SETQ TWICEARRAYLENGTH (UNFOLD ARRAYLENGTH 2))
(SETQ FFTSHIFT (WINDOWPROP WINDOW (QUOTE FFTSHIFT)))
[SETQ BWAVE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE WAVE]
(SETQ WAVESIZE (WINDOWPROP WINDOW (QUOTE WAVESIZE)))
[SETQ BFFTBUF1 (ARRAYBASE (WINDOWPROP WINDOW (QUOTE FFTBUF1]
[SETQ BLOGMAGNITUDE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE LOGMAGNITUDE]
(SETQ BLOGMAGNITUDE1 (\ADDBASE BLOGMAGNITUDE 1))
(SETQ TICKHEIGHT (WINDOWPROP WINDOW (QUOTE TICKHEIGHT)))
(SETQ BARHEIGHT (WINDOWPROP WINDOW (QUOTE BARHEIGHT)))
(SETQ STRIPEHEIGHT (ITIMES BARHEIGHT HALFARRAYLENGTH))
[SETQ BFFTTABLE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE FFTTABLE]
[SETQ BSHUFFLE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE SHUFFLE]
(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 BSUBWAVESHUFFLEDSMALLP (ARRAYBASE (WINDOWPROP WINDOW (QUOTE SUBWAVESHUFFLEDSMALLP]
[SETQ BSUBWAVESHUFFLEDFLOATP (ARRAYBASE (WINDOWPROP WINDOW (QUOTE SUBWAVESHUFFLEDFLOATP]
[SETQ BWINDOWWEIGHTSSHUFFLED (ARRAYBASE (WINDOWPROP WINDOW (QUOTE WINDOWWEIGHTSSHUFFLED]
[SETQ BFFTOUT (ARRAYBASE (WINDOWPROP WINDOW (QUOTE FFTOUT]
[SETQ BMAGNITUDESQUARED (ARRAYBASE (WINDOWPROP WINDOW (QUOTE MAGNITUDESQUARED]
[SETQ BHALFTONE (ARRAYBASE (WINDOWPROP WINDOW (QUOTE HALFTONE]
(SETQ WINDOWDD (\GETDISPLAYDATA WINDOW))
[SETQ WINDOWBASE (\ADDBASE (BASEADDROFY WINDOW 0)
(IMINUS (ITIMES (IPLUS STRIPEHEIGHT TICKHEIGHT -1)
SCREENWIDTHINWORDS]
(SETQ TWICEFFTSHIFT (LLSH FFTSHIFT 1))
(SETQ BFFTBUF1END (\ADDBASE BFFTBUF1 (IDIFFERENCE (ITIMES ARRAYLENGTH 4)
4)))
(TOTOPW WINDOW)
(for DATAPTR from START to END by TWICEFFTSHIFT as WINDOWPTR from LEFT by TWICESTRIPEWIDTH
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)
(\IBLT2 BLOGMAGNITUDE BHALFTONE (\DSPTRANSFORMX WINDOWPTR WINDOWDD)
WINDOWBASE SCREENWIDTHINWORDS BARHEIGHT STRIPEWIDTH HALFARRAYLENGTH)
(\IBLT2 BLOGMAGNITUDE1 BHALFTONE (IPLUS (\DSPTRANSFORMX WINDOWPTR WINDOWDD)
STRIPEWIDTH)
WINDOWBASE SCREENWIDTHINWORDS BARHEIGHT STRIPEWIDTH HALFARRAYLENGTH])
(\ARRAYCHECK
[LAMBDA (MESS) (* hdj " 3-Jan-85 11:48")
(if ARRAYCHECKFLG
then (printout T MESS)
(printout T " ...")
(\PARSEARRAYSPACE)
(printout T " ok." T])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS ARRAYBASE DMACRO (OPENLAMBDA (AR)
(fetch (ARRAYP BASE)
of AR)))
(PUTPROPS FFTSTEP DMACRO [LAMBDA (FFTTABLE)
(\BLT \FFTTABLE FFTTABLE \FFTTABLESIZE)
(\FFTSTEP \FFTTABLE (fetch (FFTTABLE LCNT)
of FFTTABLE])
)
(DECLARE: EVAL@COMPILE
(RPAQQ SCREENWIDTHINWORDS 64)
(CONSTANTS SCREENWIDTHINWORDS)
)
(RPAQQ ARRAYCHECKFLG NIL)
(RPAQ KAISER8 (READARRAY 512 (QUOTE FLOATP) 0))
(0.0 0.0 1.0 1.0 .4159644 .4159644 .4159644 .4159644 .1115359 .1115359 .8116048 .8116048 .8116048
.8116048 .1115359 .1115359 .03703344 .03703344 .949706 .949706 .6194209 .6194209 .2391483 .2391483
.2391483 .2391483 .6194209 .6194209 .949706 .949706 .03703344 .03703344 .01668289 .01668289 .9872172
.9872172 .5164653 .5164653 .3223783 .3223783 .1685259 .1685259 .7196427 .7196427 .8899002 .8899002
.06806202 .06806202 .06806202 .06806202 .8899002 .8899002 .7196427 .7196427 .1685259 .1685259 .3223783
.3223783 .5164653 .5164653 .9872172 .9872172 .01668289 .01668289 .009840562 .009840562 .9967906
.9967906 .4656082 .4656082 .3680653 .3680653 .1383091 .1383091 .7670025 .7670025 .8527812 .8527812
.08815682 .08815682 .05108953 .05108953 .9223804 .9223804 .670216 .670216 .2021688 .2021688 .2792991
.2792991 .567948 .567948 .9714356 .9714356 .0256532 .0256532 .0256532 .0256532 .9714356 .9714356
.567948 .567948 .2792991 .2792991 .2021688 .2021688 .670216 .670216 .9223804 .9223804 .05108953
.05108953 .08815682 .08815682 .8527812 .8527812 .7670025 .7670025 .1383091 .1383091 .3680653 .3680653
.4656082 .4656082 .9967906 .9967906 .009840562 .009840562 .007127092 .007127092 .9991972 .9991972
.4406 .4406 .3917662 .3917662 .1244937 .1244937 .7896911 .7896911 .8326617 .8326617 .09942766
.09942766 .04371127 .04371127 .9367168 .9367168 .6449462 .6449462 .2202499 .2202499 .2588406 .2588406
.5937266 .5937266 .961294 .961294 .03102498 .03102498 .02088416 .02088416 .9800884 .9800884 .5421673
.5421673 .300491 .300491 .1849229 .1849229 .6951441 .6951441 .9067538 .9067538 .05919744 .05919744
.07770786 .07770786 .8718856 .8718856 .743624 .743624 .1529865 .1529865 .3449188 .3449188 .4909206
.4909206 .9927922 .9927922 .01301373 .01301373 .01301373 .01301373 .9927922 .9927922 .4909206 .4909206
.3449188 .3449188 .1529865 .1529865 .743624 .743624 .8718856 .8718856 .07770786 .07770786 .05919744
.05919744 .9067538 .9067538 .6951441 .6951441 .1849229 .1849229 .300491 .300491 .5421673 .5421673
.9800884 .9800884 .02088416 .02088416 .03102498 .03102498 .961294 .961294 .5937266 .5937266 .2588406
.2588406 .2202499 .2202499 .6449462 .6449462 .9367168 .9367168 .04371127 .04371127 .09942766 .09942766
.8326617 .8326617 .7896911 .7896911 .1244937 .1244937 .3917662 .3917662 .4406 .4406 .9991972 .9991972
.007127092 .007127092 .005931413 .005931413 .9997994 .9997994 .4282314 .4282314 .4038066 .4038066
.117908 .117908 .8007502 .8007502 .8222459 .8222459 .1053762 .1053762 .04028669 .04028669 .9433826
.9433826 .6322099 .6322099 .2295984 .2295984 .2488968 .2488968 .6065896 .6065896 .955678 .955678
.03394755 .03394755 .01871478 .01871478 .9838452 .9838452 .5293015 .5293015 .3113503 .3113503 .1766176
.1766176 .7074521 .7074521 .8984764 .8984764 .06353353 .06353353 .07278588 .07278588 .8810342
.8810342 .7317035 .7317035 .1606485 .1606485 .3335699 .3335699 .5036685 .5036685 .9902004 .9902004
.01478404 .01478404 .01136742 .01136742 .9949896 .9949896 .4782309 .4782309 .3564196 .3564196 .1455399
.1455399 .7553939 .7553939 .8624654 .8624654 .08283074 .08283074 .05505052 .05505052 .9147242
.9147242 .6827284 .6827284 .1934405 .1934405 .2898056 .2898056 .5550525 .5550525 .9759502 .9759502
.0231955 .0231955 .02826161 .02826161 .9665482 .9665482 .5808423 .5808423 .268976 .268976 .2111059
.2111059 .6576183 .6576183 .9297136 .9297136 .04731097 .04731097 .09368842 .09368842 .842844 .842844
.7784381 .7784381 .1312939 .1312939 .3798499 .3798499 .4530615 .4530615 .9981936 .9981936 .008428634
.008428634 .008428634 .008428634 .9981936 .9981936 .4530615 .4530615 .3798499 .3798499 .1312939
.1312939 .7784381 .7784381 .842844 .842844 .09368842 .09368842 .04731097 .04731097 .9297136 .9297136
.6576183 .6576183 .2111059 .2111059 .268976 .268976 .5808423 .5808423 .9665482 .9665482 .02826161
.02826161 .0231955 .0231955 .9759502 .9759502 .5550525 .5550525 .2898056 .2898056 .1934405 .1934405
.6827284 .6827284 .9147242 .9147242 .05505052 .05505052 .08283074 .08283074 .8624654 .8624654 .7553939
.7553939 .1455399 .1455399 .3564196 .3564196 .4782309 .4782309 .9949896 .9949896 .01136742 .01136742
.01478404 .01478404 .9902004 .9902004 .5036685 .5036685 .3335699 .3335699 .1606485 .1606485 .7317035
.7317035 .8810342 .8810342 .07278588 .07278588 .06353353 .06353353 .8984764 .8984764 .7074521 .7074521
.1766176 .1766176 .3113503 .3113503 .5293015 .5293015 .9838452 .9838452 .01871478 .01871478 .03394755
.03394755 .955678 .955678 .6065896 .6065896 .2488968 .2488968 .2295984 .2295984 .6322099 .6322099
.9433826 .9433826 .04028669 .04028669 .1053762 .1053762 .8222459 .8222459 .8007502 .8007502 .117908
.117908 .4038066 .4038066 .4282314 .4282314 .9997994 .9997994 .005931413 .005931413 NIL
)
(RPAQ HALFTONE (READARRAY 256 (QUOTE SMALLPOSP) 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 0 0 0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 2 9 15 15 15 15 11 9 2 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 NIL
)
(RPAQQ PI 3.141592)
(RPAQQ RTSDRightMenu {MENU}#64,2000)
(RPAQQ \FFTTABLESIZE 32)
[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 (QUOTE FFTTABLE)
(QUOTE (FLOATP FLOATP XPOINTER XPOINTER XPOINTER WORD WORD FLOATP FLOATP FLOATP
FLOATP WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD))
[QUOTE ((FFTTABLE 0 FLOATP)
(FFTTABLE 2 FLOATP)
(FFTTABLE 4 XPOINTER)
(FFTTABLE 6 XPOINTER)
(FFTTABLE 8 XPOINTER)
(FFTTABLE 10 (BITS . 15))
(FFTTABLE 11 (BITS . 15))
(FFTTABLE 12 FLOATP)
(FFTTABLE 14 FLOATP)
(FFTTABLE 16 FLOATP)
(FFTTABLE 18 FLOATP)
(FFTTABLE 20 (BITS . 15))
(FFTTABLE 21 (BITS . 15))
(FFTTABLE 22 (BITS . 15))
(FFTTABLE 23 (BITS . 15))
(FFTTABLE 24 (BITS . 15))
(FFTTABLE 25 (BITS . 15))
(FFTTABLE 26 (BITS . 15))
(FFTTABLE 27 (BITS . 15))
(FFTTABLE 28 (BITS . 15))
(FFTTABLE 29 (BITS . 15))
(FFTTABLE 30 (BITS . 15))
(FFTTABLE 31 (BITS . 15]
(QUOTE 32))
(PUTPROPS PCDAC.READERROR READVICE (NIL (BEFORE NIL (RETURN NIL))))
(READVISE PCDAC.READERROR)
(PUTPROPS NEWRTSD COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1106 39919 (FFTSTEP 1116 . 1336) (PLAY 1338 . 1475) (RECORD.IT 1477 . 2052) (RTSDINIT
2054 . 6630) (FFTTABLEINIT 6632 . 8223) (RTSDMAKEWINDOW 8225 . 10164) (RTSD 10166 . 22371) (
RTSD.DOUBLEPERMINIT 22373 . 22941) (RTSD.MAKEMENU 22943 . 23730) (RTSD.PERMINIT 23732 . 24756) (
RTSD.PLAY 24758 . 25506) (RTSD.RECORD 25508 . 30463) (RTSD.SHOWLEFTLEGEND 30465 . 31350) (
RTSD.WHENSELECTEDFN 31352 . 32886) (RTSDRIGHTBUTTONFN 32888 . 34286) (BASEADDROFY 34288 . 34678) (
SPECTRO 34680 . 39658) (\ARRAYCHECK 39660 . 39917)))))
STOP