(FILECREATED "20-Apr-85 15:22:09" {DSK}<LISPFILES>HTHOMPSON>DSL>DSL.;3 79518
changes to: (FNS MaxSampleRate ARRAYBASE)
(VARS DSLCOMS)
previous date: "20-Apr-85 13:27:12" {DSK}<LISPFILES>HTHOMPSON>DSL>DSL.;2)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DSLCOMS)
(RPAQQ DSLCOMS [(* * signal window functions)
(FNS ARRAYBASE CloseSignalFile CloseSignalWindow CompressionButtonFn NewCompression
PositionSignalWindow NewShow LinkShow \ComputeZoomOffset ZoomWindow \MakeLinkedWindow
UnlinkWindow ClearSignalWindow RepaintSingleValuedAspect RepaintSingleValuedAspect/File
RedisplayMarks ReshapeSignalWindow \UpdateLinks \UpdateLinkedWindows \ChangeLinkedOffset
UpdateSignalCompression UpdateSignalOrigin TrueLeftMargin ScrollSignalWindow
SetupSignalFile MakeSSForFile UpdateScaleFactor RedisplayScale ReshapeScaleWindow
CarefulSFP WIN16 SecPrint ShowMark)
(* * Signal Segment functions)
(FNS PrintSignalSegment SSFullName FindSS PromptForSSFile SSFile CleanupSSFiles SaveSS SSRead
SSFromFile SSFileForm SSNewName)
(* * arrays as signal data)
(VARS ArrayOffset)
(FNS RepaintSingleValuedAspect/Array \RepaintSignalSliceFromArray)
(* * record and playback)
(VARS SSDMAChannel SSPCA/DInputChannel SSPCD/AOutputChannel \SSDrawPointTime
\SSFetchPerHundredTime \SSWriteToCoreTime \SSWriteToDskTime (\SSDataArray)
(\SSOutputArray))
(FNS RecordSegment RecordToCoreFile RecordToDisplayOnly RecordToDskFile PlaySeg PlayFileSeg
PlayArraySeg MaxSampleRate SkipSize PlaySubSS PLAY.IT)
(* * Signal window menu)
(VARS SignalMenuItems)
(FNS AddAspect TrueSS InheritAspect SpawnShow AddProperty PromptRead ButtonSignalWindow
SetAspect CopyCoreFileToDsk)
(* * Aspect manipulation)
(VARS SSAutoInheritAspects)
(FNS GetAspect AspectProperty UndisplayAspect \PutAspectProperty \GetAspectProperty)
(* * Mark manipulation)
(FNS NearMark InvertMark GrabMark ChooseMark DeleteMark ScrubSS InsertMark \MoveMark1 NewMark
NewSS AddSS JumpTo ToggleMarks \DeleteMark1 \RedisplayMark MoveMark)
(CURSORS SSCursor1 SSCursor2)
(VARS (NearMarkDelta 3)
(MinSignalHeight 10)
(DefaultInitializeFunction (QUOTE SetupSignalFile))
(DefaultUndisplayFn (QUOTE CloseSignalFile))
Pi
(CompressionMenu)
CompressionMenuItems
(SignalWindow)
(MarkCycleLength 2)
BitsPerSamp LeftOff SampsPerByte SampsPerSec (ScaleTickWidth 5)
ZeroSamp
(ZoomRatio 10))
(VARS (SSExpandFlg)
(SSFields (QUOTE (name trueName duration offset parent aspects points comment)))
(SSVersionStamp (QUOTE (2 . 1)))
(SSDir (LIST (HARRAY 50)))
(SSReadTable (COPYREADTABLE HASHFILERDTBL))
(SSRereadChar (QUOTE #))
(SSRereadable)
(SignalFiles)
(SignalWindowMenu))
(GLOBALVARS SSRereadable SSRereadChar SSDir SignalFiles SignalWindow CompressionMenu
CompressionMenuItems SSFields SSVersionStamp Pi SSExpandFlg SSReadTable
SignalWindowMenu SignalMenuItems DefaultInitializeFunction DefaultUndisplayFn
MarkCycleLength MinSignalHeight NearMarkDelta ScaleTickWidth LeftOff SSCursor1
SSCursor2 ZoomRatio SSAutoInheritAspects ArrayOffset)
(RECORDS LinkedWindow PointRec SSFileForm SignalSegment)
[ADDVARS (INSPECTMACROS (SignalSegment (name fullName comment points aspects parent offset
duration)
[LAMBDA (INSTANCE FIELD)
(RECORDACCESS FIELD INSTANCE]
(LAMBDA (INSTANCE FIELD NEWVALUE)
(RECORDACCESS FIELD INSTANCE NIL (QUOTE
/REPLACE)
NEWVALUE]
(P (DEFPRINT (QUOTE SignalSegment)
(QUOTE PrintSignalSegment))
(SETSYNTAX (QUOTE #)
(QUOTE (MACRO FIRST SSRead))
SSReadTable))
(FNS MakeFake SinPoint)
(FILES (SYSLOAD FROM LISPUSERS)
NOBOX PCDAC {IVY}<HTHOMPSON>LISP>DSL>BUSUTIL)
(ADVISE TOTOPW-IN-TOPATTACHEDWINDOWS)
(PROP ARGNAMES AspectProperty)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
{IVY}<HTHOMPSON>LISP>DSL>BUSUTIL))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA AspectProperty])
(* * signal window functions)
(DEFINEQ
(ARRAYBASE
[LAMBDA (A) (* ht: "20-Apr-85 15:14")
(AND (ARRAYP A)
(\GETBASEPTR A 0])
(CloseSignalFile
[LAMBDA (ss aspect w) (* ht: "10-Jan-85 15:12")
(* * default aspect ending fn)
(let [(sf (WINDOWPROP w 'SignalFile]
(if sf
then (if [AND (OPENP sf)
(NOT (for ow in (OPENWINDOWS) unless w=ow thereis sf=(WINDOWPROP
ow
'SignalFile]
then (CLOSEF sf))
(WINDOWPROP w 'SignalFile NIL])
(CloseSignalWindow
[LAMBDA (window) (* ht: "13-Dec-84 14:43")
(UndisplayAspect (WINDOWPROP window (QUOTE DisplayedAspect))
(WINDOWPROP window (QUOTE SignalSegment))
window)
(if (WINDOWPROP window (QUOTE SignalFile))
then (CLOSEF (WINDOWPROP window (QUOTE SignalFile])
(CompressionButtonFn
[LAMBDA (cw) (* ht: "11-Jan-85 09:44")
(PROG ((window (MAINWINDOW (MAINWINDOW cw)))
old)
(if (LASTMOUSESTATE MIDDLE)
then (old←(WINDOWPROP window 'Compression))
(NewCompression window (SELECTQ [MENU (if (type? MENU CompressionMenu)
then CompressionMenu
else CompressionMenu←(create
MENU
ITEMS ← CompressionMenuItems
WHENSELECTEDFN ←(FUNCTION (LAMBDA (
i m k)
i:1]
(NIL (RETURN))
(1 1)
(Down old-1)
(Up old+1)
(10 10)
(Set (PromptRead window "New value: " 1 78))
(SHOULDNT])
(NewCompression
[LAMBDA (window compr) (* ht: "11-Jan-85 16:48")
(WINDOWPROP window 'Compression compr)
(\UpdateLinks window (fetch WIDTH of (DSPCLIPPINGREGION NIL window))
compr)
(PositionSignalWindow window (WINDOWPROP window 'SignalOrigin)
compr)
(REDISPLAYW window])
(PositionSignalWindow
[LAMBDA (window signalPos compr) (* ht: "11-Jan-85 14:05")
(* * The idea of this is to scroll the position without repainting, as the scale has changed, say.
The first bits with offset and clipping region effect the scrolling, then the WHOLE window is repainted.)
(PROG (reg offset)
(CLEARW window)
(reg←(DSPCLIPPINGREGION NIL window))
(offset←(DSPXOFFSET NIL window))
(reg:LEFT←signalPos/compr)
(* * It says in the manual not to call these functions, but I can%'t see any other way to do what I want)
(DSPCLIPPINGREGION reg window)
(DSPXOFFSET offset-signalPos/compr window)
(\UpdateLinkedWindows window])
(NewShow
[LAMBDA (ss window) (* ht: "11-Jan-85 19:21")
(let (ow pw cw sw sww)
[if (NOT (WINDOWP window))
then window←(CREATEW NIL (CONCAT "Signal Display for " ss:fullName " " (OR ss:comment ""]
(WINDOWPROP window 'SignalSegment ss)
(if ~(WINDOWPROP window 'ATTACHEDWINDOWS)
then (ATTACHWINDOW sw←(CREATEW (CREATEREGION 0 0 sww←(WIDTHIFWINDOW (STRINGWIDTH "Scale"
window))
10)
NIL NIL T)
window
'LEFT)
(CLOSEW sw)
(WINDOWPROP window 'ScaleWindow sw)
(WINDOWPROP sw 'MAXSIZE (CONS sww NIL))
(WINDOWPROP sw 'MINSIZE (CONS sww 0))
(WINDOWPROP sw 'RESHAPEFN 'ReshapeScaleWindow)
(ATTACHWINDOW ow←(CREATEW '(0 0 75 30)
"Origin" NIL T)
window
'LEFT
'BOTTOM)
(WINDOWPROP ow 'MAXSIZE (CONS 75 30))
(WINDOWPROP ow 'MINSIZE (CONS 75 30))
(ATTACHWINDOW cw←(CREATEW '(0 0 75 30)
"Compression" NIL T)
ow
'TOP)
(WINDOWPROP cw 'MAXSIZE (CONS 75 30))
(WINDOWPROP cw 'MINSIZE (CONS 75 30))
(WINDOWPROP cw 'BUTTONEVENTFN 'CompressionButtonFn)
(CLOSEW cw)
(ATTACHWINDOW pw←(CREATEW '(0 0 75 10)
NIL NIL T)
window
'TOP
'RIGHT)
(WINDOWPROP pw 'MAXSIZE (CONS 0 0))
(WINDOWPROP pw 'MINSIZE (CONS 0 0))
(DSPFONT '(GACHA 8)
pw)
(DSPSCROLL T pw)
(WINDOWPROP pw 'PAGEFULLFN 'NILL)
(WINDOWPROP pw 'RESHAPEFN (FUNCTION CLOSEW))
(* * the reason I do this myself instead of using GETPROMPTWINDOW exclusively is to get the position and width as I
want them)
(WINDOWPROP window 'PromptWindow (CONS pw 0))
(WINDOWPROP window 'OriginWindow ow)
(WINDOWPROP window 'CompressionWindow cw))
(WINDOWPROP window 'REPAINTFN 'NILL)
(WINDOWPROP window 'SCROLLFN 'ScrollSignalWindow)
(WINDOWADDPROP window 'CLOSEFN 'CloseSignalWindow)
(WINDOWADDPROP window 'RESHAPEFN 'ReshapeSignalWindow)
(WINDOWPROP window 'BUTTONEVENTFN 'ButtonSignalWindow)
(ReshapeSignalWindow window)
window])
(LinkShow
[LAMBDA (ss w) (* ht: "11-Jan-85 14:41")
(\MakeLinkedWindow ss w (fetch WIDTH of (DSPCLIPPINGREGION NIL w))
'end])
(\ComputeZoomOffset
[LAMBDA (width compr1 compr2) (* ht: "11-Jan-85 15:21")
(width-width*compr2/compr1)/2])
(ZoomWindow
[LAMBDA (ss w) (* ht: "11-Jan-85 15:30")
(let ((compr (WINDOWPROP w 'Compression))
subCompr)
(subCompr←(IMAX 1 compr/ZoomRatio))
(\MakeLinkedWindow ss w (\ComputeZoomOffset (fetch WIDTH of (DSPCLIPPINGREGION NIL w))
compr subCompr)
'zoom subCompr])
(\MakeLinkedWindow
[LAMBDA (ss w posOffset linkType subCompr) (* ht: "11-Apr-85 13:22")
(if ss:points=NIL
then (ss:points←(LIST NIL)))
(let ((compr (WINDOWPROP w 'Compression))
(dummy (create SignalSegment
points ←(fetch points of ss)))
(reg (WINDOWPROP w 'REGION))
(cr (DSPCLIPPINGREGION NIL w))
lw link)
(dummy:offset←ss:offset+posOffset*compr)
(dummy:duration←ss:offset+ss:duration-dummy:offset)
(dummy:aspects←ss:aspects)
(dummy:parent←ss:parent)
(lw←(NewShow dummy (CREATEW (CREATEREGION 0 0 reg:WIDTH reg:HEIGHT)
(CONCAT (WINDOWPROP w 'TITLE)
" at offset " posOffset)
NIL T)))
(ATTACHWINDOW lw w 'BOTTOM
NIL
'LOCALCLOSE)
(SetAspect dummy lw (WINDOWPROP w 'DisplayedAspect)
T)
(WINDOWPROP lw 'Compression
(OR subCompr compr))
(PositionSignalWindow lw (cr:LEFT+posOffset)*compr (OR subCompr compr))
(REDISPLAYW lw)
(WINDOWADDPROP w 'LinkedWindows
link←(create LinkedWindow
lWindow ← lw
lOffset ← posOffset
lType ← linkType))
(WINDOWADDPROP lw 'CLOSEFN
'UnlinkWindow
T)
(WINDOWADDPROP lw 'LinkedWindows
(create LinkedWindow
lWindow ← w
lOffset ←(-posOffset)
lType ← link))
(WINDOWADDPROP w 'CLOSEFN
'UnlinkWindow
T])
(UnlinkWindow
[LAMBDA (w) (* ht: "11-Jan-85 16:40")
[WINDOWDELPROP (MAINWINDOW w)
'LinkedWindows
(ASSOC w (WINDOWPROP (MAINWINDOW w)
'LinkedWindows]
(WINDOWDELPROP w 'LinkedWindows)
(DETACHWINDOW w])
(ClearSignalWindow
[LAMBDA (w) (* ht: "10-Jan-85 14:22")
(PositionSignalWindow w (DSPLEFTMARGIN NIL w)
1])
(RepaintSingleValuedAspect
[LAMBDA (window region) (* ht: "17-Apr-85 17:50")
(if (ARRAYP (WINDOWPROP window 'SignalFile))
then (RepaintSingleValuedAspect/Array window region)
else (RepaintSingleValuedAspect/File window region])
(RepaintSingleValuedAspect/File
[LAMBDA (window region) (* ht: "19-Apr-85 11:09")
(* * all the LLSHing by one is because each datum takes up two bytes on the file)
(let ((file (WINDOWPROP window 'SignalFile))
(base (IPLUS (WINDOWPROP window 'SignalBase)
(DSPYOFFSET NIL window)))
(height (WINDOWPROP window 'SignalHeight))
(ss (WINDOWPROP window 'SignalSegment))
(compr (LLSH (WINDOWPROP window 'Compression)
1))
(scale (WINDOWPROP window 'ScaleFactor))
(iScale (WINDOWPROP window 'IntegerScaleFactor))
(stream (WINDOWPROP window 'DSP))
destBM bottom top left right y dispPos (dispPos1 (IBOX))
(truePos (IBOX))
(mDelta 0))
(UpdateSignalOrigin window)
(UpdateSignalCompression window)
destBM←(DSPDESTINATION NIL stream)
[if (NOT iScale)
then (WINDOWPROP window 'IntegerScaleFactor
iScale←(FIX (FQUOTIENT 1.0 scale]
(if (NOT region)
then region←(DSPCLIPPINGREGION NIL window))
bottom←region:BOTTOM+(DSPYOFFSET NIL stream)
top←bottom+region:HEIGHT
left←(IBOX region:LEFT+(DSPXOFFSET NIL stream))
right←(IBOX left+region:WIDTH)
dispPos←(IBOX region:LEFT+(DSPXOFFSET NIL stream))
truePos:I←region:LEFT*compr
(SETFILEPTR file (IMAX 0 truePos-compr))
y←(IQUOTIENT (LOGOR (LLSH (BIN file)
8)
(BIN file))
-ArrayOffset iScale)+base
(if compr=2
then (* won%'t happen inside the loop, needed in case we
were at the beginning of the file)
(SETFILEPTR file truePos))
(for i from 1 to (IMIN region:WIDTH+1 ((LLSH ss:duration+ss:offset 1)
-truePos)/compr)
do (if compr~=2
then (SETFILEPTR file truePos))
(\CLIPANDDRAWLINE1 dispPos-1 y dispPos y←(IQUOTIENT (LOGOR (LLSH (BIN file)
8)
(BIN file))
-ArrayOffset iScale)+base
'REPLACE
destBM left right bottom top stream)
(add truePos:I compr)
(dispPos←(PROG1 dispPos1 dispPos1←dispPos))
(* hack to keep from incrementing the DSPXPOSITION)
(dispPos:I←dispPos1)
(add dispPos:I 1])
(RedisplayMarks
[LAMBDA (w reg) (* ht: "12-Jan-85 11:33")
(let ((ss (WINDOWPROP w 'SignalSegment))
(compr (WINDOWPROP w 'Compression))
(base (WINDOWPROP w 'SignalBase))
(height (WINDOWPROP w 'SignalHeight))
(mDelta 0)
(posFn (WINDOWPROP w 'PositionFn))
(getFn (WINDOWPROP w 'GetFn))
(file (WINDOWPROP w 'SignalFile))
left right pp)
(if ~reg
then reg←(DSPCLIPPINGREGION NIL w))
(left←reg:LEFT)
(right←left+reg:WIDTH)
(pp←ss:points::1)
(while (AND pp (ILESSP pp:1:pPtr/compr+pp:1:pWidth+(-LeftOff)
left))
do (pop pp))
(while (AND pp (ILESSP pp:1:pPtr/compr-LeftOff right))
do (APPLY* posFn file pp:1:pPtr)
(mDelta←(ShowMark ss pp:1:pPtr/compr base height pp:1 NIL mDelta w NIL
(APPLY* getFn file)))
(pop pp])
(ReshapeSignalWindow
[LAMBDA (window) (* ht: "11-Jan-85 19:23")
(let [(reg (DSPCLIPPINGREGION NIL window))
(deltaY (FONTPROP (DSPFONT NIL window)
'HEIGHT]
(WINDOWPROP window 'SignalHeight (IMAX MinSignalHeight (reg:HEIGHT-2*(MarkCycleLength+1)
*deltaY)/2))
(WINDOWPROP window 'SignalBase reg:BOTTOM+reg:HEIGHT/2)
(* * Kludge because of SMALLP restriction on this field)
(DSPRIGHTMARGIN 65535 window)
(UpdateScaleFactor window)
(\UpdateLinks window reg:WIDTH (WINDOWPROP window 'Compression))
(REDISPLAYW window reg])
(\UpdateLinks
[LAMBDA (w width compr) (* ht: "11-Jan-85 20:33")
(bind [(ss ←(WINDOWPROP w 'SignalSegment] for lw in (WINDOWPROP w 'LinkedWindows)
do (SELECTQ lw:lType
(end (\ChangeLinkedOffset w lw width compr ss))
(beginning)
(zoom (\ChangeLinkedOffset w lw (\ComputeZoomOffset width compr
(WINDOWPROP lw:lWindow
'Compression))
compr ss))
(PROGN
(* * here if a back link -
presume (hope!) source has been done already)
(if (NOT (IEQP (-lw:lType:lOffset)
lw:lOffset))
then (HELP "back pointers screwed up"])
(\UpdateLinkedWindows
[LAMBDA (window) (* ht: "11-Jan-85 15:03")
(* * Compute the scrolling of the next window by figuring the deltaX from his left hand end to our
(new) left -
this avoids all confusions about thumbing, different compressions, etc.)
(* * The LinkedWindows property is a list of records of the form (window offset type) with offset in pixels)
(bind ((compr ←(WINDOWPROP window 'Compression))
lc tlm dx)
for lw in (WINDOWPROP window 'LinkedWindows)
do (lc←(WINDOWPROP lw:lWindow 'Compression))
(* * the setting of tlm is inside the loop because the call to SCROLLW may actually move me because of other
connections/back connections and the interaction with window boundaries)
(tlm←(fetch LEFT of (DSPCLIPPINGREGION NIL window)))
(dx←((fetch LEFT of (DSPCLIPPINGREGION NIL lw:lWindow))*lc-(tlm*compr+lw:lOffset*(if
(LISTP lw:lType)
then
lc
else
compr)))
/lc)
(if dx~=0
then (SCROLLW lw:lWindow dx 0])
(\ChangeLinkedOffset
[LAMBDA (w lw newOffset compr ss) (* ht: "11-Jan-85 19:24")
(let [(dummy (WINDOWPROP (fetch lWindow of lw)
'SignalSegment]
(lw:lOffset←newOffset)
(replace lOffset of (OR (for llw in (WINDOWPROP lw:lWindow 'LinkedWindows) thereis
llw:lType=lw)
(SHOULDNT "no back link"))
with (-newOffset))
(dummy:offset←ss:offset+newOffset*compr)
(dummy:duration←ss:offset+ss:duration-dummy:offset)
(WINDOWPROP lw:lWindow 'TITLE (CONCAT (WINDOWPROP w 'TITLE)
" at offset " newOffset])
(UpdateSignalCompression
[LAMBDA (window) (* ht: "10-Jan-85 13:52")
(let [(compr (WINDOWPROP window 'Compression))
(cw (WINDOWPROP window 'CompressionWindow))
(ss (WINDOWPROP window 'SignalSegment]
(WINDOWPROP window 'EXTENT (create REGION
LEFT ←(ss:offset/compr)
BOTTOM ← 0
HEIGHT ← -1
WIDTH ←(ss:duration/compr)))
(DSPLEFTMARGIN ss:offset/compr window)
(CLEARW cw)
(printout cw compr])
(UpdateSignalOrigin
[LAMBDA (window) (* ht: "10-Jan-85 13:33")
(let [(w (WINDOWPROP window 'OriginWindow))
(ss (WINDOWPROP window 'SignalSegment))
(newo (ITIMES (WINDOWPROP window 'Compression)
(TrueLeftMargin window]
(WINDOWPROP window 'SignalOrigin newo)
(CLEARW w)
(SecPrint newo w 0 (OR (AspectProperty ss (WINDOWPROP window 'DisplayedAspect)
'SampleRate)
1])
(TrueLeftMargin
[LAMBDA (w) (* ht: " 7-Jan-85 17:40")
(fetch LEFT of (WINDOWPROP w 'REGION))+(WINDOWPROP w 'BORDER)
-(DSPXOFFSET NIL w])
(ScrollSignalWindow
[LAMBDA (window deltaX deltaY continuousFlg) (* ht: "11-Jan-85 14:05")
(SCROLLBYREPAINTFN window deltaX deltaY continuousFlg)
(\UpdateLinkedWindows window])
(SetupSignalFile
[LAMBDA (ss aspect w) (* ht: "19-Apr-85 18:25")
(* * default aspect init fn -
get a file from the aspect and open it and put it in the window)
(let ((sf (AspectProperty ss aspect 'DataFile))
(compr (OR (AspectProperty ss aspect 'DefaultCompression)
1))
(ampl (AspectProperty ss aspect 'MaxAmplitude))
f)
(if sf
then (WINDOWPROP w 'SignalFile
f←(OPENFILE sf 'INPUT))
(WINDOWPROP w 'Compression
compr)
(WINDOWPROP w 'REPAINTFN
(FUNCTION RepaintSingleValuedAspect))
(WINDOWPROP w 'PositionFn
(FUNCTION CarefulSFP))
(WINDOWPROP w 'GetFn
(FUNCTION WIN16))
(UpdateScaleFactor w ampl T)
(UpdateSignalCompression w)
(ClearSignalWindow w)
(if ss:duration=0
then (ss:duration←(LRSH (GETEOFPTR f)
1)))
f])
(MakeSSForFile
[LAMBDA (name fileName size ampl rate) (* ht: "18-Apr-85 10:00")
(create SignalSegment
name ← name
duration ←(OR size (if (INFILEP fileName)
then (LRSH (GETFILEINFO fileName 'LENGTH)
1))
0)
aspects ←(DSUBST (OR ampl 2048)
'ampl
(DSUBST (OR rate 10000)
'rate
(SUBST fileName 'fileName
'((Data (DataFile . fileName)
(SampleRate . rate)
(MaxAmplitude . ampl)))])
(UpdateScaleFactor
[LAMBDA (w ampl redisplayFlg) (* ht: " 9-Jan-85 11:54")
(let ((height (WINDOWPROP w 'SignalHeight))
(asp (WINDOWPROP w 'DisplayedAspect))
ampl sf)
(if asp
then [ampl←(OR ampl (AspectProperty (WINDOWPROP w 'SignalSegment)
asp
'MaxAmplitude]
(WINDOWPROP w 'ScaleFactor sf←(if (AND ampl (IGREATERP ampl height))
then (FQUOTIENT height ampl)
else 1.0))
(if redisplayFlg
then (RedisplayScale sf height w])
(RedisplayScale
[LAMBDA (scale height w) (* ht: " 9-Jan-85 11:48")
(let ((base (WINDOWPROP w 'SignalBase))
(sw (WINDOWPROP w 'ScaleWindow))
(top (FIX (FQUOTIENT height scale)))
midChar width)
(DSPRESET sw)
(printout sw "Scale" T .F4.2 scale)
(midChar←(FONTPROP (DSPFONT NIL sw)
'ASCENT)/2)
(width←(fetch WIDTH of (DSPCLIPPINGREGION NIL sw)))
(MOVETO 0 base-(height+midChar)
sw)
(printout sw .I4 (-top))
(MOVETO 0 base-midChar sw)
(printout sw .I4 0)
(MOVETO 0 base+(height-midChar)
sw)
(printout sw .I4 top)
(MOVETO width base+height sw)
(RELDRAWTO (-ScaleTickWidth)
0 1 NIL sw)
(MOVETO width base sw)
(RELDRAWTO (-ScaleTickWidth)
0 1 NIL sw)
(MOVETO width base-height sw)
(RELDRAWTO (-ScaleTickWidth)
0 1 NIL sw])
(ReshapeScaleWindow
[LAMBDA (sw) (* ht: " 9-Jan-85 11:40")
(let ((w (WINDOWPROP sw 'MAINWINDOW))
sf)
(if sf←(WINDOWPROP w 'ScaleFactor)
then (RedisplayScale sf (WINDOWPROP w 'SignalHeight)
w])
(CarefulSFP
[LAMBDA (file pos) (* ht: "17-Apr-85 19:34")
(* * Carefully set the file pointer of a file)
(SETFILEPTR file (LLSH (IMAX 0 pos)
1])
(WIN16
[LAMBDA (stream) (* ht: "17-Apr-85 19:29")
(LOGOR (LLSH (BIN stream)
8)
(BIN stream))
-ArrayOffset])
(SecPrint
[LAMBDA (tics window offset rate) (* ht: "22-Nov-84 13:26")
(printout window .F7.3. (FPLUS offset (FQUOTIENT (FLOAT tics)
rate])
(ShowMark
[LAMBDA (ss x y h point oldy mDelta window pos val) (* ht: "12-Jan-85 11:35")
(let ((lf (DSPLINEFEED NIL window))
maxX)
(MOVETO x-LeftOff y+(-h)+lf+(-mDelta)
window)
(SecPrint (OR pos point:pPtr)
window 0 (OR (AspectProperty ss (WINDOWPROP window 'DisplayedAspect)
'SampleRate)
1))
(maxX←(DSPXPOSITION NIL window))
(MOVETO x y-(h+mDelta)
window)
(DRAWTO x y+h+mDelta 1 NIL window)
(MOVETO x y+h+mDelta+(FONTPROP (DSPFONT NIL window)
'DESCENT)
window)
(printout window val , # (if point:end?
then (printout NIL , point:pSS:name '>)
else (printout NIL '< point:pSS:name)))
(point:pWidth←(IMAX maxX (DSPXPOSITION NIL window))+LeftOff+(-x))
(if oldy
then (MOVETO x oldy window))
(IMOD mDelta-lf MarkCycleLength*(-lf])
)
(* * Signal Segment functions)
(DEFINEQ
(PrintSignalSegment
[LAMBDA (ss) (* ht: " 8-Nov-84 13:17")
(CONS (if SSRereadable
then SSRereadChar
else '{SS})
ss:fullName])
(SSFullName
[LAMBDA (ss) (* ht: " 9-Jan-85 21:44")
(if ss:trueName
else [ss:trueName←(PACK (NCONC (if ss:parent
then (CONS (SSFullName ss:parent)
NIL))
(LIST '/(if ss:name
elseif SSRereadable
then (printout T
"assigning random name to unnamed signal segment")
ss:name←(GENSYM 'SS)
ss:name
else 'anon]
ss:trueName])
(FindSS
[LAMBDA (fullName expandFlg dontCacheFlg) (* ht: "12-Jan-85 10:56")
(* * Tries to find an SS given its name. Looks first in SSDir, then in SignalFiles, and in the latter case creates
it)
(* * * * * * * * * temporary tie-down -
see documentation for discussion * * * * * * * * *)
expandFlg←T
(* * * * * * * * * temporary tie-down -
see documentation for discussion * * * * * * * * *)
(OR (GETHASH fullName SSDir)
(for sf in SignalFiles
do
(* * First check if it%'s there -
if so, build it and then read it (to stop regress on backpointers to this from sub-segments))
(if (LOOKUPHASHFILE fullName NIL sf)
then (RETURN (PROG1 (SSFromFile (PUTHASH fullName (create SignalSegment
trueName ← fullName)
SSDir)
(RESETVARS ((SSExpandFlg expandFlg)
(HASHFILERDTBL SSReadTable))
(RETURN (GETHASHFILE fullName sf)))
expandFlg)
(if dontCacheFlg
then (PUTHASH fullName NIL SSDir])
(PromptForSSFile
[LAMBDA (ss w) (* ht: " 9-Jan-85 22:17")
(let [(nf (MENU (create MENU
TITLE ←(CONCAT "Choose file for " (fetch fullName of ss))
ITEMS ←(CONS '{NewFile} (for sf in SignalFiles
collect (HASHFILEPROP sf 'NAME]
(SELECTQ nf
(NIL NIL)
({NewFile} (SSFile (if w
then (PromptRead w "New file name: " 1 150)
else (printout T T "New file name: ")
(READ T))
T))
nf])
(SSFile
[LAMBDA (file newFlg) (* ht: "22-Nov-84 12:32")
(* * Find or create a Signal Hash File)
(PROG [(hf (OR (HASHFILEP file)
(thereis f in SignalFiles suchthat file=(HASHFILEPROP f (QUOTE NAME)))
(AND (INFILEP file)
(OPENHASHFILE file]
(if (AND (NOT hf)
newFlg)
then (printout T file " does not exist - create it? ")
(if (QUOTE Y)=(ASKUSER DWIMWAIT (QUOTE N))
then hf←(CREATEHASHFILE file (QUOTE EXPR)
20 100)))
(if hf
then (pushnew SignalFiles hf)
else (HELP "Can:t find/make signal file " file))
(RETURN hf])
(CleanupSSFiles
[LAMBDA (files) (* ht: "11-Jan-85 20:55")
(for f in (OR files SignalFiles) do (CLOSEHASHFILE f T])
(SaveSS
[LAMBDA (ss ssFile dontScrubFlg saveSubs w) (* ht: "11-Jan-85 19:48")
(* * Store an SS in a hashfile. ssFile should either be a signal hashfile, or name one)
(let ((ss (if (type? SignalSegment ss)
then ss
else (FindSS ss)))
hf fullName)
(fullName←ss:fullName)
(if ssFile
then (hf←(SSFile ssFile T))
(if (LOOKUPHASHFILE fullName NIL hf NIL)
then (PROMPTPRINT "replacing"))
elseif hf←(for f in SignalFiles thereis (LOOKUPHASHFILE fullName NIL f NIL))
else hf←(PromptForSSFile ss w))
(* * note that the use of fullName above guarantees that trueName is accurate)
(if hf
then (RESETVARS ((SSRereadable T))
(PUTHASHFILE fullName (SSFileForm ss)
hf))
(if saveSubs
then (for p in ss:points::1 unless p:end?
do (SaveSS p:pSS hf dontScrubFlg saveSubs w)))
(if (NOT dontScrubFlg)
then (ScrubSS ss))
else (PROMPTPRINT "Not saved"))
ss])
(SSRead
[LAMBDA (file) (* ht: "10-Jan-85 12:37")
(let ((name (READ file)))
(RESETLST (RESETSAVE NIL (LIST 'SETFILEPTR file (GETFILEPTR file)))
(SELECTQ SSExpandFlg
((0 NIL)
name)
(T (FindSS name T))
(if (NUMBERP SSExpandFlg)
then (FindSS name SSExpandFlg-1)
else (SHOULDNT SSExpandFlg])
(SSFromFile
[LAMBDA (ss ssForm expandFlg) (* ht: "12-Jan-85 11:36")
(* * Make an SS from its file form)
(if (NOT (EQUAL ssForm:version SSVersionStamp))
then (HELP "wrong version"))
(for f in SSFields as v in ssForm:fields do (RECORDACCESS f ss NIL 'REPLACE v))
(* * * note this only works because expandFlg is forced to T * *)
[if ssForm:subs
then ss:points←(CONS NIL
(SORT [bind subSS for subName in ssForm:subs
join (subSS←(if expandFlg
then (FindSS subName expandFlg)
else subName))
(LIST (create PointRec
pSS ← subSS
pWidth ←(3*LeftOff))
(create PointRec
pSS ← subSS
end? ← T
pWidth ←(3*LeftOff]
(FUNCTION (LAMBDA (p1 p2)
(ILESSP p1:pPtr p2:pPtr]
ss])
(SSFileForm
[LAMBDA (ss) (* ht: "12-Jan-85 11:14")
(create SSFileForm
version ← SSVersionStamp
fields ←(for f in SSFields collect (RECORDACCESS f ss))
subs ←(for p in ss:points::1 unless p:end? collect p:pSS:fullName])
(SSNewName
[LAMBDA (ss name) (* ht: " 8-Nov-84 13:28")
(if ss:localName
then (HELP 'renaming)
else ss:localName←name
(PUTHASH ss:fullName ss SSDir])
)
(* * arrays as signal data)
(RPAQQ ArrayOffset 2048)
(DEFINEQ
(RepaintSingleValuedAspect/Array
[LAMBDA (window region) (* ht: "16-Apr-85 21:51")
(let ((scale (WINDOWPROP window 'ScaleFactor))
(iScale (WINDOWPROP window 'IntegerScaleFactor))
(stream (WINDOWPROP window 'DSP))
bottom)
(* * This code assumes all pointers will be smallp, and doesn%'t use any boxing hacks)
[if (NOT iScale)
then (WINDOWPROP window 'IntegerScaleFactor
iScale←(FIX (FQUOTIENT 1.0 scale]
(if (NOT region)
then region←(DSPCLIPPINGREGION NIL stream))
(bottom←region:BOTTOM+(DSPYOFFSET NIL stream))
(\RepaintSignalSliceFromArray region (WINDOWPROP window 'SignalFile)
(IPLUS (WINDOWPROP window 'SignalBase)
(DSPYOFFSET NIL window))
(WINDOWPROP window 'SignalHeight)
(WINDOWPROP window 'SignalSegment)
(WINDOWPROP window 'Compression)
(WINDOWPROP window 'DrawMode)
iScale stream (DSPDESTINATION NIL stream)
bottom bottom+region:HEIGHT])
(\RepaintSignalSliceFromArray
[LAMBDA (region array base height ss compr mode iScale stream destBM bottom top)
(* ht: "17-Apr-85 21:45")
(* * This code assumes all pointers will be smallp, and doesn%'t use any boxing hacks)
(DSPFILL region NIL NIL stream)
(let ((dispPos (IPLUS region:LEFT (DSPXOFFSET NIL stream)))
(truePos region:LEFT*compr)
(left region:LEFT+(DSPXOFFSET NIL stream))
right y)
(right←left+region:WIDTH)
(SELECTQ mode
((NIL Line)
y←
(IQUOTIENT (ELT array (MAX truePos-compr 0))
-ArrayOffset iScale)
+base
(for i from 1 to (IMIN region:WIDTH+1 (ss:duration+ss:offset)/compr-region:LEFT)
do (\CLIPANDDRAWLINE1 dispPos-1 y dispPos y←(IQUOTIENT (ELT array truePos)
-ArrayOffset iScale)
+base 'REPLACE
destBM left right bottom top stream)
(add dispPos 1)
(add truePos compr)))
(Bit
(* * this is now full of hax borrowed from BITMAPBIT to make it run fast)
(* DDDestination field, i sure hope)
(for i from 1 to (IMIN region:WIDTH+1 (ss:duration+ss:offset)
/compr-region:LEFT)
do (BITMAPBIT destBM dispPos y←(IPLUS (IQUOTIENT (ELT array truePos)
-ArrayOffset iScale)
base)
1)
(add dispPos 1)
(add truePos compr)))
(SHOULDNT])
)
(* * record and playback)
(RPAQQ SSDMAChannel 1)
(RPAQQ SSPCA/DInputChannel 0)
(RPAQQ SSPCD/AOutputChannel 1)
(RPAQQ \SSDrawPointTime 1.0)
(RPAQQ \SSFetchPerHundredTime .55)
(RPAQQ \SSWriteToCoreTime .07)
(RPAQQ \SSWriteToDskTime .4)
(RPAQQ \SSDataArray NIL)
(RPAQQ \SSOutputArray NIL)
(DEFINEQ
(RecordSegment
[LAMBDA (ss window) (* ht: "19-Apr-85 16:56")
(if (NOT (AspectProperty ss 'Data
'DataFile))
then (ERROR "need file to record to - this ss lacks one" ss)
else (RESETLST (RESETSAVE (TTYDISPLAYSTREAM window))
(RESETSAVE (RECLAIMMIN MAX.SMALLP))
(let ((width (WINDOWPROP window 'WIDTH))
[writing (NOT (WINDOWPROP window 'DontWrite]
(compression (OR (WINDOWPROP window 'Compression
1)
1))
(sampleRate (AspectProperty ss 'Data
'SampleRate))
(old (ATTACHEDWINDOWREGION window))
(ampl (AspectProperty ss 'Data
'MaxAmplitude))
dataWidth sliceWidth arraySize nSlices correctSize correctWidth file
sliceSize xferSize estLength nPages device array)
(CLEARW window)
(UpdateSignalOrigin window)
(printout T "initializing for record ..." T)
array←(if (ARRAYP \SSDataArray)
else (ARRAY 16384 'WORD
ArrayOffset 0 128))
[if writing
then (file←(OPENSTREAM (AspectProperty ss 'Data
'DataFile)
'OUTPUT))
(if [NOT (MEMB device←(FILENAMEFIELD (FULLNAME file)
'HOST)
'(CORE NIL DSK)]
then (ERROR "can't record to a file on this device" file))
(if (NOT (ILESSP sampleRate (MaxSampleRate device)))
then (ERROR "Sample rate too high - max is " (MaxSampleRate
device)))
(estLength←(OR (PromptRead window
"Estimated length of recording (in seconds): "
1 250)
5))
(nPages←(IPLUS (IQUOTIENT sampleRate*estLength 256)
1))
(SELECTQ device
((NIL CORE)
(* * touch all pages on the file to (hopefully) speed things up)
(for i from 0 to nPages
do (SETFILEPTR file i*512)
(BOUT file 0)))
(DSK
(* * touch last page on the file to (hopefully) speed things up)
(SETFILEPTR file nPages*512)
(BOUT file 0)
(* * not safe -
(OR (LISTP \SSPrivateBuffers) \SSPrivateBuffers← (for i from 0 to 16128 by 256 collect (\ADDBASE
(ARRAYBASE array) i))))
NIL)
(SHOULDNT))
(* * close it to get the system%'s hands off that last page)
(file←(OPENSTREAM (CLOSEF file)
'OUTPUT]
sliceSize←dataWidth←(ITIMES compression width)
arraySize←16384
(for i from 2 until xferSize←sliceSize+[FIX (SkipSize sampleRate
compression sliceSize
NIL
(if writing
then device
else 'NULL]
le arraySize
do (if (ZEROP sliceSize←dataWidth/i)
then (HELP "gone to zero")))
ss:duration←arraySize
sliceWidth←(IQUOTIENT sliceSize compression)
sliceSize←(ITIMES sliceWidth compression)
(UndisplayAspect (WINDOWPROP window 'DisplayedAspect)
ss window)
(WINDOWPROP window 'DisplayedAspect
'Data)
(WINDOWPROP window 'REPAINTFN
(FUNCTION RepaintSingleValuedAspect))
(WINDOWPROP window 'PositionFn
(FUNCTION CarefulSFP))
(WINDOWPROP window 'GetFn
(FUNCTION WIN16))
(UpdateScaleFactor window ampl T)
(for link in (WINDOWPROP window 'LinkedWindows) do (CLOSEW link:lWindow))
(WINDOWPROP window 'SignalFile
array)
(WINDOWPROP window 'Compression
compression)
(WINDOWPROP window 'SignalOrigin
0)
(* * make sure there are an integral number of slices in the window)
correctWidth←(ITIMES sliceWidth nSlices←(IQUOTIENT width sliceWidth))
correctSize←(ITIMES sliceSize nSlices)
(if (NOT (IEQP width correctWidth))
then [SHAPEW window
(create REGION
LEFT ← old:LEFT
BOTTOM ← old:BOTTOM
HEIGHT ← old:HEIGHT
WIDTH ←(old:WIDTH-(width-correctWidth]
else (REDISPLAYW window))
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK (FIX (FQUOTIENT (FQUOTIENT 1.0 sampleRate)
1.25E-6)))
(PCDAC.SETUPDMA 1 0 32768 T T)
(PCDAC.SETA/DPARAMETERS (OR (WINDOWPROP window 'InputGainCode)
0)
SSPCA/DInputChannel)
(UpdateSignalCompression window)
(TOTOPW window)
(RECLAIM)
(PCDAC.STARTREADA/D T T)
(printout T "Type STOP to stop: ")
(if writing
then (SELECTQ device
((NIL CORE)
(RecordToCoreFile ss window xferSize sliceWidth
sliceSize compression correctSize
array file))
(DSK (RecordToDskFile ss window xferSize sliceWidth
sliceSize compression correctSize
array file))
(SHOULDNT))
else (RecordToDisplayOnly ss window xferSize sliceWidth sliceSize
compression correctSize array))
(PCDAC.STOP)
(PCDAC.CLEARERROR)
(if writing
then (WINDOWPROP window 'SignalFile
(OPENSTREAM (CLOSEF file)
'INPUT))
(ss:duration←(LRSH (GETFILEINFO (WINDOWPROP window 'SignalFile)
'LENGTH)
1))
(REDISPLAYW window])
(RecordToCoreFile
[LAMBDA (ss window xferSize sliceWidth sliceSize compression correctSize array file)
(* ht: "18-Apr-85 15:37")
(bind (nextBufEnd ← xferSize)
(lastArrayPtr ← 0)
(redisplayRegion ←(APPEND (DSPCLIPPINGREGION NIL window)))
(scale ←(WINDOWPROP window 'ScaleFactor))
(iScale ←(WINDOWPROP window 'IntegerScaleFactor))
(stream ←(WINDOWPROP window 'DSP))
(base ←(IPLUS (WINDOWPROP window 'SignalBase)
(DSPYOFFSET NIL window)))
(height ←(WINDOWPROP window 'SignalHeight))
(mode ←(WINDOWPROP window 'DrawMode))
bottom destBM top lastBufEnd currentAddress wrapped
first (redisplayRegion:LEFT←0)
(redisplayRegion:WIDTH←sliceWidth)
[if (NOT iScale)
then (WINDOWPROP window 'IntegerScaleFactor
iScale←(FIX (FQUOTIENT 1.0 scale]
(bottom←redisplayRegion:BOTTOM+(DSPYOFFSET NIL stream))
(destBM←(DSPDESTINATION NIL stream))
(top←bottom+redisplayRegion:HEIGHT)
until (KEYDOWNP 'STOP)
do (* (PCDAC.ERROR?))
(* * Get the current location of the dma transfer, in words. Open coded for speed)
(if (BUSDMA.UPDATEADDR SSDMAChannel currentAddress wrapped T)
then (add currentAddress 32768))
(if (ILESSP currentAddress nextBufEnd)
then (GO $$LP)
elseif (GREATERP currentAddress nextBufEnd+xferSize)
then (* falling behind -
punt)
(nextBufEnd←currentAddress)
(lastArrayPtr←0)
(redisplayRegion:LEFT←0)
(FLASHWINDOW window)
(wrapped←NIL))
(if (GREATERP nextBufEnd 32768)
then (* slice lies across buffer end)
(wrapped←NIL)
(nextBufEnd←nextBufEnd-32768))
(if (MINUSP lastBufEnd←nextBufEnd-xferSize)
then (FetchArray array 32768+lastBufEnd (-lastBufEnd)
'SWAP
0)
(FetchArray array 0 nextBufEnd 'SWAP
(-lastBufEnd))
else (FetchArray array lastBufEnd xferSize 'SWAP
0))
(* * Dont call redisplayw, because it does a resetvars which burns conses which we can%'t afford)
(\RepaintSignalSliceFromArray redisplayRegion array base height ss compression mode iScale
stream destBM bottom top)
(\BOUTS file (ARRAYBASE array)
0
(LLSH xferSize 1))
(add redisplayRegion:LEFT sliceWidth)
(add nextBufEnd xferSize)
(if (add lastArrayPtr sliceSize)=correctSize
then (lastArrayPtr←0)
(redisplayRegion:LEFT←0])
(RecordToDisplayOnly
[LAMBDA (ss window xferSize sliceWidth sliceSize compression correctSize array)
(* ht: "18-Apr-85 14:46")
(bind (nextBufEnd ← xferSize)
(lastArrayPtr ← 0)
(redisplayRegion ←(APPEND (DSPCLIPPINGREGION NIL window)))
(scale ←(WINDOWPROP window 'ScaleFactor))
(iScale ←(WINDOWPROP window 'IntegerScaleFactor))
(stream ←(WINDOWPROP window 'DSP))
(base ←(IPLUS (WINDOWPROP window 'SignalBase)
(DSPYOFFSET NIL window)))
(height ←(WINDOWPROP window 'SignalHeight))
(mode ←(WINDOWPROP window 'DrawMode))
bottom destBM top lastBufEnd currentAddress wrapped
first (redisplayRegion:LEFT←0)
(redisplayRegion:WIDTH←sliceWidth)
[if (NOT iScale)
then (WINDOWPROP window 'IntegerScaleFactor
iScale←(FIX (FQUOTIENT 1.0 scale]
(bottom←redisplayRegion:BOTTOM+(DSPYOFFSET NIL stream))
(destBM←(DSPDESTINATION NIL stream))
(top←bottom+redisplayRegion:HEIGHT)
until (KEYDOWNP 'STOP)
do (* (PCDAC.ERROR?))
(* * Get the current location of the dma transfer, in words. Open coded for speed)
(if (BUSDMA.UPDATEADDR SSDMAChannel currentAddress wrapped T)
then (add currentAddress 32768))
(if (ILESSP currentAddress nextBufEnd)
then (GO $$LP)
elseif (GREATERP currentAddress nextBufEnd+xferSize)
then (* falling behind -
punt)
(nextBufEnd←currentAddress)
(lastArrayPtr←0)
(redisplayRegion:LEFT←0)
(FLASHWINDOW window)
(wrapped←NIL))
(if (GREATERP nextBufEnd 32768)
then (* slice lies across buffer end)
(wrapped←NIL)
(nextBufEnd←nextBufEnd-32768))
(if (MINUSP lastBufEnd←nextBufEnd-xferSize)
then (FetchArray array 32768+lastBufEnd (-lastBufEnd)
'SWAP
0)
(FetchArray array 0 nextBufEnd 'SWAP
(-lastBufEnd))
else (FetchArray array lastBufEnd xferSize 'SWAP
0))
(* * Dont call redisplayw, because it does a resetvars which burns conses which we can%'t afford)
(\RepaintSignalSliceFromArray redisplayRegion array base height ss compression mode iScale
stream destBM bottom top)
(add redisplayRegion:LEFT sliceWidth)
(add nextBufEnd xferSize)
(if (add lastArrayPtr sliceSize)=correctSize
then (lastArrayPtr←0)
(redisplayRegion:LEFT←0])
(RecordToDskFile
[LAMBDA (ss window xferSize sliceWidth sliceSize compression correctSize array file)
(* ht: "19-Apr-85 15:17")
(bind (pagesXfered ←(IQUOTIENT (IPLUS xferSize 255)
256))
(lastArrayPtr ← 0)
(nextFilePage ← 0)
(redisplayRegion ←(APPEND (DSPCLIPPINGREGION NIL window)))
(scale ←(WINDOWPROP window 'ScaleFactor))
(iScale ←(WINDOWPROP window 'IntegerScaleFactor))
(stream ←(WINDOWPROP window 'DSP))
(base ←(IPLUS (WINDOWPROP window 'SignalBase)
(DSPYOFFSET NIL window)))
(height ←(WINDOWPROP window 'SignalHeight))
(mode ←(WINDOWPROP window 'DrawMode))
myBufs bottom destBM top lastBufEnd currentAddress wrapped nextBufEnd
first
(* * not needed without \LFWritePages below -
(SETQ xferSize (ITIMES 256 pagesXfered)))
(nextBufEnd←xferSize)
(* * unsafe -
not needed without \LFWritePages below -
(myBufs← (for i from 1 to pagesXfered as m in \SSPrivateBuffers collect m)))
(redisplayRegion:LEFT←0)
(redisplayRegion:WIDTH←sliceWidth)
[if (NOT iScale)
then (WINDOWPROP window 'IntegerScaleFactor
iScale←(FIX (FQUOTIENT 1.0 scale]
(bottom←redisplayRegion:BOTTOM+(DSPYOFFSET NIL stream))
(destBM←(DSPDESTINATION NIL stream))
(top←bottom+redisplayRegion:HEIGHT)
until (KEYDOWNP 'STOP)
do (* (PCDAC.ERROR?))
(* * Get the current location of the dma transfer, in words. Open coded for speed)
(if (BUSDMA.UPDATEADDR SSDMAChannel currentAddress wrapped T)
then (add currentAddress 32768))
(if (ILESSP currentAddress nextBufEnd)
then (GO $$LP)
elseif (GREATERP currentAddress nextBufEnd+xferSize)
then (* falling behind -
punt)
(nextBufEnd←currentAddress)
(lastArrayPtr←0)
(redisplayRegion:LEFT←0)
(FLASHWINDOW window)
(wrapped←NIL))
(if (GREATERP nextBufEnd 32768)
then (* slice lies across buffer end)
(wrapped←NIL)
(nextBufEnd←nextBufEnd-32768))
(if (MINUSP lastBufEnd←nextBufEnd-xferSize)
then (FetchArray array 32768+lastBufEnd (-lastBufEnd)
'SWAP
0)
(FetchArray array 0 nextBufEnd 'SWAP
(-lastBufEnd))
else (FetchArray array lastBufEnd xferSize 'SWAP
0))
(* * Dont call redisplayw, because it does a resetvars which burns conses which we can%'t afford)
(\RepaintSignalSliceFromArray redisplayRegion array base height ss compression mode iScale
stream destBM bottom top)
(* * not safe -
(\LFWritePages file nextFilePage myBufs))
(\BOUTS file (ARRAYBASE array)
0
(LLSH xferSize 1))
(* * not needed unless the \LFWritePages comes back -
(add nextFilePage pagesXfered))
(add redisplayRegion:LEFT sliceWidth)
(add nextBufEnd xferSize)
(if (add lastArrayPtr sliceSize)=correctSize
then (lastArrayPtr←0)
(redisplayRegion:LEFT←0))
finally
(* * not needed unless the \LFWritePages comes back -
(\SETEOF file nextFilePage-1 512))
NIL])
(PlaySeg
[LAMBDA (ss w) (* ht: "17-Apr-85 22:22")
(SELECTQ (TYPENAME (WINDOWPROP w 'SignalFile))
(ARRAYP (PlayArraySeg ss w))
((STREAM LITATOM)
(PlayFileSeg ss w))
(SHOULDNT])
(PlayFileSeg
[LAMBDA (ss window) (* ht: "20-Apr-85 13:26")
(if (GREATERP ss:duration 32768)
then (HELP "segment too long for now")
else (LET [(str (OPENSTREAM (AspectProperty ss 'Data
'DataFile)
'INPUT]
(* * depends on getting the same stream as the one which must be already open)
(SETFILEPTR str (LLSH ss:offset 1))
(\BINS str (ARRAYBASE (OR (ARRAYP \SSOutputArray)
\SSOutputArray←(ARRAY 32768 'WORD
NIL 0 128)))
0
(LLSH ss:duration 1))
(PLAY.IT \SSOutputArray ss:duration (FQUOTIENT (AspectProperty ss (WINDOWPROP
window
'DisplayedAspect)
'SampleRate)
1000)
SSPCD/AOutputChannel T])
(PlayArraySeg
[LAMBDA (ss w) (* ht: "20-Apr-85 13:12")
(PLAY.IT (WINDOWPROP w 'SignalFile)
ss:duration
(FQUOTIENT (AspectProperty ss (WINDOWPROP w 'DisplayedAspect)
'SampleRate)
1000)
SSPCD/AOutputChannel T ss:offset])
(MaxSampleRate
[LAMBDA (device fetchPerHundredPoints) (* ht: "20-Apr-85 15:13")
1000.0/(SELECTQ device
((NIL CORE)
\SSWriteToCoreTime+
(OR fetchPerHundredPoints \SSFetchPerHundredTime)
/100.0)
(DSK \SSWriteToDskTime+ (OR fetchPerHundredPoints \SSFetchPerHundredTime)
/100.0)
(SHOULDNT])
(SkipSize
[LAMBDA (sampleRate compression sliceSize repaintPerPoint device fetchPerHundredPoints)
(* ht: "18-Apr-85 11:30")
(if (NOT repaintPerPoint)
then repaintPerPoint←\SSDrawPointTime)
(if (NOT fetchPerHundredPoints)
then fetchPerHundredPoints←\SSFetchPerHundredTime)
(* * this is based on the following truth? -
"rPP*sl/compr+fPP*(sl+sk)+wPP*(sl+sk)<(sl+sk)*(1000/samp)")
(LET [(fetchPerPoint fetchPerHundredPoints/100.0)
(writePerPoint (SELECTQ device
((NIL CORE)
\SSWriteToCoreTime)
(NULL 0.0)
(DSK \SSWriteToDskTime)
(SHOULDNT]
sliceSize*(((repaintPerPoint/compression+writePerPoint+fetchPerPoint)*sampleRate-1000.0)/(
1000.0-(writePerPoint+fetchPerPoint)*sampleRate])
(PlaySubSS
[LAMBDA (ss w) (* ht: "17-Apr-85 22:18")
(let ((mark (GrabMark w ss)))
(if mark
then (PlaySeg mark:pSS w])
(PLAY.IT
[LAMBDA (ARRAY NUMSAMPLES FREQKHZ DACCHANNEL STORED? offset)
(* ht: "11-Apr-85 10:43")
(let [(PCPAGE 1)
(PCMEMSIZEINWORDS 32768)
(CLOCKRATE (FIX (FQUOTIENT (FQUOTIENT 1.0 (FTIMES FREQKHZ 1000.0))
1.25E-6]
(PCDAC.STOP)
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK CLOCKRATE)
(if STORED?
then (StoreArray ARRAY 0 NUMSAMPLES 'SWAP
offset))
(PCDAC.SETUPDMA PCPAGE 0 NUMSAMPLES NIL T)
(PCDAC.SETD/APARAMETERS (OR DACCHANNEL 1))
(PCDAC.STARTWRITED/A T T])
)
(* * Signal window menu)
(RPAQQ SignalMenuItems [(Display (SetAspect SignalSegment Window)
"Gives a menu of available aspects and displays the selected one")
(Inspect (INSPECT (TrueSS SignalSegment Window))
"Bring up an inspector window on the signal segment")
(AddAspect (AddAspect (TrueSS SignalSegment Window)
Window)
"Add an (empty) new aspect"
(SUBITEMS (InheritAspect (InheritAspect (TrueSS SignalSegment
Window)
Window)
"Inherit an aspect from parent")
(CopyAspect (InheritAspect (TrueSS SignalSegment Window)
Window T)
"Inherit an aspect from parent")))
(SetProperty (AddProperty (TrueSS SignalSegment Window)
Window)
"Set a property of the current aspect")
(Save (SaveSS (TrueSS SignalSegment Window)
NIL T NIL Window)
"Save this segment on its home file"
(SUBITEMS (Save* (SaveSS (TrueSS SignalSegment Window)
NIL T T Window)
"Save this segment and all its sub-segments on its home file")
(CopyToDsk (CopyCoreFileToDsk SignalSegment Window)
"Copy the data file for this segment from {CORE} to {DSK}, and change the segment to point to that")))
(Spawn (SpawnShow SignalSegment Window)
"Spawn a window for a sub-segment")
(Link (LinkShow SignalSegment Window)
"Link another window to this display"
(SUBITEMS (Twin (\MakeLinkedWindow SignalSegment Window 0 (QUOTE
beginning))
"Link another window to this display at offset 0")
(Zoom (ZoomWindow SignalSegment Window)
"Link another window to this display zoomed in on its middle at 10/1")))
(Play (PlaySeg SignalSegment Window)
"play the ss out"
(SUBITEMS (PlaySub (PlaySubSS SignalSegment Window)
"Play a designated sub-segment")
(Quiet (PCDAC.STOP)
"Shut up!")))
(Record (RecordSegment SignalSegment Window)
"record into the ss")
(ToggleMarks (ToggleMarks SignalSegment Window)
"Start/Stop showing marks")
(JumpTo (JumpTo SignalSegment Window)
"Jump to the beginning of a named sub-segment")
(NewSS (NewSS (TrueSS SignalSegment Window)
Window)
"Add a new sub-segment"
(SUBITEMS (AddSS (AddSS (TrueSS SignalSegment Window)
Window)
"Put an existing sub-segment back in")))
(ChangeMark (MoveMark SignalSegment Window)
"Move a mark"
(SUBITEMS (MoveSS (MoveMark SignalSegment Window T)
"Move a whole sub-segment (grab and move either end)")
(DeleteSS (DeleteMark SignalSegment Window)
"Delete a sub-segment")
(RemoveSS (DeleteMark SignalSegment Window T)
"Remove a sub-segment from the display, but don't destroy it"])
(DEFINEQ
(AddAspect
[LAMBDA (ss w) (* ht: " 8-Jan-85 10:07")
(let ((n (PromptRead w "Aspect: " 1 75)))
(if n
then (push ss:aspects (CONS n NIL])
(TrueSS
[LAMBDA (ss w) (* ht: "11-Jan-85 20:12")
(* * if this is a dummy, get back to the one true parent)
(if ss:localName=NIL
then (let ((mw (MAINWINDOW w T)))
(OR (AND mw~=w (WINDOWPROP mw 'SignalSegment))
(HELP "Unnamed or disconnected segment" ss)))
else ss])
(InheritAspect
[LAMBDA (ss w copyFlg) (* ht: "11-Apr-85 14:07")
(* * Inherit aspect properties from the parent ss)
(if ss:parent
then [let [(n (MENU (create MENU
ITEMS ←(for a in (fetch aspects of (fetch parent of ss))
collect (CAR a]
(if n
then (push ss:aspects (CONS n (if copyFlg
then (COPY (GetAspect n ss:parent))
else 'Inherited]
else (PROMPTPRINT "no parent - no inheritance"])
(SpawnShow
[LAMBDA (ss w) (* ht: " 9-Jan-85 21:35")
(let ((sub (GrabMark w ss)))
(if sub
then (NewShow sub:pSS])
(AddProperty
[LAMBDA (ss w) (* ht: " 8-Jan-85 10:11")
(* * Add/set a property of the displayed aspec)
(let ((aspect (WINDOWPROP w 'DisplayedAspect))
(nl 2)
pn pv)
(if ~aspect
then (aspect←(PromptRead w "For aspect: " 3 150))
nl←NIL)
(if aspect
then pn←(PromptRead w "Property name: " nl 150))
(if pn
then pv←(PromptRead w "Property value: " NIL))
(if pv
then (AspectProperty ss aspect pn pv])
(PromptRead
[LAMBDA (w prompt nLines width) (* ht: "11-Apr-85 12:59")
(let ((pw (WINDOWPROP w 'PromptWindow))
v r)
(r←(WINDOWPROP pw:1 'REGION))
[v←(NLSETQ (PROGN (if nLines
then (r←(APPEND r))
(if (AND width width~=r:WIDTH)
then (r:LEFT←r:LEFT+(r:WIDTH-width))
(r:WIDTH←width))
(if nLines~=pw::1
then [r:HEIGHT←(HEIGHTIFWINDOW nLines*(-(DSPLINEFEED NIL pw:1]
(pw::1←nLines))
(SHAPEW pw:1 r)
(DSPRESET pw:1))
(RESETFORM (TTYDISPLAYSTREAM pw:1)
(printout T prompt)
(READ T]
(CLOSEW pw:1)
(if v
then v:1])
(ButtonSignalWindow
[LAMBDA (Window) (* ht: " 8-Jan-85 18:56")
(DECLARE (SPECVARS SignalSegment Window))
(* * buttoneventfn for signal window)
(PROG [(SignalSegment (WINDOWPROP Window 'SignalSegment]
(if (LASTMOUSESTATE MIDDLE)
then (MENU (if (type? MENU SignalWindowMenu)
then SignalWindowMenu
else SignalWindowMenu←(create MENU
ITEMS ← SignalMenuItems])
(SetAspect
[LAMBDA (ss w aspect dontDoIt) (* ht: "11-Apr-85 13:53")
[if (NOT aspect)
then aspect←(MENU (create MENU
ITEMS ←(for a in ss:aspects collect a:1]
(if aspect
then (UndisplayAspect (WINDOWPROP w 'DisplayedAspect)
ss w)
(CLEARW w)
(WINDOWPROP w 'DisplayedAspect
aspect)
(APPLY* (OR (AspectProperty ss aspect 'InitializeFunction)
DefaultInitializeFunction)
ss aspect w)
(if (NOT dontDoIt)
then (REDISPLAYW w])
(CopyCoreFileToDsk
[LAMBDA (ss w) (* ht: "19-Apr-85 19:19")
(LET ((file (WINDOWPROP w 'SignalFile))
nFile)
(if (AND file 'CORE=
(FILENAMEFIELD (if (STREAMP file)
then (FULLNAME file)
else file)
'HOST))
then [nFile←(COPYFILE file (PACKFILENAME 'HOST
'DSK
'VERSION
NIL
'BODY
(if (STREAMP file)
then (FULLNAME file)
else file]
(PROMPTPRINT (PACK* "Copied to " nFile))
(if (OPENP file)
then (CLOSEF file))
(AspectProperty ss 'Data
'DataFile
nFile)
(WINDOWPROP w 'SignalFile
(OPENSTREAM nFile 'INPUT])
)
(* * Aspect manipulation)
(RPAQQ SSAutoInheritAspects (Data))
(DEFINEQ
(GetAspect
[LAMBDA (aspect ss) (* ht: "11-Apr-85 13:53")
(bind value while value←(CDR (ASSOC aspect ss:aspects))= 'Inherited do ss← ss:parent
finally (RETURN value])
(AspectProperty
[LAMBDA N (* ht: "11-Apr-85 13:41")
(* * args are (ss aspect propertyName value))
(* * get (or set) the value of the property of the given aspect in the given ss)
(if (IGREATERP N 3)
then (\PutAspectProperty (ARG N 1)
(ARG N 2)
(ARG N 3)
(ARG N 4))
else (\GetAspectProperty (ARG N 1)
(ARG N 2)
(ARG N 3])
(UndisplayAspect
[LAMBDA (aspect ss w) (* ht: " 7-Jan-85 20:55")
(* * clean up and shut down this aspect)
(if aspect
then (APPLY* (OR (AspectProperty ss aspect 'UndisplayFunction)
DefaultUndisplayFn)
ss aspect w])
(\PutAspectProperty
[LAMBDA (ss aspect propertyName newValue) (* ht: "11-Apr-85 13:45")
(let ((aspEntry (ASSOC aspect ss:aspects)))
(if aspEntry
then [if aspEntry::1= 'Inherited
then (PROMPTPRINT T "Copying " aspect " aspect down from " ss:parent " to " ss
" in order to change it.")
(aspEntry::1←(COPY (GetAspect aspect ss:parent]
(PROG1 (CDR (ASSOC propertyName aspEntry))
(PUTASSOC propertyName newValue aspEntry))
else (HELP "not an aspect of this segment" aspect])
(\GetAspectProperty
[LAMBDA (ss aspect propertyName) (* ht: "11-Apr-85 13:48")
(let ((aspEntry (GetAspect aspect ss)))
(if aspEntry
then (CDR (FASSOC propertyName aspEntry])
)
(* * Mark manipulation)
(DEFINEQ
(NearMark
[LAMBDA (mark stream compr) (* ht: " 9-Jan-85 18:42")
(* * is the mouse near this mark?)
(if (ILEQ (IABS (LASTMOUSEX stream)
-(mark:pPtr+compr-1)/compr)
NearMarkDelta)
then mark])
(InvertMark
[LAMBDA (mark str compr y height) (* ht: " 8-Jan-85 15:45")
(* * Invert the space around the mark)
(let ((x (IDIFFERENCE (IQUOTIENT (fetch pPtr of mark)
compr)
NearMarkDelta)))
(BITBLT str x y str x y 2*NearMarkDelta 2*height 'INVERT])
(GrabMark
[LAMBDA (w ss) (* ht: "11-Jan-85 19:48")
(* * Return a marks if one is close enough to the mouse when it lets up)
(PROG ((str (DECODE/WINDOW/OR/DISPLAYSTREAM w))
(compr (WINDOWPROP w 'Compression))
(height (WINDOWPROP w 'SignalHeight))
y marks)
(y←(WINDOWPROP w 'SignalBase)
-height)
(RESETLST (RESETSAVE (SETCURSOR SSCursor1)
'(CURSOR T))
(until (MOUSESTATE LEFT) do (BLOCK))
(while (MOUSESTATE LEFT)
do (if marks
then (if (NOT (for mark in marks thereis (NearMark mark str compr)))
then (InvertMark marks:1 str compr y height)
(marks←NIL))
elseif marks←(for m in ss:points::1 when (NearMark m str compr)
collect m)
then (InvertMark marks:1 str compr y height))
(BLOCK)))
(if marks
then (InvertMark marks:1 str compr y height)
(if (for mark in marks thereis (NearMark mark str compr))
then (RETURN (if marks::1
then (ChooseMark marks)
else marks:1])
(ChooseMark
[LAMBDA (marks) (* ht: "10-Jan-85 11:15")
(let [(choice (MENU (create MENU
TITLE ← "Which one(s)?"
ITEMS ←(NCONC1 (for m in marks collect m:pSS:name)
'All]
(SELECTQ choice
(NIL)
(All (HELP "Not implemented yet"))
(for m in marks thereis m:pSS:name=choice])
(DeleteMark
[LAMBDA (ss w dontScrubFlg) (* ht: "11-Jan-85 19:48")
(* * grabs a mark, deletes it)
(let ((mark (GrabMark w ss)))
(if mark
then (\DeleteMark1 mark ss w)
(\DeleteMark1 (for p in ss:points::1 thereis p:pSS=mark:pSS)
ss w)
(if (NOT dontScrubFlg)
then (ScrubSS mark:pSS])
(ScrubSS
[LAMBDA (ss recFlg) (* ht: "11-Jan-85 19:49")
(PUTHASH ss:fullName NIL SSDir)
(* * clear circular pointers)
ss:parent←NIL
ss:aspects←NIL
(if recFlg
then (for p in ss:points::1 do (ScrubSS p:pSS T)))
ss:points←NIL
ss:localName←
'invalid ss:trueName← 'invalid])
(InsertMark
[LAMBDA (points mark) (* ht: "11-Jan-85 19:26")
(* * Safe to do this because points:1 is always NIL)
(bind (pp←points) while (AND pp::1 (IGEQ mark:pPtr pp:2:pPtr)) do (pop pp)
finally (pp::1←(CONS mark pp::1])
(\MoveMark1
[LAMBDA (mark ss w dontMove) (* ht: "12-Jan-85 11:34")
(* * move a mark by deleting it, repainting it where it is, and tracking the mouse)
(let ((str (DECODE/WINDOW/OR/DISPLAYSTREAM w))
(compr (WINDOWPROP w 'Compression))
(height (WINDOWPROP w 'SignalHeight))
(base (WINDOWPROP w 'SignalBase))
(getFn (WINDOWPROP w 'GetFn))
(posFn (WINDOWPROP w 'PositionFn))
(file (WINDOWPROP w 'SignalFile))
(del (ITIMES (IMINUS (DSPLINEFEED NIL w))
MarkCycleLength))
pos value reg left right)
(RESETLST (RESETSAVE (DSPOPERATION 'INVERT str)
(LIST 'DSPOPERATION (DSPOPERATION NIL str)
str))
pos←(mark:pPtr+compr-1)/compr reg←(DSPCLIPPINGREGION NIL w)
left←reg:LEFT
right←left+reg:WIDTH-1
(APPLY* posFn file pos*compr)
value←(APPLY* getFn file)
(ShowMark ss pos base height mark NIL del w pos*compr value)
[if (NOT dontMove)
then (RESETSAVE (SETCURSOR SSCursor2)
'(CURSOR T))
(until (MOUSESTATE LEFT) do (BLOCK))
(while (MOUSESTATE LEFT)
do (if (NOT (EQP pos (LASTMOUSEX str)))
then (ShowMark ss pos base height mark NIL del w pos*compr
value)
[pos←(IMAX left (IMIN right (LASTMOUSEX str]
(APPLY* posFn file pos*compr)
(ShowMark ss pos base height mark NIL del w pos*compr
value←(APPLY* getFn file)))
(BLOCK))
(if (INSIDEP (DSPCLIPPINGREGION NIL str)
(CURSORPOSITION NIL str))
then (mark:pPtr←pos*compr)
else (ShowMark ss pos base height mark NIL del w pos*compr value)
(APPLY* posFn file mark:pPtr)
(ShowMark ss (mark:pPtr+compr-1)/compr base height mark NIL del w
NIL (APPLY* getFn file]
(if ss:points=NIL
then ss:points←(LIST NIL))
(InsertMark ss:points mark])
(NewMark
[LAMBDA (ss w subSS end? dontMove) (* ht: "11-Jan-85 19:36")
(PROG (mark)
[if ~subSS
then subSS←(create SignalSegment
parent ← ss
name ←(OR (PromptRead w "Name for new SS: " 1 150)
(RETURN]
(mark←(create PointRec
pSS ← subSS
end? ← end?))
(\MoveMark1 mark ss w dontMove)
(RETURN mark])
(NewSS
[LAMBDA (ss w) (* ht: "17-Apr-85 22:13")
(let ((beginning (NewMark ss w)))
(if beginning
then (if (NewMark ss w beginning:pSS T)
then (for aspectName in SSAutoInheritAspects when (GetAspect aspectName ss)
do (push beginning:pSS:aspects (CONS aspectName 'Inherited])
(AddSS
[LAMBDA (ss w) (* ht: "10-Jan-85 10:25")
(let ((name (PromptRead w "Name of existing sub-segment: " 1 170))
sub)
(if sub←(FindSS (if (NTHCHAR name 1)=%'/
then name
else (PACK (LIST ss:fullName '/ name)))
T)
then (NewMark ss w sub NIL T)
(NewMark ss w sub T T)
else (PROMPTPRINT "SS by that name not found"])
(JumpTo
[LAMBDA (ss w) (* ht: "11-Jan-85 19:50")
(* * Jump the window to show a named mark)
(let ((name (PromptRead w "Name of mark: " 1 108))
mark compr)
(if name
then (mark←(for p in ss:points::1 thereis name=p:pSS:name))
(if mark
then (compr←(WINDOWPROP w 'Compression))
(PositionSignalWindow w (IMAX 0 mark:pPtr-compr*((fetch WIDTH
of (DSPCLIPPINGREGION
NIL w))/2))
compr)
(REDISPLAYW w)
else (PROMPTPRINT "No such mark"])
(ToggleMarks
[LAMBDA (ss w) (* ht: "12-Jan-85 11:38")
(if (EQMEMB 'RedisplayMarks (WINDOWPROP w 'REPAINTFN))
then (* turn off marks)
(WINDOWDELPROP w 'REPAINTFN 'RedisplayMarks)
(PROMPTPRINT "Marks no longer displayed")
(REDISPLAYW w)
else (* turn on marks)
(WINDOWADDPROP w 'REPAINTFN 'RedisplayMarks)
(PROMPTPRINT "Marks now displayed")
(for p in ss:points::1 unless (type? SignalSegment p:pSS)
do (p:pSS←(FindSS p:pSS NIL T)))
(RedisplayMarks w])
(\DeleteMark1
[LAMBDA (mark ss w) (* ht: " 9-Jan-85 22:37")
ss:points←(DREMOVE mark ss:points)
(\RedisplayMark mark ss w])
(\RedisplayMark
[LAMBDA (mark ss w) (* ht: " 9-Jan-85 22:37")
(let ((compr (WINDOWPROP w 'Compression))
(r (APPEND (DSPCLIPPINGREGION NIL w)))
truePos)
(truePos←(mark:pPtr+compr-1)/compr)
(r:LEFT←truePos-LeftOff)
(* * should compute and save in the point its width)
(r:WIDTH←mark:pWidth)
(REDISPLAYW w r])
(MoveMark
[LAMBDA (ss w bothFlg) (* ht: "11-Jan-85 21:07")
(* * move a mark by deleting it, repainting it where it is, and tracking the mouse)
(let ((mark (GrabMark w ss))
offset duration other)
(if mark
then (if bothFlg
then (offset←mark:pSS:offset)
(duration←mark:pSS:duration))
(\DeleteMark1 mark ss w)
(\MoveMark1 mark ss w)
(if bothFlg
then (other←(for p in ss:points:1 thereis (AND p:pSS=mark:pSS p:end?~=mark:end?)
))
(\DeleteMark1 other ss w)
(* * Tricky bit here -
if we%'ve moved the end around, have to fix both offset and duration, but if moved the beginning around, just the
duration needs fixed)
(* * Crucial to understanding is the fact that both mark and other have the SAME ss in them)
(if mark:end?
then mark:pSS:offset←mark:pPtr-duration)
(mark:pSS:duration←duration)
(if (EQ (fetch points of ss)
NIL)
then ss:points←(LIST NIL))
(InsertMark ss:points other)
(\RedisplayMark other ss w])
)
(RPAQ SSCursor1 (CURSORCREATE (READBITMAP) 0 15))
(16 16
"@@@@"
"@@@@"
"@@@G"
"O@@D"
"OH@G"
"AL@A"
"@O@G"
"@CO@"
"@CO@"
"@O@G"
"AL@D"
"OH@G"
"O@@A"
"@@@G"
"@@@@"
"@@@@")(RPAQ SSCursor2 (CURSORCREATE (READBITMAP) 0 15))
(16 16
"H@@@"
"L@@@"
"N@CH"
"O@B@"
"OHCH"
"OL@H"
"ONCH"
"O@@@"
"MH@@"
"IHCH"
"@LB@"
"@LCH"
"@F@H"
"@FCH"
"@C@@"
"@C@@")
(RPAQQ NearMarkDelta 3)
(RPAQQ MinSignalHeight 10)
(RPAQQ DefaultInitializeFunction SetupSignalFile)
(RPAQQ DefaultUndisplayFn CloseSignalFile)
(RPAQQ Pi 3.141592)
(RPAQQ CompressionMenu NIL)
(RPAQQ CompressionMenuItems ((1)
(Down NIL "Decrement current value")
(Up NIL "Increment current value")
(10)
(Set NIL "Read in new value")))
(RPAQQ SignalWindow NIL)
(RPAQQ MarkCycleLength 2)
(RPAQQ BitsPerSamp 1)
(RPAQQ LeftOff 24)
(RPAQQ SampsPerByte 8)
(RPAQQ SampsPerSec 7659.0)
(RPAQQ ScaleTickWidth 5)
(RPAQQ ZeroSamp 1)
(RPAQQ ZoomRatio 10)
(RPAQQ SSExpandFlg NIL)
(RPAQQ SSFields (name trueName duration offset parent aspects points comment))
(RPAQQ SSVersionStamp (2 . 1))
(RPAQ SSDir (LIST (HARRAY 50)))
(RPAQ SSReadTable (COPYREADTABLE HASHFILERDTBL))
(RPAQQ SSRereadChar #)
(RPAQQ SSRereadable NIL)
(RPAQQ SignalFiles NIL)
(RPAQQ SignalWindowMenu NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SSRereadable SSRereadChar SSDir SignalFiles SignalWindow CompressionMenu
CompressionMenuItems SSFields SSVersionStamp Pi SSExpandFlg SSReadTable SignalWindowMenu
SignalMenuItems DefaultInitializeFunction DefaultUndisplayFn MarkCycleLength
MinSignalHeight NearMarkDelta ScaleTickWidth LeftOff SSCursor1 SSCursor2 ZoomRatio
SSAutoInheritAspects ArrayOffset)
)
[DECLARE: EVAL@COMPILE
(RECORD LinkedWindow (lWindow lOffset . lType))
(RECORD PointRec (pSS pWidth end?)
[ACCESSFNS PointRec ((pPtr [LAMBDA (mark)
(COND
[(fetch end? of mark)
(IPLUS (fetch offset of (fetch pSS of mark))
(fetch duration
of (fetch pSS of mark]
(T (fetch offset of (fetch pSS of mark]
(LAMBDA (mark newValue)
(COND
[(fetch end? of mark)
(replace duration of (fetch pSS of mark)
with (IDIFFERENCE newValue
(fetch offset
of (fetch pSS of mark]
(T (add (fetch duration of (fetch pSS of mark))
(IDIFFERENCE (fetch offset
of (fetch pSS of mark))
newValue))
(replace offset of (fetch pSS of mark)
with newValue])
(RECORD SSFileForm (version subs . fields))
(DATATYPE SignalSegment (localName trueName comment points aspects parent (offset FIXP)
(duration FIXP))
(ACCESSFNS SignalSegment ((fullName SSFullName)
(name (fetch localName of DATUM)
SSNewName))))
]
(/DECLAREDATATYPE (QUOTE SignalSegment)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER FIXP FIXP))
(QUOTE ((SignalSegment 0 POINTER)
(SignalSegment 2 POINTER)
(SignalSegment 4 POINTER)
(SignalSegment 6 POINTER)
(SignalSegment 8 POINTER)
(SignalSegment 10 POINTER)
(SignalSegment 12 FIXP)
(SignalSegment 14 FIXP)))
(QUOTE 16))
(ADDTOVAR INSPECTMACROS (SignalSegment (name fullName comment points aspects parent offset duration)
[LAMBDA (INSTANCE FIELD)
(RECORDACCESS FIELD INSTANCE]
[LAMBDA (INSTANCE FIELD NEWVALUE)
(RECORDACCESS FIELD INSTANCE NIL (QUOTE /REPLACE)
NEWVALUE]))
(DEFPRINT (QUOTE SignalSegment)
(QUOTE PrintSignalSegment))
(SETSYNTAX (QUOTE #)
(QUOTE (MACRO FIRST SSRead))
SSReadTable)
(DEFINEQ
(MakeFake
[LAMBDA (f) (* edited: " 9-Nov-84 11:37")
f←(OPENFILE f (QUOTE OUTPUT)
(QUOTE NEW))
(for i from 1 to 100 do (WOUT8 f 0))
(for i from 1 to 20
do (for i from 1 to 20 do (WOUT8 f 40))
(for i from 1 to 20 do (WOUT8 f -40)))
(for i from 1 to 100 do (WOUT8 f 0))
(for i from 1 to 100 do (WOUT8 f 0))
[for j from 1 to 20 do (for i from 0 to 99 do (WOUT8 f (SinPoint i 40.0 100.0]
[for j from 1 to 20 do (for i from 0 to 99 do (WOUT8 f (SinPoint 10*i 20.0 100.0)+(SinPoint
15*i 15.0 100.0)+(SinPoint 17*i 5.0 100.0]
(CLOSEF f])
(SinPoint
[LAMBDA (i a p) (* edited: " 9-Nov-84 11:26")
(FIX (FTIMES a (SIN (FQUOTIENT 2.0*Pi*i p)
T])
)
(FILESLOAD (SYSLOAD FROM LISPUSERS)
NOBOX PCDAC {IVY}<HTHOMPSON>LISP>DSL>BUSUTIL)
(PUTPROPS TOTOPW-IN-TOPATTACHEDWINDOWS READVICE [(TOPATTACHEDWINDOWS . TOTOPW)
(BEFORE NIL (COND ((NOT (OPENWP WINDOW))
(RETURN])
(READVISE TOTOPW-IN-TOPATTACHEDWINDOWS)
(PUTPROPS AspectProperty ARGNAMES (NIL (segment aspect propertyName {propertyValue}) . N))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
{IVY}<HTHOMPSON>LISP>DSL>BUSUTIL)
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA AspectProperty)
)
(PUTPROPS DSL COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4314 25719 (ARRAYBASE 4324 . 4482) (CloseSignalFile 4484 . 4973) (CloseSignalWindow
4975 . 5365) (CompressionButtonFn 5367 . 6157) (NewCompression 6159 . 6532) (PositionSignalWindow 6534
. 7341) (NewShow 7343 . 9625) (LinkShow 9627 . 9834) (\ComputeZoomOffset 9836 . 9986) (ZoomWindow
9988 . 10363) (\MakeLinkedWindow 10365 . 11795) (UnlinkWindow 11797 . 12108) (ClearSignalWindow 12110
. 12290) (RepaintSingleValuedAspect 12292 . 12603) (RepaintSingleValuedAspect/File 12605 . 15080) (
RedisplayMarks 15082 . 16018) (ReshapeSignalWindow 16020 . 16687) (\UpdateLinks 16689 . 17424) (
\UpdateLinkedWindows 17426 . 18656) (\ChangeLinkedOffset 18658 . 19305) (UpdateSignalCompression 19307
. 19836) (UpdateSignalOrigin 19838 . 20330) (TrueLeftMargin 20332 . 20553) (ScrollSignalWindow 20555
. 20771) (SetupSignalFile 20773 . 21771) (MakeSSForFile 21773 . 22330) (UpdateScaleFactor 22332 .
22928) (RedisplayScale 22930 . 23860) (ReshapeScaleWindow 23862 . 24159) (CarefulSFP 24161 . 24393) (
WIN16 24395 . 24585) (SecPrint 24587 . 24791) (ShowMark 24793 . 25717)) (25757 32411 (
PrintSignalSegment 25767 . 25983) (SSFullName 25985 . 26516) (FindSS 26518 . 27698) (PromptForSSFile
27700 . 28281) (SSFile 28283 . 29073) (CleanupSSFiles 29075 . 29266) (SaveSS 29268 . 30417) (SSRead
30419 . 30869) (SSFromFile 30871 . 31842) (SSFileForm 31844 . 32173) (SSNewName 32175 . 32409)) (32476
35238 (RepaintSingleValuedAspect/Array 32486 . 33621) (\RepaintSignalSliceFromArray 33623 . 35236)) (
35576 54040 (RecordSegment 35586 . 41281) (RecordToCoreFile 41283 . 44114) (RecordToDisplayOnly 44116
. 46870) (RecordToDskFile 46872 . 50435) (PlaySeg 50437 . 50724) (PlayFileSeg 50726 . 51593) (
PlayArraySeg 51595 . 51917) (MaxSampleRate 51919 . 52301) (SkipSize 52303 . 53184) (PlaySubSS 53186 .
53385) (PLAY.IT 53387 . 54038)) (56919 61645 (AddAspect 56929 . 57154) (TrueSS 57156 . 57550) (
InheritAspect 57552 . 58156) (SpawnShow 58158 . 58356) (AddProperty 58358 . 58923) (PromptRead 58925
. 59680) (ButtonSignalWindow 59682 . 60201) (SetAspect 60203 . 60808) (CopyCoreFileToDsk 60810 .
61643)) (61719 63661 (GetAspect 61729 . 61982) (AspectProperty 61984 . 62495) (UndisplayAspect 62497
. 62810) (\PutAspectProperty 62812 . 63412) (\GetAspectProperty 63414 . 63659)) (63692 73855 (
NearMark 63702 . 63983) (InvertMark 63985 . 64328) (GrabMark 64330 . 65626) (ChooseMark 65628 . 66035)
(DeleteMark 66037 . 66459) (ScrubSS 66461 . 66852) (InsertMark 66854 . 67182) (\MoveMark1 67184 .
69301) (NewMark 69303 . 69746) (NewSS 69748 . 70155) (AddSS 70157 . 70626) (JumpTo 70628 . 71279) (
ToggleMarks 71281 . 72010) (\DeleteMark1 72012 . 72199) (\RedisplayMark 72201 . 72610) (MoveMark 72612
. 73853)) (77754 78806 (MakeFake 77764 . 78624) (SinPoint 78626 . 78804)))))
STOP