(FILECREATED "14-Jan-86 11:15:10" {IVY}<HTHOMPSON>LISP>SP>DSL.;24 120411
changes to: (FNS RecordSegment)
(MACROS \RawFPlusArrays \RawFTimesArrays \RawFloatArray \RawPermArray)
(RECORDS LinkedWindow PointRec SSFileForm SignalSegment)
previous date: "11-Jan-86 17:17:16" {IVY}<HTHOMPSON>LISP>SP>DSL.;22)
(* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DSLCOMS)
(RPAQQ DSLCOMS [(* * DSL Control functions)
(FNS DSL MakeDSLControlW \PosnDSLIconW \PosnDSLCtlW MakeAndShowSS DSLControlWindowButtonFn
MakeSSForFile PrintSSName SSDir FindAndShowSS GetSS \FindSSDir UpdateDir SFNames
CloseDir SSOneDir NoticeDir CreateDir SSDir1 DTYPE)
(VARS DSLControlIcon DSLControlMenuItems (DSLControlIconW)
(\SSAmplMenu)
(\SSFormatMenu)
(\SSSampleMenu)
(\SSOffsetMenu)
(DSLControlWindow)
(DSLControlMenu))
(* * signal window functions)
(FNS CloseSignalFile CloseSignalWindow CompressionButtonFn NewCompression \CheckWidthVsCompr
PositionSignalWindow NewShow MakePrompt LinkShow \ComputeZoomOffset ZoomWindow
\MakeLinkedWindow UnlinkWindow ClearSignalWindow RepaintSingleValuedAspect
RepaintSingleValuedAspect/File RedisplayMarks ReshapeSignalWindow \UpdateLinks
\UpdateLinkedWindows \ChangeLinkedOffset UpdateSignalCompression UpdateSignalOrigin
TrueLeftMargin ScrollSignalWindow SetupSignalFile UpdateScaleFactor RedisplayScale
ReshapeScaleWindow CarefulSFP 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 \SetupArrays)
(* * record and playback)
(VARS SSPCA/DInputChannel SSPCD/AOutputChannel \SSDrawPointTime \SSFetchPerHundredTime
\SSWriteToCoreTime \SSWriteToDskTime)
(INITVARS (\SSDataArray (ARRAY 32768 'WORD
0 0 128)))
(CONSTANTS (PCDACClockInverse 1.25E-6)
(SSDMAChannel 1))
(FNS RecordSegment RecordToFile PlaySeg PlayFileSeg PlayArraySeg MaxSampleRate SkipSize
PlaySubSS PLAY.IT \SSShutUpBoard)
(* * Signal window menu)
(VARS SignalMenuItems)
(FNS AddAspect ChooseAspect ClipSeg ClipSubSeg DescribeAspect TrueSS InheritAspect SpawnShow
AddProperty DSLPromptRead 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 ChooseMarkSelectFn
MenuChooseMark)
(CURSORS SSCursor1 SSCursor2)
(VARS \DSLNoDataShade (\MarkOprInProgress)
(NearMarkDelta 3)
(MinSignalHeight 10)
(DefaultInitializeFunction 'SetupSignalFile)
(DefaultUndisplayFn 'CloseSignalFile)
Pi
(CompressionMenu)
CompressionMenuItems
(SignalWindow)
(MarkCycleLength 2)
LeftOff BitsPerSamp SampsPerByte SampsPerSec (ScaleTickWidth 5)
ZeroSamp
(ZoomRatio 10))
(VARS (SSExpandFlg)
(SSFields '(name trueName duration offset parent aspects points comment))
(SSVersionStamp '(2 . 1))
(SSDir (LIST (HARRAY 50)))
(SSRereadChar '#)
(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 \MarkOprInProgress)
(DECLARE: DONTCOPY (RECORDS LinkedWindow PointRec SSFileForm SignalSegment))
(DECLARE: DONTEVAL@LOAD DOCOPY (SYSRECORDS SignalSegment)
(INITRECORDS 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 '/REPLACE
NEWVALUE]
(BackgroundMenuCommands (DSL (DSL)
"Start up the Digital Signal Lab")))
(FILES (SYSLOAD)
HASH BUSMASTER PCDAC)
(* the next stuff is for the release DSL only - it includes stuff private to HT)
(COMS * MOVEDATACOMS)
(COMS * RAWCOMS)
(COMS * CFIXCOMS)
(VARS (SSReadTable (COPYREADTABLE HASHFILERDTBL))
(\ZeroArray (ARRAY 16384 'WORD
(\PCDAC.DATAOFFSET PCDAC.BOARD)
0)))
(P (SETQ BackgroundMenu NIL)
(DEFPRINT 'SignalSegment
'PrintSignalSegment)
(SETSYNTAX '#
'(MACRO FIRST SSRead)
SSReadTable))
(PROP ARGNAMES AspectProperty)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
BUSMASTER.DCOM PCDAC.DCOM)
(P (RESETSAVE DWIMIFYCOMPFLG T)
(COND ([NOT (OR (GETP 'ARRAYBASE
'DMACRO)
(GETP 'ARRAYBASE
'MACRO]
(HELP "ARRAYBASE needed - load macro def'n from somewhere and/or RETURN"]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA AspectProperty])
(* * DSL Control functions)
(DEFINEQ
(DSL
[LAMBDA NIL (* ht: " 6-Jan-86 13:59")
(TOTOPW (if (WINDOWP DSLControlIconW)
then DSLControlIconW
else (MakeDSLControlW)))
(if (DTYPE)= 'TIGER
then (BUS.RESET)
(BUSDMA.INIT])
(MakeDSLControlW
[LAMBDA NIL (* ht: " 6-Jan-86 14:13")
(LET ((w DSLControlWindow←(CREATEW (GETBOXREGION 200 200 NIL NIL NIL
"Specify the position of the DSL control window please")
"DSL Control" NIL T))
iw wr)
wr←(WINDOWPROP DSLControlWindow 'REGION)
iw←DSLControlIconW←(CREATEW '(0 0 59 59)
NIL NIL T)
(\PosnDSLIconW)
(BITBLT DSLControlIcon 0 0 DSLControlIconW 3 3)
(OPENW DSLControlIconW)
[WINDOWADDPROP DSLControlWindow 'SHRINKFN
(FUNCTION (LAMBDA (w)
(CLOSEW w)
'DON'T]
(WINDOWADDPROP DSLControlWindow 'AFTERMOVEFN
(FUNCTION \PosnDSLIconW))
(WINDOWPROP DSLControlWindow 'BUTTONEVENTFN
(FUNCTION DSLControlWindowButtonFn))
(MakePrompt DSLControlWindow)
(DSPSCROLL 'ON
DSLControlWindow)
(WINDOWPROP DSLControlIconW 'SHRINKFN
'DON'T)
(WINDOWPROP DSLControlIconW 'BUTTONEVENTFN
(FUNCTION DSLControlWindowButtonFn))
(WINDOWPROP DSLControlIconW 'PromptWindow
(WINDOWPROP DSLControlWindow 'PromptWindow))
(WINDOWPROP DSLControlIconW 'DSLOutputWindow
DSLControlWindow)
(WINDOWPROP DSLControlIconW 'AFTERMOVEFN
(FUNCTION \PosnDSLCtlW))
DSLControlIconW])
(\PosnDSLIconW
[LAMBDA NIL (* ht: " 6-Jan-86 14:10")
(LET [(wr (WINDOWPROP DSLControlWindow 'REGION]
(if DSLControlIconW:LEFT~=wr:PRIGHT-59
then (MOVEW DSLControlIconW wr:PRIGHT-59 wr:PTOP-59)
(if (OPENWP DSLControlWindow)
then (TOTOPW DSLControlWindow])
(\PosnDSLCtlW
[LAMBDA NIL (* ht: " 6-Jan-86 14:13")
(LET [(wr (WINDOWPROP DSLControlIconW 'REGION]
(if DSLControlWindow:LEFT~=wr:PRIGHT-200
then (MOVEW DSLControlWindow wr:PRIGHT-200 wr:PTOP-200])
(MakeAndShowSS
[LAMBDA ($window$)
(DECLARE (SPECVARS $window$)) (* ht: "16-Aug-85 09:40")
(LET ((name (DSLPromptRead $window$ "Name of new SS: " 2 120))
file ampl sample format offset)
(if name
then file←(DSLPromptRead $window$ "Name of data file: "))
[if file
then ampl←(MENU (OR \SSAmplMenu \SSAmplMenu←(create
MENU
TITLE ← "Max Amplitude"
ITEMS ← '(1000 2048 16384 (Other (DSLPromptRead $window$
"Amplitude: "
1 100)))]
[if ampl
then sample←(MENU (OR \SSSampleMenu \SSSampleMenu←(create MENU
TITLE ← "Sample Rate"
ITEMS ←
'((5K 5000)
(10K 10000)
(27K 27000))]
[if sample
then format←(MENU (OR \SSFormatMenu \SSFormatMenu←(create MENU
TITLE ← "Data Format"
ITEMS ←
'(VAX DLion/MCmp)]
[if format
then offset←(MENU (OR \SSOffsetMenu \SSOffsetMenu←(create
MENU
TITLE ← "Sample Offset"
ITEMS ← '(Default (Other (DSLPromptRead $window$
"offset: "
1 75)))]
(if offset
then (NewShow (MakeSSForFile name file NIL ampl sample (if format= 'DLion/MCmp
then NIL
else format)
(if offset= 'Default
then NIL
else offset])
(DSLControlWindowButtonFn
[LAMBDA (Window) (* ht: " 7-Jan-86 11:19")
Window←(MAINWINDOW Window)
(if (MOUSESTATE LEFT)
then (MOVEW Window)
else (RESETFORM (TTYDISPLAYSTREAM (OR (WINDOWPROP Window 'DSLOutputWindow)
Window))
(MENU (OR DSLControlMenu DSLControlMenu←(create MENU
ITEMS ←
DSLControlMenuItems])
(MakeSSForFile
[LAMBDA (name fileName size ampl rate format offset) (* ht: "16-Aug-85 09:40")
(LET ((duration (OR size (if (INFILEP fileName)
then (LRSH (GETFILEINFO fileName 'LENGTH)
1))
0)))
(create SignalSegment
name ← name
duration ←(SELECTQ format
(VAX (IDIFFERENCE duration 256))
duration)
offset ←(SELECTQ format
(VAX 256)
0)
aspects ←(DSUBST (OR ampl 2048)
'ampl
(DSUBST (OR rate 10000)
'rate
(DSUBST format 'format (DSUBST (OR offset (SELECTQ
format
(VAX 0)
2048))
'offset
(SUBST (OR (INFILEP fileName)
fileName)
'fileName '((Data
(DataFile . fileName)
(SampleRate . rate)
(MaxAmplitude . ampl)
(SampleOffset .
offset)
(SampleFormat .
format])
(PrintSSName
[LAMBDA (key) (* ht: "20-May-85 13:50")
(if (OR $AllFlg$ (NOT (STRPOS "/" key 2)))
then (printout NIL , key])
(SSDir
[LAMBDA (file allFlg) (* ht: "15-May-85 11:31")
(if file
then (SSDir1 file allFlg)
else (SSDir1 SSDir allFlg)
(for sf in SignalFiles do (SSDir1 sf allFlg])
(FindAndShowSS
[LAMBDA (window) (* ht: "16-Aug-85 09:40")
(LET ((ss (GetSS window))
ow)
(if ss
then (if ow←(for w in (OPENWINDOWS) thereis (WINDOWPROP w 'SignalSegment)
=ss)
then (TOTOPW ow)
else (NewShow ss])
(GetSS
[LAMBDA (window) (* ht: "16-Aug-85 09:41")
(LET ((location (\FindSSDir T window))
ssName $result$)
(DECLARE (SPECVARS $result$))
[SELECTQ location
(NIL)
({typein} ssName← (DSLPromptRead window "Name of SS: " 1 100))
(PROGN (SELECTQ (TYPENAME (if (LISTP location)
then location:1
else location))
[ARRAYP (if (HASHFILEP location)
then (MAPHASHFILE
location
(FUNCTION (LAMBDA (key)
(if (NOT (STRPOS "/" key 2))
then (push $result$ key]
[HARRAYP (MAPHASH location
(FUNCTION (LAMBDA (val key)
(if (AND val:home=NIL
(NOT (STRPOS
"/" key 2)))
then (push $result$ key]
NIL)
(if $result$
then ssName←(MENU (create MENU
ITEMS ← $result$))
else (printout NIL "No segments there" T]
(if ssName
then (if (FindSS ssName)
else (printout NIL ssName " not found" T)
NIL])
(\FindSSDir
[LAMBDA (nowhereFlg readWindow) (* ht: " 3-Jan-86 15:41")
(LET ((items (SFNames)))
[if nowhereFlg
then items←(NCONC1 items '(NowhereYet SSDir)]
(if readWindow
then items←(NCONC1 items '{typein}))
(MENU (create MENU
ITEMS ← items])
(UpdateDir
[LAMBDA NIL (* ht: "16-Aug-85 09:41")
(LET ((hf (\FindSSDir)))
(if hf
then (CleanupSSFiles (LIST hf])
(SFNames
[LAMBDA NIL (* ht: "22-May-85 16:10")
(for hf in SignalFiles collect (LIST (ROOTFILENAME (HASHFILEPROP hf 'NAME))
hf])
(CloseDir
[LAMBDA NIL (* ht: "16-Aug-85 09:41")
(LET ((hf (\FindSSDir)))
(if hf
then (CLOSEHASHFILE hf)
(SignalFiles←(DREMOVE hf SignalFiles])
(SSOneDir
[LAMBDA NIL (* ht: "16-Aug-85 09:41")
(LET ((hf (\FindSSDir T)))
(if hf
then (SSDir1 hf])
(NoticeDir
[LAMBDA (window) (* ht: "16-Aug-85 09:41")
(LET ((file (DSLPromptRead window "SS Directory File: " 1 150)))
(if file
then (SSFile file])
(CreateDir
[LAMBDA (window) (* ht: "16-Aug-85 09:41")
(LET ((file (DSLPromptRead window "New SS Directory File: " 1 150)))
(if file
then (if (INFILEP file)
then (printout (WINDOWPROP window 'DSLOutputWindow)
"Note - " file "already exists and will not be recreated" T))
(SSFile file T])
(SSDir1
[LAMBDA (file $AllFlg$) (* ht: "22-May-85 17:04")
(DECLARE (SPECVARS $AllFlg$))
(SELECTQ (TYPENAME (if (LISTP file)
then file:1
else file))
(ARRAYP (if (HASHFILEP file)
then (printout T (ROOTFILENAME (HASHFILENAME file))
#
(MAPHASHFILE file (FUNCTION PrintSSName))
T)))
(HARRAYP (printout T # [MAPHASH file (FUNCTION (LAMBDA (val key)
(if val:home=NIL
then (PrintSSName key]
T))
NIL])
(DTYPE
[LAMBDA NIL (* ht: "27-May-85 13:11")
(if (NLSETQ (\BUSBLTINBYTES [ARRAYBASE (CONSTANT (ARRAY 1 'WORD]
15 0 1))
then 'TIGER
else 'LION])
)
(RPAQ DSLControlIcon (READBITMAP))
(53 53
"HA@@@@@@@@@@@@@@"
"HA@@@@@@@@@@@@@@"
"JA@@@@@@@@@@@@@@"
"JA@@@@@@@@@@@@@@"
"JA@@@@@@@@@@@@@@"
"JA@@@@@@@@@@@@@@"
"JA@@@@@@@@@@@@@@"
"KA@@@@@@@@@@@@@@"
"KAH@@@@@@@@@@@@@"
"KAH@@@@@@@@@@@@@"
"KAH@@@@@@@@@@@@@"
"KAH@@@@@@@@@@@@@"
"KAH@D@@@@@@@@@@@"
"KBH@D@@@@@@@@@@@"
"KBH@D@@@@@@@@@@@"
"KBJ@D@@@@@@@@@@@"
"KBJ@D@@@@@@@@@@@"
"KBJ@L@D@@B@@@@@@"
"KBJHJ@F@@BA@@@@@"
"KBJHJBF@@EA@@@@@"
"KBJHJBJDHEAH@@@@"
"KBJLJBIFLEBH@@@@"
"KFJLJFIFJEBHHH@@"
"KFKMBFIFJIBKDH@@"
"KFKMBEIEAIBFE@@@"
"KFKEBEAEAIBDC@@@"
"ODKCBIAE@@L@B@@@"
"ODKBBIAE@@L@@@@@"
"MDKBBIAD@@L@@@@@"
"MDGBAHAH@@L@@@@@"
"LLE@AH@H@@H@@@@@"
"LLE@AH@H@@@@@@@@"
"LLD@A@@H@@@@@@@@"
"LLD@A@@H@@@@@@@@"
"DLD@A@@H@@@@@@@@"
"DLD@A@@H@@@@@@@@"
"DHD@@@@H@@@@@@@@"
"DHD@@@@@@@@@@@@@"
"DHD@@@@@@@@@@@@@"
"DHD@@@@@@@@@@@@@"
"DHDCOH@GNAH@@@@@"
"DHDCON@OOAH@@@@@"
"DHDC@OALCIH@@@@@"
"DHDC@CAHAIH@@@@@"
"DH@C@CIN@AH@@@@@"
"DH@C@AHONAH@@@@@"
"DH@C@AHCOAH@@@@@"
"DH@C@AH@CIH@@@@@"
"DH@C@CIHAIH@@@@@"
"DH@C@CAHAIH@@@@@"
"D@@C@OALCIH@@@@@"
"D@@CON@OOAOO@@@@"
"D@@COH@GNAOO@@@@")
(RPAQQ DSLControlMenuItems [(Checkout (if (EQ (DTYPE)
'TIGER)
then
(if (PC.CHECKOUT T)
then
(printout T "D/A-A/D okay." T)
else
(printout T
"D/A-A/D not there or powered down or bust."
T))
else
(printout T "Not on a Dandytiger - can't use D/A-A/D" T))
"Check that the D/A-A/D equipment is OK")
(NoticeDir (NoticeDir Window)
"notice an existing SS directory file"
(SUBITEMS (CreateDir (CreateDir Window)
"Create a new, empty SS directory file")
))
(UpdateDir (UpdateDir)
"Update all the directory files to accurately reflect their current contents")
(CloseDir (CloseDir)
"Close and remove from view a directory file")
(DirList (SSDir)
"list all the top level SSs we know about"
(SUBITEMS (DirList' (SSOneDir)
"list all the top level SSs in a specified directory")))
(MakeSS (MakeAndShowSS Window)
"Make up a new signal segment and display it")
(ShowSS (FindAndShowSS Window)
"Display a selected signal segment")
(SaveSS* (SaveSS (GetSS Window)
NIL T T Window)
"Save a segment and all its sub-segments on its home file"
(SUBITEMS (SaveSS (SaveSS (GetSS Window)
NIL T NIL Window)
"Save a segment alone (not its sub-segments) on its home file")))
(DeleteSS* (ScrubSS (GetSS Window)
T)
"Delete a segment and all its sub-segments from its home file"
(SUBITEMS (Delete (ScrubSS (GetSS Window)
NIL)
"Delete a segment alone (not its sub-segments) from its home file"])
(RPAQQ DSLControlIconW NIL)
(RPAQQ \SSAmplMenu NIL)
(RPAQQ \SSFormatMenu NIL)
(RPAQQ \SSSampleMenu NIL)
(RPAQQ \SSOffsetMenu NIL)
(RPAQQ DSLControlWindow NIL)
(RPAQQ DSLControlMenu NIL)
(* * signal window functions)
(DEFINEQ
(CloseSignalFile
[LAMBDA (ss aspect w) (* ht: "16-Aug-85 09:41")
(* * 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: "25-Jun-85 14:11")
(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 (DSLPromptRead window "New value: " 1 78))
(SHOULDNT])
(NewCompression
[LAMBDA (window compr) (* ht: " 6-Jan-86 15:02")
(if (\CheckWidthVsCompr compr (fetch WIDTH of (DSPCLIPPINGREGION NIL window)))
then (WINDOWPROP window 'Compression
compr)
(\UpdateLinks window (fetch WIDTH of (DSPCLIPPINGREGION NIL window))
compr)
(PositionSignalWindow window (WINDOWPROP window 'SignalOrigin)
compr)
(REDISPLAYW window])
(\CheckWidthVsCompr
[LAMBDA (compr width) (* ht: " 6-Jan-86 15:07")
(if (AND compr (IGREATERP (ITIMES compr width)
(ARRAYSIZE \SSDataArray)))
then (ERROR (PACK*
"Compression times display width is too great for available data storage - can't do it. Max possible compression is "
(IQUOTIENT (ARRAYSIZE \SSDataArray)
width)))
NIL
else T])
(PositionSignalWindow
[LAMBDA (window signalPos compr) (* ht: "19-Sep-85 15:56")
(* * 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, although
WXOFFSET might do it if there were some documentation)
(DSPCLIPPINGREGION reg window)
(DSPXOFFSET offset-signalPos/compr window)
(\UpdateLinkedWindows window])
(NewShow
[LAMBDA (ss window) (* ht: " 4-Jan-86 14:11")
(LET (ow pw cw sw sww (height (HEIGHTIFWINDOW (IMINUS (DSPLINEFEED))
T)))
[if (NOT (WINDOWP window))
then window←(CREATEW NIL (CONCAT "Signal Display for " ss:fullName " "
(OR ss:comment ""]
(WINDOWPROP window 'SignalSegment
ss)
(WINDOWADDPROP window 'REPAINTFN
(FUNCTION RedisplayMarks))
(if (NOT (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 (CREATEREGION 0 0 100 height)
"Origin" NIL T)
window
'LEFT
'BOTTOM)
(WINDOWPROP ow 'MAXSIZE
(CONS 100 height))
(WINDOWPROP ow 'MINSIZE
(CONS 100 height))
(ATTACHWINDOW cw←(CREATEW (CREATEREGION 0 0 80 height)
"Compression" NIL T)
ow
'TOP)
(WINDOWPROP cw 'MAXSIZE
(CONS 80 height))
(WINDOWPROP cw 'MINSIZE
(CONS 80 height))
(WINDOWPROP cw 'BUTTONEVENTFN
'CompressionButtonFn)
(CLOSEW cw)
(MakePrompt window)
(WINDOWPROP window 'OriginWindow
ow)
(WINDOWPROP window 'CompressionWindow
cw))
(WINDOWPROP window 'SCROLLFN
'ScrollSignalWindow)
(WINDOWADDPROP window 'CLOSEFN
'CloseSignalWindow)
(WINDOWADDPROP window 'RESHAPEFN
'ReshapeSignalWindow)
(WINDOWPROP window 'BUTTONEVENTFN
'ButtonSignalWindow)
(WINDOWPROP window 'SCROLLEXTENTUSE
'(T))
(ReshapeSignalWindow window)
window])
(MakePrompt
[LAMBDA (mw) (* ht: " 6-Jan-86 14:47")
(LET ((pw (CREATEW '(0 0 75 10)
NIL NIL T)))
(ATTACHWINDOW pw mw '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))
(WINDOWPROP pw 'REJECTMAINCOMS
'(OPENW TOTOPW))
(WINDOWPROP pw 'TOTOPFN
NIL)
(* * the reason I do this myself instead of using GETPROMPTWINDOW exclusively is to get the position and width as I
want them)
(WINDOWPROP mw 'PromptWindow
(CONS pw 0))
pw])
(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")
(QUOTIENT (DIFFERENCE width (QUOTIENT (TIMES width compr2)
compr1))
2])
(ZoomWindow
[LAMBDA (ss w) (* ht: "16-Aug-85 09:41")
(LET ((compr (WINDOWPROP w 'Compression))
subCompr)
(SETQ subCompr (IMAX 1 (QUOTIENT compr ZoomRatio)))
(\MakeLinkedWindow ss w (\ComputeZoomOffset (fetch WIDTH of (DSPCLIPPINGREGION
NIL w))
compr subCompr)
'zoom
subCompr])
(\MakeLinkedWindow
[LAMBDA (ss w posOffset linkType subCompr) (* ht: "16-Aug-85 09:41")
(if ss:points=NIL
then (replace points of ss with (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)
(replace offset of dummy with (PLUS (fetch offset of ss)
(TIMES posOffset compr)))
(replace duration of dummy with (DIFFERENCE (PLUS (fetch offset of ss)
(fetch duration of ss))
(fetch offset of dummy)))
(replace aspects of dummy with (fetch aspects of ss))
(replace parent of dummy with (fetch parent of ss))
(SETQ lw (NewShow dummy (CREATEW (CREATEREGION 0 0 (fetch WIDTH of reg)
(fetch HEIGHT of reg))
(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 (TIMES (PLUS (fetch LEFT of cr)
posOffset)
compr)
(OR subCompr compr))
(REDISPLAYW lw)
(WINDOWADDPROP w 'LinkedWindows
(SETQ link (create LinkedWindow
lWindow ← lw
lOffset ← posOffset
lType ← linkType)))
(WINDOWADDPROP lw 'CLOSEFN
'UnlinkWindow
T)
(WINDOWADDPROP lw 'LinkedWindows
(create LinkedWindow
lWindow ← w
lOffset ←(MINUS 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: " 6-Jan-86 15:25")
(UpdateSignalOrigin window)
(UpdateSignalCompression window)
[LET [(extent (WINDOWPROP window 'EXTENT]
(LET ((eLeft extent:LEFT)
(eRight extent:PRIGHT)
(rLeft region:LEFT)
(rRight region:PRIGHT)
nLeft nWidth)
(if (ILESSP rLeft eLeft)
then (DSPFILL (CREATEREGION rLeft region:BOTTOM (IDIFFERENCE (IMIN rRight
eLeft)
rLeft)
region:HEIGHT)
\DSLNoDataShade NIL window)
elseif (IGREATERP rRight eRight)
then (DSPFILL (CREATEREGION (IMAX rLeft eRight)
region:BOTTOM
(IDIFFERENCE rRight (IMAX rLeft eRight))
region:HEIGHT)
\DSLNoDataShade NIL window))
nLeft←(IMAX rLeft eLeft)
region←(if (IGREATERP nWidth←(IDIFFERENCE (IMIN rRight eRight)
nLeft)
0)
then (CREATEREGION nLeft region:BOTTOM nWidth region:HEIGHT]
(if region
then (if (ARRAYP (WINDOWPROP window 'SignalFile))
then (RepaintSingleValuedAspect/Array window region (WINDOWPROP
window
'SignalFile))
else (RepaintSingleValuedAspect/File window region])
(RepaintSingleValuedAspect/File
[LAMBDA (window region) (* ht: " 7-Jan-86 14:19")
(* * all the LLSHing by one is because each datum takes up two bytes on the file)
(* * should try to read more in in background and keep track)
(* * all this hair is because we need from one before the interval to one after for continuity in line drawing, and
either of those may be off the edge of the file)
(LET ((file (WINDOWPROP window 'SignalFile))
(ss (WINDOWPROP window 'SignalSegment))
compr eof pos start index datum count format offset)
format←(AspectProperty ss 'Data
'SampleFormat)
offset←(IDIFFERENCE (AspectProperty ss 'Data
'SampleOffset)
(\PCDAC.DATAOFFSET PCDAC.BOARD))
eof←(GETEOFPTR file)
compr←(WINDOWPROP window 'Compression)
start←compr*region:LEFT
count←(IPLUS compr*region:WIDTH 1)
(if (ILESSP start compr)
then
(* * off the front -
fake it)
(index←compr)
(SETFILEPTR file 0)
(AWIN file \SSDataArray 1 0 format offset)
else
(* * can do it all at once)
(index←0)
(start←start-compr)
(count←count+compr))
(if (GREATERP start+count (LRSH eof 1))
then
(* * off the end)
(SETFILEPTR file eof-2)
(AWIN file \SSDataArray 1 index+count-1 format offset)
(count←count-compr))
(SETFILEPTR file (LLSH start 1))
(AWIN file \SSDataArray count index format offset)
(RepaintSingleValuedAspect/Array window region \SSDataArray 0])
(RedisplayMarks
[LAMBDA (w reg) (* ht: "16-Aug-85 09:41")
(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 file
then (if (NOT 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 (AspectProperty
ss
(WINDOWPROP w 'DisplayedAspect)
'SampleFormat)
(AspectProperty ss (WINDOWPROP
w
'DisplayedAspect)
'SampleOffset]
(pop pp])
(ReshapeSignalWindow
[LAMBDA (window) (* ht: " 6-Jan-86 15:04")
(if (\CheckWidthVsCompr (WINDOWPROP window 'Compression)
(fetch WIDTH of (DSPCLIPPINGREGION NIL window)))
then (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)
(* * Only possible because MARHAX removes the SMALLP restriction on this field, but still hacked becaused of SMALLP
restriction on line length! The \GETBASE is the FONTAVGCHARWIDTH field)
(DSPRIGHTMARGIN (IPLUS (DSPLEFTMARGIN NIL window)
(ITIMES 60000 (\GETBASE (DSPFONT NIL window)
36)))
window)
(UpdateScaleFactor window)
(\UpdateLinks window reg:WIDTH (WINDOWPROP window 'Compression))
(REDISPLAYW window reg])
(\UpdateLinks
[LAMBDA (w width compr) (* ht: " 3-Jan-86 15:55")
(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: " 3-Jan-86 14:53")
(* * 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 (ScrollSignalWindow lw:lWindow dx 0 NIL T])
(\ChangeLinkedOffset
[LAMBDA (w lw newOffset compr ss) (* ht: "16-Aug-85 09:41")
(LET [(dummy (WINDOWPROP (fetch lWindow of lw)
'SignalSegment]
(replace lOffset of lw with newOffset)
(replace lOffset of (OR (for llw in (WINDOWPROP (fetch lWindow of lw)
'LinkedWindows)
thereis llw:lType=lw)
(SHOULDNT "no back link"))
with (MINUS newOffset))
(replace offset of dummy with (PLUS (fetch offset of ss)
(TIMES newOffset compr)))
(replace duration of dummy with (DIFFERENCE (PLUS (fetch offset of ss)
(fetch duration of ss))
(fetch offset of dummy)))
(WINDOWPROP (fetch lWindow of lw)
'TITLE
(CONCAT (WINDOWPROP w 'TITLE)
" at offset " newOffset])
(UpdateSignalCompression
[LAMBDA (window) (* ht: "19-Sep-85 17:00")
(LET [(compr (WINDOWPROP window 'Compression))
(cw (WINDOWPROP window 'CompressionWindow))
(ss (WINDOWPROP window 'SignalSegment]
(WINDOWPROP window 'EXTENT
(create REGION
LEFT ←((fetch offset of (TrueSS ss window))/compr)
BOTTOM ← 0
HEIGHT ← -1
WIDTH ←((fetch duration of (TrueSS ss window))/compr)))
(DSPLEFTMARGIN ss:offset/compr window)
(CLEARW cw)
(printout cw compr])
(UpdateSignalOrigin
[LAMBDA (window) (* ht: "16-Aug-85 09:41")
(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 (WINDOWPROP window 'DisplayedAspect)
ss])
(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 fromLinkFlg) (* ht: " 4-Jan-86 14:08")
(SCROLLBYREPAINTFN window deltaX deltaY continuousFlg)
(\UpdateLinkedWindows window])
(SetupSignalFile
[LAMBDA (ss aspect w) (* ht: "19-Sep-85 17:30")
(* * 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←(OPENSTREAM sf 'INPUT))
(WINDOWPROP w 'Compression
compr)
(WINDOWADDPROP w 'REPAINTFN
(FUNCTION RepaintSingleValuedAspect)
T)
(WINDOWPROP w 'PositionFn
(FUNCTION CarefulSFP))
(WINDOWPROP w 'GetFn
(FUNCTION WIN))
(UpdateScaleFactor w ampl T)
(UpdateSignalCompression w)
(ClearSignalWindow w)
(if ss:duration=0
then (ss:duration←(LRSH (GETEOFPTR f)
1)))
f])
(UpdateScaleFactor
[LAMBDA (w ampl redisplayFlg) (* ht: "16-Aug-85 09:41")
(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: "16-Aug-85 09:41")
(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: "16-Aug-85 09:41")
(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])
(SecPrint
[LAMBDA (tics window aspect ss) (* ht: "13-May-85 13:54")
(printout window .F7.3. (FQUOTIENT (FLOAT (SELECTQ (AspectProperty ss aspect 'SampleFormat)
(VAX (IDIFFERENCE tics 256))
tics))
(AspectProperty ss aspect 'SampleRate])
(ShowMark
[LAMBDA (ss x y h point oldy mDelta window pos val) (* ht: "16-Aug-85 09:41")
(LET ((lf (DSPLINEFEED NIL window))
maxX)
(MOVETO (DIFFERENCE x LeftOff)
(PLUS y (MINUS h)
lf
(MINUS mDelta))
window)
(SecPrint (OR pos (fetch pPtr of point))
window
(WINDOWPROP window 'DisplayedAspect)
ss)
(SETQ maxX (DSPXPOSITION NIL window))
(MOVETO x (DIFFERENCE y (PLUS h mDelta))
window)
(DRAWTO x (PLUS y h mDelta)
1 NIL window)
(MOVETO x (PLUS y h mDelta (FONTPROP (DSPFONT NIL window)
'DESCENT))
window)
[printout window val , # (if point:end?
then (printout NIL , (fetch name
of (fetch pSS of point))
'>)
else (printout NIL '<
(fetch name of (fetch pSS of point]
(replace pWidth of point with (PLUS (IMAX maxX (DSPXPOSITION NIL window))
LeftOff
(MINUS x)))
(if oldy
then (MOVETO x oldy window))
(IMOD (DIFFERENCE mDelta lf)
(TIMES MarkCycleLength (MINUS 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: "22-May-85 16:59")
(* * 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
home ←(HASHFILEPROP sf
'NAME))
SSDir)
(RESETVARS ((SSExpandFlg expandFlg)
(HASHFILERDTBL SSReadTable))
(RETURN (GETHASHFILE fullName sf)))
expandFlg)
(if dontCacheFlg
then (PUTHASH fullName NIL SSDir])
(PromptForSSFile
[LAMBDA (ss w) (* ht: "16-Aug-85 09:41")
(LET [(nf (MENU (create MENU
TITLE ←(CONCAT "Choose file for " ss:fullName)
ITEMS ←(CONS '{NewFile} (SFNames]
(SELECTQ nf
(NIL NIL)
({NewFile} (SSFile (if w
then (DSLPromptRead w "New file name: " 1 150)
else (printout T T "New file name: ")
(READ T))
T))
nf])
(SSFile
[LAMBDA (file newFlg) (* ht: " 4-Jan-86 10:31")
(* * Find or create a Signal Hash File)
(LET* [nfn (hf (OR (HASHFILEP file)
(thereis f in SignalFiles suchthat file=(HASHFILEPROP f
'NAME))
(AND (INFILEP file)
(OPENHASHFILE file))
(AND nfn←(SPELLFILE file)
(OPENHASHFILE nfn]
(if (AND (NOT hf)
newFlg)
then (printout T file " does not exist - create it? ")
(if (ASKUSER DWIMWAIT 'N)= 'Y
then hf←(CREATEHASHFILE file 'EXPR
20 100)))
(if hf
then (pushnew SignalFiles hf)
else (HELP "Can:t find/make signal file " file))
hf])
(CleanupSSFiles
[LAMBDA (files) (* ht: "25-Jun-85 15:09")
(bind new olld for f in (OR files SignalFiles)
do (new←(CLOSEHASHFILE f T))
(if olld←(FMEMB f SignalFiles)
then (olld:1←new])
(SaveSS
[LAMBDA (ss ssFile dontScrubFlg saveSubs w) (* ht: "16-Aug-85 09:41")
(* * 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)
(SETQ fullName (fetch fullName of ss))
(if ssFile
then (SETQ 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))
(replace home of ss with (HASHFILEPROP hf 'NAME))
(if saveSubs
then (for p in ss:points::1 unless p:end?
do (SaveSS (fetch pSS of p)
hf dontScrubFlg saveSubs w)))
(if (NOT dontScrubFlg)
then (ScrubSS ss))
else (PROMPTPRINT "Not saved"))
ss])
(SSRead
[LAMBDA (file) (* ht: "16-Aug-85 09:41")
(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 (DIFFERENCE SSExpandFlg 1))
else (SHOULDNT SSExpandFlg])
(SSFromFile
[LAMBDA (ss ssForm expandFlg) (* ht: "11-Jan-86 16:43")
(* * Make an SS from its file form)
(if (NOT (EQUAL ssForm:version SSVersionStamp))
then (HELP "wrong version"))
ss:name←ssForm:fields:1
ss:trueName←ssForm:fields:2
ss:duration←ssForm:fields:3
ss:offset←ssForm:fields:4
ss:parent←ssForm:fields:5
ss:aspects←ssForm:fields:6
ss:points←ssForm:fields:7
ss:comment←ssForm:fields:8
(* * * 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: "11-Jan-86 16:38")
(create SSFileForm
version ← SSVersionStamp
fields ←(LIST ss:name ss:trueName ss:duration ss:offset ss:parent ss:aspects
ss:points ss:comment)
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 array index) (* ht: " 6-Jan-86 17:09")
(LET ((scale (WINDOWPROP window 'ScaleFactor))
(stream (WINDOWPROP window 'DSP))
(compr (WINDOWPROP window 'Compression))
(base (IPLUS (WINDOWPROP window 'SignalBase)
(DSPYOFFSET NIL window)))
bottom)
(* * This code assumes all pointers will be smallp, and doesn't use any boxing hacks)
(if (NOT region)
then region←(DSPCLIPPINGREGION NIL stream))
bottom←region:BOTTOM+
(DSPYOFFSET NIL stream)
[\SetupArrays compr scale (FDIFFERENCE base (FTIMES scale (\PCDAC.DATAOFFSET
PCDAC.BOARD]
(\RepaintSignalSliceFromArray region array index base (WINDOWPROP window 'SignalHeight)
(WINDOWPROP window 'SignalSegment)
compr scale stream (DSPDESTINATION NIL stream)
bottom bottom+region:HEIGHT])
(\RepaintSignalSliceFromArray
[LAMBDA (region array index base height ss compr scale stream destBM bottom top)
(* ht: " 7-Jan-86 11:44")
(* * This code assumes all pointers will be smallp, and doesn't use any boxing hacks)
(DSPFILL region NIL NIL stream)
(LET ((dispPos region:LEFT+(DSPXOFFSET NIL stream)+-1)
(truePos (OR index region:LEFT*compr))
(left (IMAX 0 region:LEFT+(DSPXOFFSET NIL stream)))
(sliceWidth region:WIDTH)
right y arrayBase)
right←(IMIN SCREENWIDTH-1 region:RIGHT+(DSPXOFFSET NIL stream))
bottom←(IMAX 0 bottom)
top←(IMIN SCREENHEIGHT-1 top)
[\SetupArrays compr scale (FDIFFERENCE base (FTIMES scale (\PCDAC.DATAOFFSET
PCDAC.BOARD]
arrayBase←(ARRAYBASE \FloatTArray)
(* * first produce a dense smallp set of points)
(\RawPermArray array truePos \PermArray 0 \SmallTArray 0 sliceWidth+2)
(* * float the points)
(\RawFloatArray \SmallTArray 0 \FloatTArray 0 sliceWidth+2)
(* * scale the points)
(\RawFTimesArrays \FloatTArray 0 \SArray 0 \FloatTArray 0 sliceWidth+2)
(* * add in the scaled offset and base (base-scale*offset))
(\RawFPlusArrays \FloatTArray 0 \SOArray 0 \FloatTArray 0 sliceWidth+2)
y←(\CheapFix arrayBase)
(for i from 2 to (LLSH sliceWidth+1 1) by 2
do (\CLIPANDDRAWLINE1 dispPos y (IPLUS dispPos 1)
y←(\CheapFix (\ADDBASE arrayBase i))
'REPLACE
destBM left right bottom top stream)
(add dispPos 1])
(\SetupArrays
[LAMBDA (compr scale scaledOffset) (* ht: " 7-Jan-86 13:53")
(DECLARE (LOCALVARS . T)
(GLOBALVARS \SmallTArray \FloatTArray \SArray \SOArray \PermArray))
(if (NOT (ARRAYP \SmallTArray))
then \SmallTArray←(ARRAY SCREENWIDTH 'SMALLP
NIL 0))
(if (NOT (ARRAYP \SArray))
then \SArray←(ARRAY SCREENWIDTH 'FLOATP
scale 0)
elseif (NOT (EQP (ELT \SArray 0)
scale))
then (for i from 0 to SCREENWIDTH-1 do (SETA \SArray i scale)))
(if (NOT (ARRAYP \FloatTArray))
then \FloatTArray←(ARRAY SCREENWIDTH 'FLOATP
NIL 0))
(if (NOT (ARRAYP \SOArray))
then \SOArray←(ARRAY SCREENWIDTH 'FLOATP
scaledOffset 0)
elseif (NOT (EQP (ELT \SOArray 0)
scaledOffset))
then (for i from 0 to SCREENWIDTH-1 do (SETA \SOArray i scaledOffset)))
(if (NOT (ARRAYP \PermArray))
then \PermArray←(ARRAY SCREENWIDTH 'SMALLP
NIL 0))
(if (NOT (EQP (ELT \PermArray 1)
compr))
then (for i from 0 to SCREENWIDTH-1 as j from 0 by compr
do (SETA \PermArray i j])
)
(* * record and playback)
(RPAQQ SSPCA/DInputChannel 0)
(RPAQQ SSPCD/AOutputChannel 1)
(RPAQQ \SSDrawPointTime .75)
(RPAQQ \SSFetchPerHundredTime .55)
(RPAQQ \SSWriteToCoreTime .07)
(RPAQQ \SSWriteToDskTime .4)
(RPAQ? \SSDataArray (ARRAY 32768 'WORD
0 0 128))
(DECLARE: EVAL@COMPILE
(RPAQQ PCDACClockInverse 1.25E-6)
(RPAQQ SSDMAChannel 1)
(CONSTANTS (PCDACClockInverse 1.25E-6)
(SSDMAChannel 1))
)
(DEFINEQ
(RecordSegment
[LAMBDA (ss window) (* ht: "14-Jan-86 11:14")
(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))
(RESETSAVE (\SSShutUpBoard T))
[RESETSAVE (MODIFY.KEYACTIONS '((STOP IGNORE . IGNORE))]
(LET ((width (WINDOWPROP window 'WIDTH))
(compression (OR (WINDOWPROP window 'Compression
1)
1))
(sampleRate (AspectProperty ss 'Data
'SampleRate))
(old (ATTACHEDWINDOWREGION window))
(ampl (AspectProperty ss 'Data
'MaxAmplitude))
(array \SSDataArray)
sliceWidth arraySize nSlices correctSize correctWidth file sliceSize
xferSize estLength nPages device dataWidth)
(CLEARW window)
(UpdateSignalOrigin window)
(printout T "initializing for record ..." T)
file←(AspectProperty ss 'Data
'DataFile)
(CLOSEF? file)
file←(OPENSTREAM file 'OUTPUT)
(if [NOT (MEMB device←(FILENAMEFIELD (FULLNAME file)
'HOST)
'(CORE 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 (DSLPromptRead window
"Estimated length of recording (in seconds): "
1 250)
5)
nPages←sampleRate*estLength/256+1
(SELECTQ device
(CORE)
(DSK
(* * touch last page on the file to (hopefully) speed things up)
(SETFILEPTR file nPages*512)
(BOUT file 0)
NIL)
(SHOULDNT))
(* * close it to get the system's hands off that last page)
file←(OPENSTREAM (CLOSEF file)
'OUTPUT)
sliceSize←dataWidth←(FIX compression*width)
arraySize←32768
(until (ILEQ xferSize←(IPLUS sliceSize
(SkipSize sampleRate compression
sliceSize NIL device))
arraySize)
do (if (ILESSP sliceSize←(IDIFFERENCE sliceSize 25)
1)
then (HELP "gone to zero")))
ss:duration←arraySize
sliceWidth←(FIX sliceSize/compression)
(UndisplayAspect (WINDOWPROP window 'DisplayedAspect)
ss window)
(WINDOWPROP window 'DisplayedAspect
'Data)
(WINDOWPROP window 'REPAINTFN
'(RepaintSingleValuedAspect RedisplayMarks))
(WINDOWPROP window 'PositionFn
(FUNCTION CarefulSFP))
(WINDOWPROP window 'GetFn
(FUNCTION WIN))
(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)
)
(if (IGREATERP correctSize←(ITIMES sliceSize nSlices)
arraySize)
then (HELP "array overflow"))
(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))
(if [NOT (NLSETQ (PROGN (PCDAC.STOP T)
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK
(FIX (FQUOTIENT (FQUOTIENT
1.0 sampleRate)
PCDACClockInverse)
))
(PCDAC.SETUPDMA 1 0 32768 T T)
(PCDAC.SETA/DPARAMETERS
(OR (WINDOWPROP window
'InputGainCode)
0)
SSPCA/DInputChannel)
(UpdateSignalCompression window)
(TOTOPW window)
(printout T "Type STOP to stop: ")
(RecordToFile ss window xferSize
sliceWidth sliceSize
compression correctSize
array file)
(PCDAC.STOP)
(PCDAC.CLEARERROR]
then (PROMPTPRINT "Error while recording - aborted")
(BUS.RESET))
ss:duration←(LRSH (GETFILEPTR file)
1)
(WINDOWPROP window 'SignalFile
(OPENSTREAM (CLOSEF file)
'INPUT))
(REDISPLAYW window])
(RecordToFile
[LAMBDA (ss window xferSize sliceWidth sliceSize compression correctSize array file)
(* ht: " 8-Jan-86 09:16")
(DECLARE (LOCALVARS . T)
(GLOBALVARS \LASTKEYSTATE))
(bind (nextBufEnd ← xferSize)
(lastArrayPtr ← 0)
(redisplayRegion ←(APPEND (DSPCLIPPINGREGION NIL window)))
(scale ←(WINDOWPROP window 'ScaleFactor))
(stream ←(WINDOWPROP window 'DSP))
(base ←(IPLUS (WINDOWPROP window 'SignalBase)
(DSPYOFFSET NIL window)))
(height ←(WINDOWPROP window 'SignalHeight))
(lastAddress ← 32768)
(arraySize ←(ARRAYSIZE array))
bottom destBM top lastBufEnd currentAddress wrapped
first [\SetupArrays compression scale (FDIFFERENCE base (FTIMES scale (
\PCDAC.DATAOFFSET
PCDAC.BOARD]
(redisplayRegion:LEFT←0)
(redisplayRegion:WIDTH←sliceWidth)
(bottom←redisplayRegion:BOTTOM+(DSPYOFFSET NIL stream))
(destBM←(DSPDESTINATION NIL stream))
(top←bottom+redisplayRegion:HEIGHT)
(RECLAIM)
(PCDAC.STARTREADA/D T T)
until (KEYDOWNP 'STOP)
do (* (PCDAC.ERROR?))
(* * Get the current location of the dma transfer, in words. Open coded for speed)
(if (BUSDMA.FASTUPDATEADDR SSDMAChannel currentAddress wrapped)
then (add currentAddress 32768))
(* * the IGREATERP check is actually on currentAddress+currentAddress-lastAddress-32768, but the computation is
done in the way it actually is to avoid building any boxes)
(if (OR wrapped= 'DoubleWrap
(IGREATERP (IPLUS (IDIFFERENCE currentAddress lastAddress)
(IDIFFERENCE currentAddress 32768))
nextBufEnd))
then (* falling behind -
punt)
(nextBufEnd←currentAddress)
(FLASHWINDOW window)
(wrapped←NIL)
elseif (ILESSP currentAddress nextBufEnd)
then (GO $$LP))
(lastAddress←currentAddress)
(if (GREATERP nextBufEnd 32768)
then (* slice lies across buffer end)
(wrapped←NIL)
(nextBufEnd←nextBufEnd-32768))
(if (MINUSP lastBufEnd←nextBufEnd-xferSize)
then (PCBUS.READARRAY array 32768+lastBufEnd (-lastBufEnd)
'SWAP
lastArrayPtr)
(PCBUS.READARRAY array 0 nextBufEnd 'SWAP
(IMOD (IDIFFERENCE lastArrayPtr lastBufEnd)
arraySize))
else (PCBUS.READARRAY array lastBufEnd xferSize 'SWAP
lastArrayPtr))
(* * Dont call redisplayw, because it does a resetvars which burns conses which we can't afford)
(\RepaintSignalSliceFromArray redisplayRegion array lastArrayPtr base height ss
compression scale stream destBM bottom top)
(\BOUTS file (ARRAYBASE array)
(LLSH lastArrayPtr 1)
(LLSH xferSize 1))
(add redisplayRegion:LEFT sliceWidth)
(add nextBufEnd xferSize)
(if (add lastArrayPtr sliceSize)=correctSize
then (lastArrayPtr←0)
(redisplayRegion:LEFT←0])
(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: " 8-Jan-86 10:22")
(DECLARE (LOCALVARS . T)
(GLOBALVARS \LASTKEYSTATE))
(LET [(str (OPENSTREAM (OR (AspectProperty ss 'Data
'DataFile)
(HELP "No data file to play"))
'INPUT]
(* * depends on getting the same stream as the one which must be already open)
(SETFILEPTR str (LLSH (fetch offset of ss)
1))
(if (GREATERP (fetch duration of ss)
32768)
then
[RESETLST
(RESETSAVE (TTYDISPLAYSTREAM window))
(RESETSAVE (RECLAIMMIN MAX.SMALLP))
(RESETSAVE (\SSShutUpBoard T))
(LET ((sampleRate (AspectProperty ss 'Data
'SampleRate))
(array \SSDataArray)
(offset (IDIFFERENCE (AspectProperty ss 'Data
'SampleOffset)
(\PCDAC.DATAOFFSET PCDAC.BOARD)))
(format (AspectProperty ss 'Data
'SampleFormat))
arraySize sliceSize xferSize device)
[if [NOT (MEMB (SETQ device (FILENAMEFIELD (FULLNAME str)
'HOST))
'(CORE DSK)]
then (ERROR "can't play from a file on this device" (AspectProperty
ss
'Data
'DataFile]
(if (NOT (ILESSP sampleRate (MaxSampleRate device)))
then (ERROR "Sample rate too high - max is " (MaxSampleRate device)))
(SETQ xferSize 16384)
(SETQ arraySize 32768)
(if [NOT (NLSETQ (PROGN (PCDAC.STOP T)
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK (FIX (FQUOTIENT
(FQUOTIENT 1.0
sampleRate)
PCDACClockInverse)))
(PCDAC.SETUPDMA 1 0 32768 NIL T)
(PCDAC.SETD/APARAMETERS SSPCD/AOutputChannel)
(AWIN str array xferSize 0 format offset)
(PCBUS.WRITEARRAY array 0 xferSize
'SWAP)
(PCDAC.STARTWRITED/A T T)
(AWIN str array xferSize xferSize format
offset)
(PCBUS.WRITEARRAY array xferSize xferSize
'SWAP
xferSize)
[PROG ((nextBufEnd xferSize)
(lastArrayPtr 0)
(lastAddress 32768)
(remaining (DIFFERENCE (fetch
duration
of ss)
32768))
lastBufEnd currentAddress wrapped)
LP1 (AWIN str array (IMIN remaining
xferSize)
lastArrayPtr format offset)
(* * Get the current location of the dma transfer, in words. Open coded for speed)
LP2 (if (BUSDMA.FASTUPDATEADDR
SSDMAChannel
currentAddress
wrapped)
then (add currentAddress 32768))
(* * the IGREATERP check is actually on currentAddress+currentAddress-lastAddress-32768, but the computation is
done in the way it actually is to avoid building any boxes)
(if (OR (EQ wrapped 'DoubleWrap)
(IGREATERP
(IPLUS (IDIFFERENCE
currentAddress
lastAddress)
(IDIFFERENCE
currentAddress
32768))
nextBufEnd))
then
(* falling behind -
punt)
(SETQ nextBufEnd
currentAddress)
(FLASHWINDOW window)
(SETQ wrapped NIL)
elseif (ILESSP currentAddress
nextBufEnd)
then (GO LP2))
(SETQ lastAddress currentAddress)
(if (GREATERP nextBufEnd 32768)
then
(* slice lies across buffer end)
(SETQ wrapped NIL)
(SETQ nextBufEnd
(DIFFERENCE nextBufEnd
32768)))
(SELECTQ remaining
(done (PCDAC.STOP)
(RETURN))
(partial (PCBUS.WRITEARRAY
\ZeroArray
(DIFFERENCE
nextBufEnd
xferSize)
xferSize
'SWAP
0)
(add nextBufEnd
xferSize)
(SETQ remaining
'done)
(GO LP2))
(if (ILESSP remaining
xferSize)
then
(PCBUS.WRITEARRAY
array lastArrayPtr
remaining
'SWAP
lastArrayPtr)
(PCBUS.WRITEARRAY
\ZeroArray
(PLUS lastArrayPtr
remaining)
(DIFFERENCE xferSize
remaining)
'SWAP
0)
(add nextBufEnd
xferSize)
(SETQ remaining
'partial)
(GO LP2)
else (PCBUS.WRITEARRAY
array lastArrayPtr
xferSize
'SWAP
lastArrayPtr)
(add nextBufEnd
xferSize)
(if (add
lastArrayPtr
xferSize)
=arraySize
then
lastArrayPtr←0)
(SETQ remaining
(IDIFFERENCE
remaining
xferSize))
(GO LP1]
(PCDAC.STOP)
(PCDAC.CLEARERROR]
then (PROMPTPRINT "Error while playing - aborted")
(BUS.RESET]
else (AWIN str \SSDataArray (fetch duration of ss)
NIL
(AspectProperty ss 'Data
'SampleFormat)
(IDIFFERENCE (AspectProperty ss 'Data
'SampleOffset)
(\PCDAC.DATAOFFSET PCDAC.BOARD)))
(PLAY.IT \SSDataArray (fetch duration of ss)
(FQUOTIENT (AspectProperty ss 'Data
'SampleRate)
1000)
SSPCD/AOutputChannel T NIL NIL])
(PlayArraySeg
[LAMBDA (ss w) (* ht: "20-Apr-85 13:12")
(PLAY.IT (WINDOWPROP w 'SignalFile)
(fetch duration of ss)
(FQUOTIENT (AspectProperty ss (WINDOWPROP w 'DisplayedAspect)
'SampleRate)
1000)
SSPCD/AOutputChannel T (fetch offset of ss])
(MaxSampleRate
[LAMBDA (device fetchPerHundredPoints) (* ht: "22-Apr-85 10:33")
(FQUOTIENT 1000.0 (SELECTQ device
((NIL CORE)
(PLUS \SSWriteToCoreTime (FQUOTIENT (OR
fetchPerHundredPoints
\SSFetchPerHundredTime)
100.0)))
(DSK (PLUS \SSWriteToDskTime (OR fetchPerHundredPoints
\SSFetchPerHundredTime)))
(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 (QUOTIENT fetchPerHundredPoints 100.0))
(writePerPoint (SELECTQ device
((NIL CORE)
\SSWriteToCoreTime)
(NULL 0.0)
(DSK \SSWriteToDskTime)
(SHOULDNT]
(TIMES sliceSize (QUOTIENT (DIFFERENCE (TIMES (PLUS (QUOTIENT repaintPerPoint
compression)
writePerPoint fetchPerPoint)
sampleRate)
1000.0)
(DIFFERENCE 1000.0 (TIMES (PLUS writePerPoint
fetchPerPoint)
sampleRate])
(PlaySubSS
[LAMBDA (ss w) (* ht: "16-Aug-85 09:41")
(LET ((mark (GrabMark w ss)))
(if mark
then (PlaySeg (fetch pSS of mark)
w])
(PLAY.IT
[LAMBDA (ARRAY NUMSAMPLES FREQKHZ DACCHANNEL STORED? offset repeat?)
(* ht: " 8-Jan-86 10:21")
(LET [(PCPAGE 1)
(PCMEMSIZEINWORDS 32768)
(CLOCKRATE (FIX (FQUOTIENT (FQUOTIENT 1.0 (FTIMES FREQKHZ 1000.0))
PCDACClockInverse]
(PCDAC.STOP)
(PCDAC.CLEARERROR)
(BUSDMA.INIT)
(PCDAC.SETCLOCK CLOCKRATE)
(if STORED?
then (PCBUS.WRITEARRAY ARRAY 0 NUMSAMPLES 'SWAP
offset))
(PCDAC.SETUPDMA PCPAGE 0 NUMSAMPLES NIL repeat?)
(PCDAC.SETD/APARAMETERS (OR DACCHANNEL 1))
(PCDAC.STARTWRITED/A T repeat?])
(\SSShutUpBoard
[LAMBDA (flg) (* ht: "11-Oct-85 11:36")
(PROG1 (fetch pcdQUIETERRORS of PCDAC.BOARD)
(replace pcdQUIETERRORS of PCDAC.BOARD with flg])
)
(* * Signal window menu)
(RPAQQ SignalMenuItems [(Display (SetAspect SignalSegment Window)
"Gives a menu of available aspects and displays the selected one")
(Describe (DescribeAspect (WINDOWPROP Window 'DisplayedAspect)
(TrueSS SignalSegment Window)
Window)
"Show the attributes and values of the currently displayed aspect in an inspector window"
(SUBITEMS (Describe' (DescribeAspect (ChooseAspect (TrueSS
SignalSegment
Window))
(TrueSS SignalSegment Window)
Window)
"Show the attributes and values of a selected aspect in an inspector window")
(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 T Window)
"Save this segment and all its sub-segments on its home file"
(SUBITEMS (Save (SaveSS (TrueSS SignalSegment Window)
NIL T NIL Window)
"Save this segment alone (not its sub-segments) on its home file")
(Delete* (ScrubSS (TrueSS SignalSegment Window)
T)
"Delete this segment and all its sub-segments from its home file")
(Delete (ScrubSS (TrueSS SignalSegment Window)
NIL)
"Delete this segment alone (not its sub-segments) from its home file")))
(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
'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")))
(Clip (ClipSeg (TrueSS SignalSegment Window))
"Make a new data file for the segment"
(SUBITEMS (ClipSub (ClipSubSeg SignalSegment Window)
"Make a new data file for a designated sub-segment")))
(Play (COND ((EQ (DTYPE)
'TIGER)
(PlaySeg (TrueSS SignalSegment Window)
Window))
(T (printout T "Not on a Dandetiger - can't play" T)))
"play the ss out"
(SUBITEMS (PlaySub (COND ((EQ (DTYPE)
'TIGER)
(PlaySubSS SignalSegment Window))
(T (printout T
"Not on a Dandetiger - can't play"
T)))
"Play a designated sub-segment")
(Quiet (COND ((EQ (DTYPE)
'TIGER)
(PCDAC.STOP))
(T (printout T
"Not on a Dandetiger - can't play"
T)))
"Shut up!")))
(Record (COND ((EQ (DTYPE)
'TIGER)
(RecordSegment (TrueSS SignalSegment Window)
Window))
(T (printout T "Not on a Dandetiger - can't record" T)))
"record into the ss"
(SUBITEMS (CopyToDsk (CopyCoreFileToDsk SignalSegment Window)
"Copy the data file for this segment from {CORE} to {DSK}, and change the segment to point to that")))
(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: "16-Aug-85 09:42")
(LET ((n (DSLPromptRead w "Aspect: " 1 75)))
(if n
then (push (fetch aspects of ss)
(CONS n NIL])
(ChooseAspect
[LAMBDA (ss) (* ht: "15-May-85 11:04")
(MENU (create MENU
ITEMS ←(for a in ss:aspects collect a:1])
(ClipSeg
[LAMBDA (ss w) (* ht: "25-Jun-85 14:12")
(LET ([in (FULLNAME (WINDOWPROP w 'SignalFile]
(out (DSLPromptRead w "Name of new file: " 1 70)))
(if out
then (SETQ out (OPENSTREAM (PACKFILENAME 'BODY
out
'DIRECTORY
(FILENAMEFIELD in 'DIRECTORY)
'HOST
(FILENAMEFIELD in 'HOST)
'EXTENSION
(FILENAMEFIELD in 'EXTENSION))
'OUTPUT))
(SELECTQ (AspectProperty ss (WINDOWPROP w 'DisplayedAspect)
'SampleFormat)
(VAX
(* * Need ILS header block)
(BOUT out 0)
(SETFILEPTR out 511)
(BOUT out 0))
NIL)
(COPYBYTES (OPENSTREAM in 'INPUT)
out
(LLSH (fetch offset of ss)
1)
(PLUS (LLSH (fetch offset of ss)
1)
(LLSH (fetch duration of ss)
1)))
(printout T (CLOSEF out])
(ClipSubSeg
[LAMBDA (ss w) (* ht: "16-Aug-85 09:42")
(LET ((mark (GrabMark w ss)))
(if mark
then (ClipSeg (fetch pSS of mark)
w])
(DescribeAspect
[LAMBDA (aspect ss w) (* ht: "15-May-85 11:20")
(WINDOWPROP [INSPECT/ALIST (GetAspect aspect ss)
(create POSITION
XCOORD ←[PLUS (fetch LEFT
of (WINDOWPROP w 'REGION))
(fetch WIDTH
of (WINDOWPROP w 'REGION]
YCOORD ←(fetch BOTTOM of (WINDOWPROP w
'REGION]
'TITLE
(CONCAT (fetch fullName of ss)
" " aspect " aspect"])
(TrueSS
[LAMBDA (ss w) (* ht: "16-Aug-85 09:42")
(* * 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: "16-Aug-85 09:42")
(* * 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 (fetch aspects of ss)
(CONS n (if copyFlg
then (COPY (GetAspect n
(fetch parent
of ss)))
else 'Inherited]
else (PROMPTPRINT "no parent - no inheritance"])
(SpawnShow
[LAMBDA (ss w) (* ht: "16-Aug-85 09:42")
(LET ((sub (GrabMark w ss)))
(if sub
then (NewShow (fetch pSS of sub])
(AddProperty
[LAMBDA (ss w) (* ht: "16-Aug-85 09:42")
(* * Add/set a property of the displayed aspec)
(LET ((aspect (WINDOWPROP w 'DisplayedAspect))
(nl 2)
pn pv)
(if (NOT aspect)
then (SETQ aspect (DSLPromptRead w "For aspect: " 3 150))
(SETQ nl NIL))
(if aspect
then pn←(DSLPromptRead w "Property name: " nl 150))
(if pn
then pv←(DSLPromptRead w "Property value: " NIL))
(if pv
then (AspectProperty ss aspect pn pv])
(DSLPromptRead
[LAMBDA (w prompt nLines width) (* ht: "16-Aug-85 09:42")
(LET ((pw (WINDOWPROP w 'PromptWindow))
v r)
r←(WINDOWPROP pw:1 'REGION)
v←[NLSETQ (PROGN (if nLines
then (if (NOT (NUMBERP nLines))
then nLines←1)
(r←(APPEND r))
(if (AND width width~=r:WIDTH)
then (if (NOT (NUMBERP width))
then width←25+(STRINGWIDTH prompt
(DSPFONT
NIL pw:1)))
(r:LEFT←r:LEFT+(r:WIDTH-width))
(r:WIDTH←width))
[r:HEIGHT←(HEIGHTIFWINDOW nLines*(-(DSPLINEFEED NIL pw:1]
(pw::1←nLines)
(SHAPEW pw:1 r)
(DSPRESET pw:1))
(RESETLST (RESETSAVE (TTYDISPLAYSTREAM pw:1))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(printout T prompt)
(CLEARBUF T T)
(READ T]
(CLOSEW pw:1)
(if v
then v:1])
(ButtonSignalWindow
[LAMBDA (Window) (* ht: "23-May-85 11:24")
(DECLARE (SPECVARS SignalSegment Window))
(* * buttoneventfn for signal window)
(if (NOT \MarkOprInProgress)
then (TOTOPW 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: "15-May-85 11:04")
(if (NOT aspect)
then aspect←(ChooseAspect ss))
(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 [SETQ 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: "16-Aug-85 09:42")
(LET [(aspEntry (ASSOC aspect (fetch aspects of ss]
(if aspEntry
then [if aspEntry::1= 'Inherited
then (PROMPTPRINT T "Copying " aspect " aspect down from "
(fetch parent of ss)
" to " ss " in order to change it.")
(RPLACD aspEntry (COPY (GetAspect aspect (fetch parent
of ss]
(PROG1 (CDR (ASSOC propertyName aspEntry))
(PUTASSOC propertyName newValue aspEntry))
else (HELP "not an aspect of this segment" aspect])
(\GetAspectProperty
[LAMBDA (ss aspect propertyName) (* ht: "16-Aug-85 09:42")
(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 (DIFFERENCE (LASTMOUSEX stream)
(QUOTIENT (DIFFERENCE (PLUS (fetch pPtr of mark)
compr)
1)
compr)))
NearMarkDelta)
then mark])
(InvertMark
[LAMBDA (mark str compr y height) (* ht: "16-Aug-85 09:42")
(* * Invert the space around the mark)
(LET ((x (IDIFFERENCE (IQUOTIENT (fetch pPtr of mark)
compr)
NearMarkDelta)))
(BITBLT str x y str x y (TIMES 2 NearMarkDelta)
(TIMES 2 height)
'INVERT])
(GrabMark
[LAMBDA (w ss) (* ht: "16-Aug-85 09:42")
(* * Return a marks if one is close enough to the mouse when it lets up)
(LET ((str (DECODE/WINDOW/OR/DISPLAYSTREAM w))
(compr (WINDOWPROP w 'Compression))
(height (WINDOWPROP w 'SignalHeight))
(region (WINDOWPROP w 'REGION))
y marks)
(SETQ y (DIFFERENCE (WINDOWPROP w 'SignalBase)
height))
(RESETLST (RESETSAVE (SETCURSOR SSCursor1)
'(CURSOR T))
(RESETSAVE \MarkOprInProgress T)
(PROMPTPRINT
"Either grab a mark with the left button,
or click middle to get a menu of marks")
(ALLOW.BUTTON.EVENTS)
(while (OR (NOT (INSIDEP region LASTMOUSEX LASTMOUSEY))
(MOUSESTATE UP))
do (BLOCK))
(if (MOUSESTATE LEFT)
then [while (MOUSESTATE LEFT)
do (if marks
then (if (NOT (for mark in marks
thereis (NearMark mark str
compr)))
then (InvertMark (CAR marks)
str compr y height)
(SETQ marks NIL))
elseif marks←(for m in ss:points::1
when (NearMark m str compr)
collect m)
then (InvertMark (CAR marks)
str compr y height))
(BLOCK)
finally (if marks
then (InvertMark (CAR marks)
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]
else (CURSOR T)
(until (MOUSESTATE UP) do (BLOCK))
(SETQ \MarkOprInProgress NIL)
(MenuChooseMark ss w])
(ChooseMark
[LAMBDA (marks) (* ht: "16-Aug-85 09:42")
(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: "16-Aug-85 09:42")
(* * 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 (fetch pSS of mark])
(ScrubSS
[LAMBDA (ss recFlg) (* ht: " 1-Jul-85 11:25")
(if (GETHASH (fetch fullName of ss)
SSDir)
then (PUTHASH (fetch fullName of ss)
NIL SSDir))
(for f in SignalFiles when (GETHASHFILE (fetch fullName of ss)
f)
do (PUTHASHFILE (fetch fullName of ss)
NIL f))
(* * clear circular pointers)
(replace parent of ss with NIL)
(replace aspects of ss with NIL)
(if recFlg
then (for p in ss:points::1 do (ScrubSS (fetch pSS of p)
T)))
(replace points of ss with NIL)
(replace localName of ss with 'invalid)
(replace trueName of ss with 'invalid])
(InsertMark
[LAMBDA (points mark) (* ht: " 4-Jan-86 10:31")
(* * 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: "16-Aug-85 09:42")
(* * 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))
(offset (AspectProperty ss (WINDOWPROP w 'DisplayedAspect)
'SampleOffset))
(format (AspectProperty ss (WINDOWPROP w 'DisplayedAspect)
'SampleFormat))
(region (WINDOWPROP w 'REGION))
pos value reg left right)
(RESETLST (RESETSAVE (DSPOPERATION 'INVERT
str)
(LIST 'DSPOPERATION
(DSPOPERATION NIL str)
str))
(RESETSAVE \MarkOprInProgress T)
(ALLOW.BUTTON.EVENTS)
(SETQ pos (IQUOTIENT (IPLUS (fetch pPtr of mark)
compr -1)
compr))
(APPLY* posFn file (ITIMES pos compr))
(SETQ value (APPLY* getFn file format offset))
(ShowMark ss pos base height mark NIL del w (ITIMES pos compr)
value)
[if (NOT dontMove)
then (RESETSAVE (SETCURSOR SSCursor2)
'(CURSOR T))
(while (OR (NOT (INSIDEP region LASTMOUSEX LASTMOUSEY))
(MOUSESTATE UP))
do (BLOCK))
(while (MOUSESTATE LEFT)
do [if (NOT (EQP pos (LASTMOUSEX str)))
then (ShowMark ss pos base height mark NIL del w
(ITIMES pos compr)
value)
(SETQ reg (DSPCLIPPINGREGION NIL w))
(SETQ left (fetch LEFT of reg))
(SETQ right (IPLUS left (fetch WIDTH
of reg)
-1))
[SETQ pos (IMAX left (IMIN right
(LASTMOUSEX
str]
(APPLY* posFn file (ITIMES pos compr))
(ShowMark ss pos base height mark NIL del w
(ITIMES pos compr)
(SETQ value
(APPLY* getFn file format offset]
(BLOCK))
(if (INSIDEP (DSPCLIPPINGREGION NIL str)
(CURSORPOSITION NIL str))
then (replace pPtr of mark with (ITIMES pos compr))
else (ShowMark ss pos base height mark NIL del w
(ITIMES pos compr)
value)
(APPLY* posFn file (fetch pPtr of mark))
(ShowMark ss (IQUOTIENT (IPLUS (fetch pPtr
of mark)
compr -1)
compr)
base height mark NIL del w NIL
(APPLY* getFn file format offset]
(if ss:points=NIL
then (replace points of ss with (LIST NIL)))
(InsertMark (fetch points of ss)
mark)
(\RedisplayMark mark ss w])
(NewMark
[LAMBDA (ss w subSS end? dontMove) (* ht: "25-Jun-85 14:12")
(PROG (mark)
[if (NOT subSS)
then subSS←(create SignalSegment
parent ← ss
name ←(OR (DSLPromptRead w "Name for new SS: " 1 150)
(RETURN]
(SETQ mark (create PointRec
pSS ← subSS
end? ← end?))
(\MoveMark1 mark ss w dontMove)
(RETURN mark])
(NewSS
[LAMBDA (ss w) (* ht: "16-Aug-85 09:42")
(LET ((beginning (NewMark ss w)))
(if beginning
then (if (NewMark ss w (fetch pSS of beginning)
T)
then (for aspectName in SSAutoInheritAspects when (GetAspect
aspectName ss)
do (push (fetch aspects of (fetch pSS of beginning))
(CONS aspectName 'Inherited])
(AddSS
[LAMBDA (ss w) (* ht: "16-Aug-85 09:42")
(LET ((name (DSLPromptRead w "Name of existing sub-segment: " 1 170))
sub)
(if sub←(FindSS (if (NTHCHAR name 1)= '/
then name
else (PACK (LIST (fetch fullName of ss)
'/
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: "16-Aug-85 09:42")
(* * Jump the window to show a named mark)
(LET ((mark (MenuChooseMark ss w))
compr)
(if mark
then (SETQ compr (WINDOWPROP w 'Compression))
(PositionSignalWindow w [IMAX 0 (DIFFERENCE
(fetch pPtr of mark)
(TIMES compr
(QUOTIENT (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 (fetch pSS of p))
do (replace pSS of p with (FindSS (fetch pSS of p)
NIL T)))
(RedisplayMarks w])
(\DeleteMark1
[LAMBDA (mark ss w) (* ht: "23-May-85 12:08")
(if mark
then (replace points of ss with (DREMOVE mark (fetch points of ss)))
(\RedisplayMark mark ss w])
(\RedisplayMark
[LAMBDA (mark ss w) (* ht: "16-Aug-85 09:42")
(LET ((compr (WINDOWPROP w 'Compression))
(r (APPEND (DSPCLIPPINGREGION NIL w)))
truePos)
(SETQ truePos (QUOTIENT (DIFFERENCE (PLUS (fetch pPtr of mark)
compr)
1)
compr))
(replace LEFT of r with (DIFFERENCE truePos LeftOff))
(* * should compute and save in the point its width)
(replace WIDTH of r with (fetch pWidth of mark))
(REDISPLAYW w r])
(MoveMark
[LAMBDA (ss w bothFlg) (* ht: "16-Aug-85 09:42")
(* * 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 (SETQ offset (fetch offset of (fetch pSS of mark)))
(SETQ duration (fetch duration of (fetch pSS of mark]
(\DeleteMark1 mark ss w)
(\MoveMark1 mark ss w)
(if bothFlg
then [SETQ other (for p in ss:points::1
thereis (AND (EQ (fetch pSS of p)
(fetch pSS of mark))
(NEQ (fetch end? of p)
(fetch end? of mark]
(\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 (replace offset of (fetch pSS of mark)
with (DIFFERENCE (fetch pPtr of mark)
duration)))
(replace duration of (fetch pSS of mark) with duration)
(if ss:points=NIL
then (replace points of ss with (LIST NIL)))
(InsertMark (fetch points of ss)
other)
(\RedisplayMark other ss w])
(ChooseMarkSelectFn
[LAMBDA (item menu key) (* ht: "23-May-85 10:46")
(for mark in $ss$:points::1 thereis (AND (EQ (fetch name
of (fetch pSS of mark))
item)
(EQ (fetch end? of mark)
(EQ key 'MIDDLE])
(MenuChooseMark
[LAMBDA ($ss$ w)
(DECLARE (SPECVARS $ss$)) (* ht: "23-May-85 12:10")
(PROMPTPRINT "Left button for left end of SS,
middle button for right end")
(MENU (create MENU
ITEMS ←(for mark in $ss$:points::1 when NOT (mark:end?) collect mark:pSS:name)
WHENSELECTEDFN ←(FUNCTION ChooseMarkSelectFn])
)
(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 \DSLNoDataShade 5160)
(RPAQQ \MarkOprInProgress NIL)
(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 LeftOff 24)
(RPAQQ BitsPerSamp 1)
(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)))
(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 \MarkOprInProgress)
)
(DECLARE: DONTCOPY
[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 home (offset FIXP)
(duration FIXP))
(ACCESSFNS SignalSegment ((fullName SSFullName)
(name (fetch localName of DATUM)
SSNewName))))
]
(/DECLAREDATATYPE 'SignalSegment
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER FIXP FIXP)
'((SignalSegment 0 POINTER)
(SignalSegment 2 POINTER)
(SignalSegment 4 POINTER)
(SignalSegment 6 POINTER)
(SignalSegment 8 POINTER)
(SignalSegment 10 POINTER)
(SignalSegment 12 POINTER)
(SignalSegment 14 FIXP)
(SignalSegment 16 FIXP))
'18)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
[ADDTOVAR SYSTEMRECLST
(DATATYPE SignalSegment (localName trueName comment points aspects parent home (offset FIXP)
(duration FIXP)))
]
(/DECLAREDATATYPE 'SignalSegment
'(POINTER POINTER POINTER POINTER POINTER POINTER POINTER FIXP FIXP)
'((SignalSegment 0 POINTER)
(SignalSegment 2 POINTER)
(SignalSegment 4 POINTER)
(SignalSegment 6 POINTER)
(SignalSegment 8 POINTER)
(SignalSegment 10 POINTER)
(SignalSegment 12 POINTER)
(SignalSegment 14 FIXP)
(SignalSegment 16 FIXP))
'18)
)
(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 '/REPLACE
NEWVALUE]))
(ADDTOVAR BackgroundMenuCommands (DSL (DSL)
"Start up the Digital Signal Lab"))
(FILESLOAD (SYSLOAD)
HASH BUSMASTER PCDAC)
(* the next stuff is for the release DSL only - it includes stuff private to HT)
(RPAQQ MOVEDATACOMS [[VARS (\FloatArray (ARRAY 1 'FLOATP]
(FNS AFIN AWIN FIN WIN)
(DECLARE: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T])
(RPAQ \FloatArray (ARRAY 1 'FLOATP))
(DEFINEQ
(AFIN
[LAMBDA (stream array nFloats firstElt format) (* ht: "16-Aug-85 09:40")
(LET ((base (ARRAYBASE array)))
(SELECTQ format
[VAX (for i from (if firstElt
then (LLSH (DIFFERENCE firstElt (ARRAYORIG
array))
2)
else 0)
by 4 to (LLSH (PLUS (if firstElt
then (DIFFERENCE firstElt
(ARRAYORIG array))
else 0)
(OR nFloats (ARRAYSIZE array))
-1)
2)
do (\PUTBASEBYTE base i+1 (BIN stream))
(\PUTBASEBYTE base i (BIN stream)+-1)
(\PUTBASEBYTE base i+3 (BIN stream))
(\PUTBASEBYTE base i+2 (BIN stream]
(\BINS stream base (if firstElt
then (LLSH (DIFFERENCE firstElt (ARRAYORIG
array))
2)
else 0)
(LLSH (OR nFloats (ARRAYSIZE array))
2)))
array])
(AWIN
[LAMBDA (stream array nWords firstElt format offset) (* ht: "16-Aug-85 09:40")
(LET ((base (ARRAYBASE array))
word)
[SELECTQ format
[VAX (if (NULL offset)
then (SETQ offset 0))
(for i from (if firstElt
then (DIFFERENCE firstElt (ARRAYORIG array))
else 0)
to (PLUS (if firstElt
then (DIFFERENCE firstElt (ARRAYORIG array))
else 0)
(OR nWords (ARRAYSIZE array))
-1)
do (SETQ word (LOGOR (BIN stream)
(LLSH (BIN stream)
8)))
(\PUTBASE base i (IMAX 0 (DIFFERENCE (if (GREATERP word
32767)
then (IDIFFERENCE
word 65536)
else word)
offset]
(if (AND offset (NOT (ZEROP offset)))
then
(* * from non-vax with offset)
(for i from (if firstElt
then (DIFFERENCE firstElt (ARRAYORIG array))
else 0)
to (PLUS (if firstElt
then (DIFFERENCE firstElt (ARRAYORIG array))
else 0)
(OR nWords (ARRAYSIZE array))
-1)
do (\PUTBASE base i (DIFFERENCE (LOGOR (LLSH
(BIN stream)
8)
(BIN stream))
offset)))
else
(* * fast case -
from non-vax with no offset)
(\BINS stream base (if firstElt
then (LLSH (DIFFERENCE firstElt
(ARRAYORIG
array))
1)
else 0)
(LLSH (OR nWords (ARRAYSIZE array))
1]
array])
(FIN
[LAMBDA (stream format) (* ht: "16-Aug-85 09:40")
(LET ((floatPointer (ARRAYBASE \FloatArray)))
[SELECTQ format
(VAX (\PUTBASEBYTE floatPointer 1 (BIN stream))
(\PUTBASEBYTE floatPointer 0 (BIN stream)+-1)
(\PUTBASEBYTE floatPointer 3 (BIN stream))
(\PUTBASEBYTE floatPointer 2 (BIN stream)))
(PROGN (\PUTBASEBYTE floatPointer 0 (BIN stream))
(\PUTBASEBYTE floatPointer 1 (BIN stream))
(\PUTBASEBYTE floatPointer 2 (BIN stream))
(\PUTBASEBYTE floatPointer 3 (BIN stream]
(ELT \FloatArray 1])
(WIN
[LAMBDA (stream format offset) (* ht: "13-May-85 12:01")
(SELECTQ format
(VAX (LET [(word (LOGOR (BIN stream)
(LLSH (BIN stream)
8]
(if word gt 32767
then (IDIFFERENCE word 65536)
else word)
- (OR offset 0)))
((LOGOR (LLSH (BIN stream)
8)
(BIN stream))
-(OR offset 0])
)
(DECLARE: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY
(RESETSAVE DWIMIFYCOMPFLG T)
)
(RPAQQ RAWCOMS ((FNS \RawComplexArray \RawExpArray \RawFPlusArrays \RawFTimesArrays \RawFloatArray
\RawMagArray \RawPermArray)
(DECLARE: DONTCOPY DOEVAL@COMPILE (MACROS \RawFPlusArrays \RawFTimesArrays
\RawFloatArray \RawPermArray))))
(DEFINEQ
(\RawComplexArray
[LAMBDA (fromArray fromOffset toArray toOffset kount) (* jop: " 8-Jan-86 14:16")
((OPCODES MISC3 3)
(\ADDBASE (ARRAYBASE fromArray)
fromOffset)
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount])
(\RawExpArray
[LAMBDA (fromArray fromOffset toArray toOffset kount) (* jop: " 8-Jan-86 17:09")
((OPCODES MISC3 0)
(\ADDBASE (ARRAYBASE fromArray)
fromOffset)
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount])
(\RawFPlusArrays
[LAMBDA (fromArray1 fromOffset1 fromArray2 fromOffset2 toArray toOffset kount)
(* ht: " 2-Jan-86 09:51")
((OPCODES MISC4 2)
(\ADDBASE (ARRAYBASE fromArray1)
(LLSH fromOffset1 1))
(\ADDBASE (ARRAYBASE fromArray2)
(LLSH fromOffset2 1))
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount])
(\RawFTimesArrays
[LAMBDA (fromArray1 fromOffset1 fromArray2 fromOffset2 toArray toOffset kount)
(* ht: " 2-Jan-86 09:46")
((OPCODES MISC4 0)
(\ADDBASE (ARRAYBASE fromArray1)
(LLSH fromOffset1 1))
(\ADDBASE (ARRAYBASE fromArray2)
(LLSH fromOffset2 1))
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount])
(\RawFloatArray
[LAMBDA (fromArray fromOffset toArray toOffset kount) (* ht: " 2-Jan-86 09:43")
((OPCODES MISC3 2)
(\ADDBASE (ARRAYBASE fromArray)
fromOffset)
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount])
(\RawMagArray
[LAMBDA (fromArray fromOffset toArray toOffset kount) (* jop: " 8-Jan-86 17:27")
((OPCODES MISC3 1)
(\ADDBASE (ARRAYBASE fromArray)
fromOffset)
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount])
(\RawPermArray
[LAMBDA (fromArray fromOffset permArray permOffset toArray toOffset kount)
(* ht: " 2-Jan-86 09:46")
((OPCODES MISC4 1)
(\ADDBASE (ARRAYBASE fromArray)
fromOffset)
(\ADDBASE (ARRAYBASE permArray)
permOffset)
(\ADDBASE (ARRAYBASE toArray)
toOffset)
kount])
)
(DECLARE: DONTCOPY DOEVAL@COMPILE
(DECLARE: EVAL@COMPILE
(PUTPROPS \RawFPlusArrays MACRO ((fromArray1 fromOffset1 fromArray2 fromOffset2 toArray toOffset
kount)
(* ht: " 2-Jan-86 09:51")
((OPCODES MISC4 2)
(\ADDBASE (ARRAYBASE fromArray1)
(LLSH fromOffset1 1))
(\ADDBASE (ARRAYBASE fromArray2)
(LLSH fromOffset2 1))
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount)))
(PUTPROPS \RawFTimesArrays MACRO ((fromArray1 fromOffset1 fromArray2 fromOffset2 toArray toOffset
kount)
(* ht: " 2-Jan-86 09:46")
((OPCODES MISC4 0)
(\ADDBASE (ARRAYBASE fromArray1)
(LLSH fromOffset1 1))
(\ADDBASE (ARRAYBASE fromArray2)
(LLSH fromOffset2 1))
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount)))
(PUTPROPS \RawFloatArray MACRO ((fromArray fromOffset toArray toOffset kount)
(* ht: " 2-Jan-86 09:43")
((OPCODES MISC3 2)
(\ADDBASE (ARRAYBASE fromArray)
fromOffset)
(\ADDBASE (ARRAYBASE toArray)
(LLSH toOffset 1))
kount)))
(PUTPROPS \RawPermArray MACRO ((fromArray fromOffset permArray permOffset toArray toOffset kount)
(* ht: " 2-Jan-86 09:46")
((OPCODES MISC4 1)
(\ADDBASE (ARRAYBASE fromArray)
fromOffset)
(\ADDBASE (ARRAYBASE permArray)
permOffset)
(\ADDBASE (ARRAYBASE toArray)
toOffset)
kount)))
)
)
(RPAQQ CFIXCOMS ((FNS \CheapFix)
(MACROS \CheapFix)))
(DEFINEQ
(\CheapFix
[LAMBDA (X) (* ht: " 3-Jan-86 11:06")
(PROG ((SIGN (FETCHFIELD '(NIL 0 (BITS . 0))
X))
(LO (FETCHFIELD '(NIL 1 (BITS . 15))
X))
(HI (FETCHFIELD '(NIL 0 (BITS . 150))
X))
(EXP (FETCHFIELD '(NIL 0 (BITS . 23))
X)))
(* * HTs hack of \FIXP.FROM.FLOATP -
only works for SMALLP results)
(* Unpacks a floating point number X into its components. (GO RETZERO) is evaluated if the number is true zero.
The fraction is unpacked into HI and LO, with the binary point implicitly between bits 0 and 1 of HI.
If NIL is true, the fraction is left in its original state, with 8 bits in HI and 16 in LO.
If X is not floating, it is coerced.)
(if 0=EXP
then (* zero or a de-normalized number from underflow)
(if (AND 0=HI 0=LO)
then (* A zero, regardless of the sign bit zero)
(RETURN 0)
else (* need bias adjust to account for lack of hidden bit)
EXP←1)
elseif EXP~=255
then (* might want to check for NaN's here if EXP =
\MAX.EXPONENT)
(* OR in the implicit high bit of fraction)
HI←(IPLUS HI 128))
(EXP←(IDIFFERENCE EXP (IPLUS 127 -1))) (* number of bits to left of binary point)
(if (ILESSP EXP 0)
then (RETURN 0)
elseif (IGREATERP EXP 16)
then LO←MAX.SMALLP
elseif (IGEQ EXP←(IDIFFERENCE 24 EXP)
16)
then LO←HI
(FRPTQ (IDIFFERENCE EXP 16)
LO←(LRSH LO 1))
else LO←(IPLUS (LLSH HI 8)
(LRSH LO 8))
(FRPTQ (IDIFFERENCE EXP 8)
LO←(LRSH LO 1)))
(RETURN (if SIGN=1
then (IMINUS LO)
else LO])
)
(DECLARE: EVAL@COMPILE
[PUTPROPS \CheapFix MACRO ((expr)
(LET ((X expr))
(* ht: " 3-Jan-86 11:06")
(PROG ((SIGN (FETCHFIELD '(NIL 0 (BITS . 0))
X))
(LO (FETCHFIELD '(NIL 1 (BITS . 15))
X))
(HI (FETCHFIELD '(NIL 0 (BITS . 150))
X))
(EXP (FETCHFIELD '(NIL 0 (BITS . 23))
X)))
(* * HTs hack of \FIXP.FROM.FLOATP - only works for SMALLP results)
(* Unpacks a floating point number X into its components. (GO RETZERO)
is evaluated if the number is true zero. The fraction is unpacked into HI
and LO, with the binary point implicitly between bits 0 and 1 of HI. If NIL
is true, the fraction is left in its original state, with 8 bits in HI and
16 in LO. If X is not floating, it is coerced.)
[COND [(EQ 0 EXP)
(* zero or a de-normalized number from underflow)
(COND ((AND (EQ 0 HI)
(EQ 0 LO))
(* A zero, regardless of the sign bit zero)
(RETURN 0))
(T (* need bias adjust to account for lack of hidden bit)
(SETQ EXP 1]
((NEQ EXP 255)
(* might want to check for NaN's here if EXP = \MAX.EXPONENT)
(* OR in the implicit high bit of fraction)
(SETQ HI (IPLUS HI 128]
(SETQ EXP (IDIFFERENCE EXP (SUB1 127)))
(* number of bits to left of binary point)
[COND ((ILESSP EXP 0)
(RETURN 0))
((IGREATERP EXP 16)
(SETQ LO MAX.SMALLP))
[(IGEQ (SETQ EXP (IDIFFERENCE 24 EXP))
16)
(SETQ LO HI)
(FRPTQ (IDIFFERENCE EXP 16)
(SETQ LO (LRSH LO 1]
(T (SETQ LO (IPLUS (LLSH HI 8)
(LRSH LO 8)))
(FRPTQ (IDIFFERENCE EXP 8)
(SETQ LO (LRSH LO 1]
(RETURN (COND ((EQ SIGN 1)
(IMINUS LO))
(T LO]
)
(RPAQ SSReadTable (COPYREADTABLE HASHFILERDTBL))
(RPAQ \ZeroArray (ARRAY 16384 'WORD
(\PCDAC.DATAOFFSET PCDAC.BOARD)
0))
(SETQ BackgroundMenu NIL)
(DEFPRINT 'SignalSegment
'PrintSignalSegment)
(SETSYNTAX '#
'(MACRO FIRST SSRead)
SSReadTable)
(PUTPROPS AspectProperty ARGNAMES (NIL (segment aspect propertyName {propertyValue}) . N))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
BUSMASTER.DCOM PCDAC.DCOM)
(RESETSAVE DWIMIFYCOMPFLG T)
(COND ([NOT (OR (GETP 'ARRAYBASE
'DMACRO)
(GETP 'ARRAYBASE
'MACRO]
(HELP "ARRAYBASE needed - load macro def'n from somewhere and/or RETURN")))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA AspectProperty)
)
(PUTPROPS DSL COPYRIGHT ("Xerox Corporation" 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5581 15927 (DSL 5591 . 5893) (MakeDSLControlW 5895 . 7358) (\PosnDSLIconW 7360 . 7731)
(\PosnDSLCtlW 7733 . 8021) (MakeAndShowSS 8023 . 9575) (DSLControlWindowButtonFn 9577 . 10037) (
MakeSSForFile 10039 . 11086) (PrintSSName 11088 . 11294) (SSDir 11296 . 11556) (FindAndShowSS 11558 .
11917) (GetSS 11919 . 13170) (\FindSSDir 13172 . 13536) (UpdateDir 13538 . 13740) (SFNames 13742 .
13960) (CloseDir 13962 . 14206) (SSOneDir 14208 . 14393) (NoticeDir 14395 . 14623) (CreateDir 14625 .
15031) (SSDir1 15033 . 15680) (DTYPE 15682 . 15925)) (18999 43973 (CloseSignalFile 19009 . 19479) (
CloseSignalWindow 19481 . 19871) (CompressionButtonFn 19873 . 20690) (NewCompression 20692 . 21206) (
\CheckWidthVsCompr 21208 . 21680) (PositionSignalWindow 21682 . 22525) (NewShow 22527 . 24732) (
MakePrompt 24734 . 25621) (LinkShow 25623 . 25830) (\ComputeZoomOffset 25832 . 26046) (ZoomWindow
26048 . 26481) (\MakeLinkedWindow 26483 . 28496) (UnlinkWindow 28498 . 28809) (ClearSignalWindow 28811
. 28991) (RepaintSingleValuedAspect 28993 . 30393) (RepaintSingleValuedAspect/File 30395 . 32174) (
RedisplayMarks 32176 . 33409) (ReshapeSignalWindow 33411 . 34526) (\UpdateLinks 34528 . 35291) (
\UpdateLinkedWindows 35293 . 36623) (\ChangeLinkedOffset 36625 . 37620) (UpdateSignalCompression 37622
. 38237) (UpdateSignalOrigin 38239 . 38698) (TrueLeftMargin 38700 . 38921) (ScrollSignalWindow 38923
. 39139) (SetupSignalFile 39141 . 40162) (UpdateScaleFactor 40164 . 40779) (RedisplayScale 40781 .
41779) (ReshapeScaleWindow 41781 . 42085) (CarefulSFP 42087 . 42319) (SecPrint 42321 . 42662) (
ShowMark 42664 . 43971)) (44011 51185 (PrintSignalSegment 44021 . 44237) (SSFullName 44239 . 44792) (
FindSS 44794 . 46044) (PromptForSSFile 46046 . 46548) (SSFile 46550 . 47359) (CleanupSSFiles 47361 .
47651) (SaveSS 47653 . 48948) (SSRead 48950 . 49433) (SSFromFile 49435 . 50567) (SSFileForm 50569 .
50945) (SSNewName 50947 . 51183)) (51250 55377 (RepaintSingleValuedAspect/Array 51260 . 52270) (
\RepaintSignalSliceFromArray 52272 . 54053) (\SetupArrays 54055 . 55375)) (55842 74163 (RecordSegment
55852 . 61025) (RecordToFile 61027 . 64426) (PlaySeg 64428 . 64715) (PlayFileSeg 64717 . 71019) (
PlayArraySeg 71021 . 71396) (MaxSampleRate 71398 . 71858) (SkipSize 71860 . 72949) (PlaySubSS 72951 .
73186) (PLAY.IT 73188 . 73920) (\SSShutUpBoard 73922 . 74161)) (78664 85992 (AddAspect 78674 . 78931)
(ChooseAspect 78933 . 79134) (ClipSeg 79136 . 80221) (ClipSubSeg 80223 . 80459) (DescribeAspect 80461
. 80991) (TrueSS 80993 . 81382) (InheritAspect 81384 . 82064) (SpawnShow 82066 . 82285) (AddProperty
82287 . 82916) (DSLPromptRead 82918 . 83968) (ButtonSignalWindow 83970 . 84576) (SetAspect 84578 .
85134) (CopyCoreFileToDsk 85136 . 85990)) (86066 88101 (GetAspect 86076 . 86329) (AspectProperty 86331
. 86842) (UndisplayAspect 86844 . 87157) (\PutAspectProperty 87159 . 87855) (\GetAspectProperty 87857
. 88099)) (88132 102416 (NearMark 88142 . 88525) (InvertMark 88527 . 88906) (GrabMark 88908 . 90885)
(ChooseMark 90887 . 91310) (DeleteMark 91312 . 91758) (ScrubSS 91760 . 92607) (InsertMark 92609 .
92939) (\MoveMark1 92941 . 96139) (NewMark 96141 . 96601) (NewSS 96603 . 97105) (AddSS 97107 . 97632)
(JumpTo 97634 . 98282) (ToggleMarks 98284 . 99114) (\DeleteMark1 99116 . 99379) (\RedisplayMark 99381
. 100003) (MoveMark 100005 . 101660) (ChooseMarkSelectFn 101662 . 102006) (MenuChooseMark 102008 .
102414)) (107345 111393 (AFIN 107355 . 108381) (AWIN 108383 . 110247) (FIN 110249 . 110936) (WIN
110938 . 111391)) (111738 114088 (\RawComplexArray 111748 . 112018) (\RawExpArray 112020 . 112286) (
\RawFPlusArrays 112288 . 112723) (\RawFTimesArrays 112725 . 113161) (\RawFloatArray 113163 . 113430) (
\RawMagArray 113432 . 113698) (\RawPermArray 113700 . 114086)) (115574 117698 (\CheapFix 115584 .
117696)))))
STOP