(FILECREATED " 4-Aug-84 02:09:16" {ERIS}<SPEECH>WORK>JMHT.;20 20996
changes to: (FNS JMHT0 RTSD JMHT1 FRESH LOSESBY CHK JMHT.PCBLT JHMHT.PCBLT)
(VARS JMHTCOMS)
previous date: " 2-Aug-84 00:35:25" {ERIS}<SPEECH>WORK>JMHT.;15)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT JMHTCOMS)
(RPAQQ JMHTCOMS ((FNS CHK FRESH JMHT.PCBLT JMHT0 JMHT1 LOSESBY RTSDINIT RTSDMAKEWINDOW RTSD
RTSD.DOUBLEPERMINIT RTSD.PERMINIT)))
(DEFINEQ
(CHK
[LAMBDA (N) (* edited: " 4-Aug-84 00:55")
(for I from -1 to 2 do (PRINT (LIST (PLUS I N)
(ELT WAVE (PLUS I N))
(PCREAD2 (PLUS 65536 I I N N])
(FRESH
[LAMBDA (N) (* edited: " 4-Aug-84 02:00")
(OR N (SETQ N 32000))
(for I from 0 to N do (SETA WAVE I (PCREAD2 (PLUS 65536 I I])
(JMHT.PCBLT
[LAMBDA (DA SAH SAL NW) (* edited: " 3-Aug-84 18:30")
(\PCBLTINBYTES DA SAH SAL NW])
(JMHT0
[LAMBDA (WAVEREADPTR) (* edited: " 3-Aug-84 23:27")
(* * made from RTSD%, to display the existing WAVE array in the existing window%, as much as will fit)
(PROG ((HALFARRAYLENGTH (LRSH ARRAYLENGTH 1))
(TWICEARRAYLENGTH (LLSH ARRAYLENGTH 1))
(TWICESTRIPEWIDTH (LLSH STRIPEWIDTH 1))
ERASEWIDTHINSTRIPES ERASEWIDTH ERASEMASK TWICEFFTSHIFT BWAVEEND BFFTBUF1END BLOGMAGNITUDE1
MAXWAVEREADPTR WINDOWWIDTH WINDOWHEIGHT WINDOWPTR MAXWINDOWPTR TBL1 TBL2 TBL3 TBL4 TBL5
TBL6 TBL7 TBL8 I)
(* * initialize constants)
(OR WAVEREADPTR (SETQ WAVEREADPTR 0))
(SETQ ERASEWIDTHINSTRIPES 2)
(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 MAXWAVEREADPTR (IDIFFERENCE WAVESIZE TWICEFFTSHIFT))
(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)
(* * initialize loop)
(SETQ WINDOWPTR 0)
(* * do until end of window or STOP key)
(do (* until (OR (EQ WINDOWPTR MAXWINDOWPTR)
(ZEROP (LOGAND 4 (fetch DLKBDAD3 of \IOPAGE)))))
(* * draw a "half-lapped" tick -- that is%, of the STRIPEWIDTH by TICKHEIGHT space available under the left
stripe%, draw the lower left 2x2)
(* BITBLT NIL NIL NIL WINDOW WINDOWPTR 0 2 2
(QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE)
(* * 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 WAVEREADPTR MAXWAVEREADPTR) then
(SETQ WAVEREADPTR 0) else (SETQ WAVEREADPTR
(IPLUS WAVEREADPTR TWICEFFTSHIFT)))
(* SETQ WINDOWPTR (IPLUS WINDOWPTR TWICESTRIPEWIDTH))
)
(* * draw line marking termination of scan -- and clear tick under the line if any)
(BITBLT NIL NIL NIL WINDOW WINDOWPTR 0 2 2 'TEXTURE 'REPLACE WHITESHADE)
(BITBLT NIL NIL NIL WINDOW WINDOWPTR TICKHEIGHT STRIPEWIDTH STRIPEHEIGHT 'TEXTURE
'REPLACE BLACKSHADE])
(JMHT1
[LAMBDA (DELTA) (* edited: " 4-Aug-84 01:34")
(PROG (I J)
(OR DELTA (SETQ DELTA 64))
(for I from 0 to 32767
do [SETQ J (IDIFFERENCE (ELT WAVE I)
(ELT WAVE (ADD1 I]
(if (MINUSP J)
then (SETQ J (MINUS J)))
(if (IGREATERP J DELTA)
then (PRINT (LIST I J])
(LOSESBY
[LAMBDA (LAPS) (* edited: " 4-Aug-84 01:06")
(FQUOTIENT 1.67 (ITIMES LAPS 3.02])
(RTSDINIT
[LAMBDA NIL (* edited: " 1-Aug-84 15:20")
(* * 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)
(* * initialize constants)
(SETQ PASSES 8)
(SETQ ARRAYLENGTH (LLSH 1 PASSES))
(SETQ HALFARRAYLENGTH (LRSH ARRAYLENGTH 1))
(SETQ FFTSHIFT HALFARRAYLENGTH)
(SETQ TWICEARRAYLENGTH (LLSH ARRAYLENGTH 1))
(SETQ WAVESIZE 32768)
(* * set up arrays and their base pointers)
[SETQ BWAVE (ARRAYBASE (SETQ WAVE (ARRAY (IPLUS WAVESIZE HALFARRAYLENGTH)
'WORD 0 0]
[SETQ BSHUFFLE (ARRAYBASE (SETQ SHUFFLE (RTSD.DOUBLEPERMINIT]
[SETQ BSUBWAVESHUFFLEDSMALLP (ARRAYBASE (SETQ SUBWAVESHUFFLEDSMALLP (ARRAY TWICEARRAYLENGTH
'WORD 0 0]
[SETQ BSUBWAVESHUFFLEDFLOATP (ARRAYBASE (SETQ SUBWAVESHUFFLEDFLOATP (ARRAY TWICEARRAYLENGTH
'FLOATP 0.0 0]
(SETQ BWINDOWWEIGHTSSHUFFLED (ARRAYBASE (SETQ WINDOWWEIGHTSSHUFFLED KAISER8)))
[SETQ BSUBWAVEWEIGHTEDFLOATP (ARRAYBASE (SETQ SUBWAVEWEIGHTEDFLOATP (ARRAY TWICEARRAYLENGTH
'FLOATP 0.0 0]
[SETQ BSUBWAVEWEIGHTEDCOMPLEX (ARRAYBASE (SETQ SUBWAVEWEIGHTEDCOMPLEX (ARRAY
TWICEARRAYLENGTH
'FLOATP 0.0 0]
[SETQ BFFTBUF1 (ARRAYBASE (SETQ FFTBUF1 (ARRAY TWICEARRAYLENGTH 'FLOATP 0 0 256]
[SETQ BFFTBUF2 (ARRAYBASE (SETQ FFTBUF2 (ARRAY TWICEARRAYLENGTH 'FLOATP 0 0 256]
[SETQ BFFTOUT (ARRAYBASE (SETQ FFTOUT (ARRAY TWICEARRAYLENGTH 'FLOATP 0 0 256]
[SETQ BMAGNITUDESQUARED (ARRAYBASE (SETQ MAGNITUDESQUARED (ARRAY ARRAYLENGTH 'FLOATP 0.0 0]
[SETQ BLOGMAGNITUDE (ARRAYBASE (SETQ LOGMAGNITUDE (ARRAY ARRAYLENGTH 'WORD 0 0]
(SETQ BHALFTONE (ARRAYBASE HALFTONE))
(SETQ \FFTTABLE (create FFTTABLE))
[SETQ BFFTTABLE (ARRAYBASE (SETQ FFTTABLE (FFTTABLEINIT BFFTBUF1 BFFTBUF2 PASSES]
(* * set up a window)
(RTSDMAKEWINDOW])
(RTSDMAKEWINDOW
[LAMBDA NIL (* edited: " 1-Aug-84 14:58")
(* * in this version the size & location of the window are determined for RTSD at RTSDMAKEWINDOW time -- so moving
or reshaping the window before running RTSD will cause RTSD to draw where the window was! -- window width of 236
stripes is approx 3 sec%, and has to be an even number%, for RTSD)
(PROG ((WINDOWTITLE "Real Time Spectrogram")
(SCREENWIDTHINDOTS 1024)
(WINDOWMARGIN 4)
(WINDOWTITLEBARHEIGHT 12)
(WINDOWBOTTOM 10)
(HALFARRAYLENGTH (LRSH ARRAYLENGTH 1))
X W H)
(SETQ TICKHEIGHT 3)
(SETQ SCREENWIDTHINWORDS 64)
(SETQ BARHEIGHT 1)
(SETQ STRIPEWIDTH 4)
(SETQ NRSTRIPES 236)
(SETQ STRIPEHEIGHT (ITIMES BARHEIGHT HALFARRAYLENGTH))
(SETQ W (IPLUS (ITIMES WINDOWMARGIN 2)
(ITIMES NRSTRIPES STRIPEWIDTH)))
(SETQ X (HALF (IDIFFERENCE SCREENWIDTHINDOTS W)))
(SETQ H (IPLUS WINDOWTITLEBARHEIGHT WINDOWMARGIN STRIPEHEIGHT TICKHEIGHT WINDOWMARGIN))
(SETQ WINDOW (CREATEW (CREATEREGION X WINDOWBOTTOM W H)
WINDOWTITLE))
[SETQ WINDOWBASE (\ADDBASE (BASEADDROFY WINDOW 0)
(IMINUS (ITIMES (IPLUS STRIPEHEIGHT TICKHEIGHT -1)
SCREENWIDTHINWORDS]
(SETQ WINDOWDD (fetch IMAGEDATA of (GETWINDOWPROP WINDOW 'DSP])
(RTSD
[LAMBDA (FREQKHZ ERASEWIDTHINSTRIPES) (* edited: " 4-Aug-84 00:07")
(* * 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%, default = min = 2)
(* * window width of 236 stripes is approx 3 sec -- NRSTRIPES has to be an even number%, to expedite doing 2 FFTs
at once -- in this version the size & location of the window are determined for RTSD at RTSDMAKEWINDOW time -- so
moving or reshaping the window before running RTSD will cause RTSD to draw where the window was!)
(* * 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)
(HALFARRAYLENGTH (LRSH ARRAYLENGTH 1))
(TWICEARRAYLENGTH (LLSH ARRAYLENGTH 1))
(TWICESTRIPEWIDTH (LLSH STRIPEWIDTH 1))
ABSOLUTESTRIPE DMAREADADDRESSCMD CLOCKRATE ERASEWIDTH ERASEMASK TWICEFFTSHIFT BWAVEEND
BFFTBUF1END BLOGMAGNITUDE1 HALFPCMEMSIZEINWORDS WAVEWRITEPTR MAXWAVEWRITEPTR WAVEREADPTR
MAXWAVEREADPTR SAMEARRAYLENGTHMASK WINDOWWIDTH WINDOWHEIGHT WINDOWPTR MAXWINDOWPTR TBL1
TBL2 TBL3 TBL4 TBL5 TBL6 TBL7 TBL8 I)
(* * initialize constants)
(OR FREQKHZ (SETQ FREQKHZ 10)) (* 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)
(if ERASEWIDTHINSTRIPES
then (if (for I from 1 to 15 never (EQ ERASEWIDTHINSTRIPES (LLSH 1 I)))
then (HELP "ERASEWIDTHINSTRIPES must be a power of 2!"))
else (SETQ ERASEWIDTHINSTRIPES 2))
(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)
(PCDMA.INIT)
(PCDAC.SETCLOCK CLOCKRATE)
(PCDAC.DMASETUP PCPAGE 0 (LLSH PCMEMSIZEINWORDS 1)
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.READA/DWITHDMA T)
(while (ILESSP (PCDMA.READADDRESS PCDAC.DMACHANNEL)
(LLSH FFTSHIFT 1))
do (PCDAC.REPORTERROR))
(\PCBLTINBYTES 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)
(ZEROP (LOGAND 4 (fetch DLKBDAD3 of \IOPAGE]
do
(* * possibly erase ahead)
(if (ZEROP (LOGAND WINDOWPTR ERASEMASK))
then (BITBLT NIL NIL NIL WINDOW WINDOWPTR 0 (IMIN ERASEWIDTH (IDIFFERENCE
WINDOWWIDTH
WINDOWPTR))
WINDOWHEIGHT
'TEXTURE
'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 two pointers%,
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 (PCINPUT DMAREADADDRESSCMD)
(PCINPUT DMAREADADDRESSCMD))
7)
WAVEWRITEPTR]
do (PCDAC.REPORTERROR))
(* * 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 'TEXTURE '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)
(\PCBLTINBYTES (\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 \PCINBYTES 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 'TEXTURE 'REPLACE WHITESHADE)
(BITBLT NIL NIL NIL WINDOW WINDOWPTR TICKHEIGHT STRIPEWIDTH STRIPEHEIGHT 'TEXTURE
'REPLACE BLACKSHADE])
(RTSD.DOUBLEPERMINIT
[LAMBDA NIL (* edited: " 1-Aug-84 15:06")
(PROG ((TWICEARRAYLENGTH (LLSH ARRAYLENGTH 1))
(PERM (RTSD.PERMINIT))
DPERM)
(SETQ DPERM (ARRAY TWICEARRAYLENGTH '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.PERMINIT
[LAMBDA NIL (* edited: " 1-Aug-84 15:07")
(PROG ((HALFARRAYLENGTH (LRSH ARRAYLENGTH 1))
(PERM (ARRAY ARRAYLENGTH 'WORD 0 0))
I J K TEMP)
(SETQ PERM (ARRAY ARRAYLENGTH 'WORD 0 0))
(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])
)
(PUTPROPS JMHT COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (489 20921 (CHK 499 . 732) (FRESH 734 . 947) (JMHT.PCBLT 949 . 1094) (JMHT0 1096 . 5265)
(JMHT1 5267 . 5665) (LOSESBY 5667 . 5814) (RTSDINIT 5816 . 8327) (RTSDMAKEWINDOW 8329 . 9761) (RTSD
9763 . 19480) (RTSD.DOUBLEPERMINIT 19482 . 19971) (RTSD.PERMINIT 19973 . 20919)))))
STOP