(FILECREATED " 2-Jul-85 12:20:32" {DSK}<DSK>HTHOMPSON>DSL>DSL.;27 98634
changes to: (FNS MakeAndShowSS RecordSegment NewShow RedisplayMarks SetupSignalFile
PlayFileSeg FindAndShowSS GetSS RepaintSingleValuedAspect/File
\RepaintSignalSliceFromArray ScrubSS)
(VARS DSLCOMS DSLControlMenuItems SignalMenuItems)
previous date: "25-Jun-85 20:25:10" {DSK}<DSK>HTHOMPSON>DSL>DSL.;23)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DSLCOMS)
(RPAQQ DSLCOMS [(* Needed because some of the compiled code actually calls IBOX)
(DECLARE: FIRST (FILES NOBOX))
(* * DSL Control functions)
(FNS DSL ChooseMarkSelectFn MenuChooseMark MakeAndShowSS DSLControlWindowButtonFn
MakeDSLControlW MakeSSForFile PrintSSName SSDir FindAndShowSS GetSS \FindSSDir UpdateDir
SFNames CloseDir SSOneDir NoticeDir CreateDir SSDir1 DTYPE)
(VARS DSLControlIcon DSLControlMenuItems (\SSAmplMenu)
(\SSFormatMenu)
(\SSSampleMenu)
(\SSOffsetMenu)
(DSLControlWindow)
(DSLControlMenu))
(* * signal window functions)
(FNS CloseSignalFile CloseSignalWindow CompressionButtonFn NewCompression
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)
(* * record and playback)
(VARS SSDMAChannel SSPCA/DInputChannel SSPCD/AOutputChannel \SSDrawPointTime
\SSFetchPerHundredTime \SSWriteToCoreTime \SSWriteToDskTime)
(INITVARS (\SSDataArray))
(CONSTANTS PCDACClockInverse)
(FNS RecordSegment RecordToCoreFile RecordToDisplayOnly RecordToDskFile PlaySeg PlayFileSeg
PlayArraySeg MaxSampleRate SkipSize PlaySubSS PLAY.IT)
(* * 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)
(CURSORS SSCursor1 SSCursor2)
(VARS (\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)))
(SSReadTable (COPYREADTABLE HASHFILERDTBL))
(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)
(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 '/REPLACE
NEWVALUE]
(BackgroundMenuCommands (DSL (DSL)
"Start up the Digital Signal Lab")))
(P (SETQ BackgroundMenu NIL)
(DEFPRINT 'SignalSegment
'PrintSignalSegment)
(SETSYNTAX '#
'(MACRO FIRST SSRead)
SSReadTable))
(FNS MakeFake SinPoint)
(FILES (SYSLOAD)
PCDAC MOVEDATA)
(ADVISE SETFILEPTR-IN-CREATEHASHFILE TOTOPW-IN-TOPATTACHEDWINDOWS)
(PROP ARGNAMES AspectProperty)
[DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY (P (CLISPDEC '(MIXED)]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY (FILES (SYSLOAD)
PCDAC NOBOX MOVEDATA))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA AspectProperty])
(* Needed because some of the compiled code actually calls IBOX)
(DECLARE: FIRST
(FILESLOAD NOBOX)
)
(* * DSL Control functions)
(DEFINEQ
(DSL
[LAMBDA NIL (* ht: "27-May-85 12:58")
(TOTOPW (OR (WINDOWP DSLControlWindow)
(MakeDSLControlW)))
(if (DTYPE)= 'TIGER
then (BUS.RESET)
(BUSDMA.INIT])
(ChooseMarkSelectFn
[LAMBDA (item menu key) (* ht: "23-May-85 10:46")
(for mark in $ss$:points::1 thereis (AND mark:pSS:name=item mark:end?=(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])
(MakeAndShowSS
[LAMBDA ($window$)
(DECLARE (SPECVARS $window$)) (* ht: " 2-Jul-85 11: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: "22-May-85 17:25")
Window←(MAINWINDOW Window)
(if (MOUSESTATE LEFT)
then (MOVEW Window)
else (RESETFORM (TTYDISPLAYSTREAM (WINDOWPROP Window 'DSLOutputWindow))
(MENU (OR DSLControlMenu DSLControlMenu←(create MENU
ITEMS ← DSLControlMenuItems])
(MakeDSLControlW
[LAMBDA NIL (* ht: "22-May-85 17:38")
DSLControlWindow←(CREATEW (GETBOXREGION 60 60 NIL NIL NIL
"Specify the position of the DSL control window please")
NIL NIL T)
(BITBLT DSLControlIcon NIL NIL DSLControlWindow)
(WINDOWPROP DSLControlWindow 'BUTTONEVENTFN
(FUNCTION DSLControlWindowButtonFn))
(WINDOWPROP DSLControlWindow 'SHRINKFN
'DON%'T)
(MakePrompt DSLControlWindow)
(let ((ow (CREATEW '(0 0 200 200)
NIL NIL T)))
(ATTACHWINDOW ow DSLControlWindow 'BOTTOM
'RIGHT
'HERE)
(DSPSCROLL 'ON
ow)
(WINDOWPROP ow 'BUTTONEVENTFN
(FUNCTION DSLControlWindowButtonFn))
(WINDOWPROP DSLControlWindow 'DSLOutputWindow
ow))
DSLControlWindow])
(MakeSSForFile
[LAMBDA (name fileName size ampl rate format offset) (* ht: "13-May-85 14:07")
(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: " 1-Jul-85 12:13")
(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: " 1-Jul-85 12:13")
(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: "22-May-85 17:21")
(let ((items (SFNames)))
[if nowhereFlg
then (NCONC1 items '(NowhereYet SSDir)]
(if readWindow
then (NCONC1 items '{typein}))
(MENU (create MENU
ITEMS ← items])
(UpdateDir
[LAMBDA NIL (* ht: "22-May-85 17:17")
(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: "22-May-85 17:17")
(let ((hf (\FindSSDir)))
(if hf
then (CLOSEHASHFILE hf)
(SignalFiles←(DREMOVE hf SignalFiles])
(SSOneDir
[LAMBDA NIL (* ht: "22-May-85 17:22")
(let ((hf (\FindSSDir T)))
(if hf
then (SSDir1 hf])
(NoticeDir
[LAMBDA (window) (* ht: "25-Jun-85 14:11")
(let ((file (DSLPromptRead window "SS Directory File: " 1 150)))
(if file
then (SSFile file])
(CreateDir
[LAMBDA (window) (* ht: "25-Jun-85 14:11")
(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 \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: "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: "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: "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: " 2-Jul-85 12: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 'REPAINTFN
'NILL)
(WINDOWADDPROP window 'REPAINTFN
(FUNCTION RedisplayMarks))
(WINDOWPROP window 'SCROLLFN
'ScrollSignalWindow)
(WINDOWADDPROP window 'CLOSEFN
'CloseSignalWindow)
(WINDOWADDPROP window 'RESHAPEFN
'ReshapeSignalWindow)
(WINDOWPROP window 'BUTTONEVENTFN
'ButtonSignalWindow)
(ReshapeSignalWindow window)
window])
(MakePrompt
[LAMBDA (mw) (* ht: "20-May-85 13:56")
(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))
(* * 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")
(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: " 1-Jul-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 (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 format sampleOffset bottom top left right y dispPos (dispPos1 (IBOX))
(truePos (IBOX))
(mDelta 0))
(UpdateSignalOrigin window)
(UpdateSignalCompression window)
destBM←(DSPDESTINATION NIL stream)
format←(AspectProperty ss (WINDOWPROP window 'DisplayedAspect)
'SampleFormat)
sampleOffset←(AspectProperty ss (WINDOWPROP window 'DisplayedAspect)
'SampleOffset)
(if (NOT iScale)
then (WINDOWPROP window 'IntegerScaleFactor
iScale←(FIX 1.0/scale)))
(if (NOT region)
then region←(DSPCLIPPINGREGION NIL window))
[SETQ bottom (IMAX 0 (IPLUS (fetch BOTTOM of region)
(DSPYOFFSET NIL stream]
top←(IMIN SCREENHEIGHT-1 bottom+region:HEIGHT)
left←[IBOX (IMAX 0 (region:LEFT+(DSPXOFFSET NIL stream]
right←(IBOX (IMIN (IPLUS SCREENWIDTH -1)
left+region:WIDTH))
dispPos←(IBOX region:LEFT+(DSPXOFFSET NIL stream))
truePos:I←region:LEFT*compr
(SETFILEPTR file (IMAX 0 truePos-compr))
y←(WIN file format sampleOffset)/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←(WIN file format sampleOffset)/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: " 2-Jul-85 12:13")
(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: "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: "13-May-85 13:54")
(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) (* ht: "11-Jan-85 14:05")
(SCROLLBYREPAINTFN window deltaX deltaY continuousFlg)
(\UpdateLinkedWindows window])
(SetupSignalFile
[LAMBDA (ss aspect w) (* ht: " 2-Jul-85 12:18")
(* * 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))
(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: " 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])
(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: "13-May-85 13:53")
(let ((lf (DSPLINEFEED NIL window))
maxX)
(MOVETO x-LeftOff y+(-h)+lf+(-mDelta)
window)
(SecPrint (OR pos point:pPtr)
window
(WINDOWPROP window 'DisplayedAspect)
ss)
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: "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: "25-Jun-85 14:11")
(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: "23-May-85 22:41")
(* * 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: "22-May-85 17:02")
(* * 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))
(ss:home←(HASHFILEPROP hf 'NAME))
(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: " 1-Jul-85 11:13")
(* * 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))
(truePos region:LEFT*compr)
[left (IMAX 0 (region:LEFT+(DSPXOFFSET NIL stream]
right y)
right←(IMIN SCREENWIDTH-1 left+region:WIDTH)
bottom←(IMAX 0 bottom)
top←(IMIN SCREENHEIGHT-1 top)
(SELECTQ mode
((NIL Line)
y←
(IQUOTIENT (ELT array (MAX truePos-compr 0))
-ArrayOffset iScale)
(for i from 1 to (IMIN region:WIDTH+1 (ss:duration+ss:offset)/compr-region:LEFT)
do (\CLIPANDDRAWLINE1 (SUB1 dispPos)
y dispPos (SETQ y (IPLUS (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 (SETQ 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)
(RPAQ? \SSDataArray )
(DECLARE: EVAL@COMPILE
(RPAQQ PCDACClockInverse 1.25E-6)
(CONSTANTS PCDACClockInverse)
)
(DEFINEQ
(RecordSegment
[LAMBDA (ss window) (* ht: " 2-Jul-85 11:50")
(* * The CONSTANT is to forestall a dwimify bug wrt 1.0/sampleRate/1.25E-6)
(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←(AspectProperty ss 'Data
'DataFile))
(CLOSEF? file)
(file←(OPENSTREAM file '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 (DSLPromptRead window
"Estimated length of recording (in seconds): "
1 250)
5))
(nPages←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←compression*width
arraySize←16384
(for i from 2 until (ILEQ xferSize←sliceSize+[FIX
(SkipSize sampleRate compression sliceSize NIL
(if writing
then device
else 'NULL]
arraySize)
do (if sliceSize←dataWidth/i=0
then (HELP "gone to zero")))
ss:duration←arraySize
sliceWidth←sliceSize/compression
sliceSize←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 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←sliceWidth*(nSlices←width/sliceWidth)
correctSize←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)
(CONSTANT 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 (ss:duration←(LRSH (GETFILEPTR file)
1))
(WINDOWPROP window 'SignalFile
(OPENSTREAM (CLOSEF file)
'INPUT))
(REDISPLAYW window])
(RecordToCoreFile
[LAMBDA (ss window xferSize sliceWidth sliceSize compression correctSize array file)
(* edited: "17-Jun-85 16:01")
(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 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.FASTUPDATEADDR SSDMAChannel currentAddress wrapped)
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 (PCBUS.READARRAY array 32768+lastBufEnd (-lastBufEnd)
'SWAP
0)
(PCBUS.READARRAY array 0 nextBufEnd 'SWAP
(-lastBufEnd))
else (PCBUS.READARRAY 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)
(* edited: "17-Jun-85 16:02")
(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 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.FASTUPDATEADDR SSDMAChannel currentAddress wrapped)
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 (PCBUS.READARRAY array 32768+lastBufEnd (-lastBufEnd)
'SWAP
0)
(PCBUS.READARRAY array 0 nextBufEnd 'SWAP
(-lastBufEnd))
else (PCBUS.READARRAY 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)
(* edited: "17-Jun-85 16:02")
(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 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.FASTUPDATEADDR SSDMAChannel currentAddress wrapped)
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 (PCBUS.READARRAY array 32768+lastBufEnd (-lastBufEnd)
'SWAP
0)
(PCBUS.READARRAY array 0 nextBufEnd 'SWAP
(-lastBufEnd))
else (PCBUS.READARRAY 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: " 2-Jul-85 11:21")
(if ss:duration gt 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))
(AWIN str (OR (ARRAYP \SSDataArray)
\SSDataArray←(ARRAY 32768 'WORD
NIL 0 128))
ss:duration NIL (AspectProperty ss (WINDOWPROP window 'DisplayedAspect)
'SampleFormat)
(IDIFFERENCE (AspectProperty ss (WINDOWPROP window 'DisplayedAspect)
'SampleOffset)
2048))
(PLAY.IT \SSDataArray 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: "22-Apr-85 10:33")
(FQUOTIENT 1000.0 (SELECTQ device
((NIL CORE)
\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 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)
(* edited: "17-Jun-85 16:12")
(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 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")
(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: "25-Jun-85 14:12")
(let ((n (DSLPromptRead w "Aspect: " 1 75)))
(if n
then (push ss:aspects (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 (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 ss:offset 1)
(LLSH ss:offset 1)+(LLSH ss:duration 1))
(printout T (CLOSEF out])
(ClipSubSeg
[LAMBDA (ss w) (* ht: "14-May-85 12:16")
(let ((mark (GrabMark w ss)))
(if mark
then (ClipSeg mark:pSS w])
(DescribeAspect
[LAMBDA (aspect ss w) (* ht: "15-May-85 11:20")
(WINDOWPROP [INSPECT/ALIST (GetAspect aspect ss)
(create POSITION
XCOORD ←[(fetch LEFT of (WINDOWPROP w 'REGION))+(fetch WIDTH
of
(WINDOWPROP
w
'REGION]
YCOORD ←(fetch BOTTOM of (WINDOWPROP w 'REGION]
'TITLE
(CONCAT ss:fullName " " aspect " aspect"])
(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: "25-Jun-85 14:12")
(* * Add/set a property of the displayed aspec)
(let ((aspect (WINDOWPROP w 'DisplayedAspect))
(nl 2)
pn pv)
(if (NOT aspect)
then (aspect←(DSLPromptRead w "For aspect: " 3 150))
(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: "25-Jun-85 14:45")
(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 [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: "23-May-85 15:35")
(* * 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)
y←(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 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)
finally (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]
else (CURSOR T)
(until (MOUSESTATE UP) do (BLOCK))
(\MarkOprInProgress←NIL)
(MenuChooseMark ss w])
(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: " 1-Jul-85 11:25")
(if (GETHASH ss:fullName SSDir)
then (PUTHASH ss:fullName NIL SSDir))
(for f in SignalFiles when (GETHASHFILE ss:fullName f) do (PUTHASHFILE ss:fullName NIL f))
(* * 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: "23-May-85 22:17")
(* * 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 \MarkOprInProgess T)
(ALLOW.BUTTON.EVENTS)
pos←(IQUOTIENT (IPLUS mark:pPtr compr -1)
compr)
(APPLY* posFn file (ITIMES pos compr))
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)
(reg←(DSPCLIPPINGREGION NIL w))
(left←reg:LEFT)
(right←(IPLUS left reg:WIDTH -1))
[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)
value←(APPLY* getFn file format offset)))
(BLOCK))
(if (INSIDEP (DSPCLIPPINGREGION NIL str)
(CURSORPOSITION NIL str))
then (mark:pPtr←(ITIMES pos compr))
else (ShowMark ss pos base height mark NIL del w (ITIMES pos compr)
value)
(APPLY* posFn file mark:pPtr)
(ShowMark ss (IQUOTIENT (IPLUS mark:pPtr compr -1)
compr)
base height mark NIL del w NIL
(APPLY* getFn file format offset]
(if ss:points=NIL
then (ss:points←(LIST NIL)))
(InsertMark ss:points 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]
(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: "25-Jun-85 14:12")
(let ((name (DSLPromptRead 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: "23-May-85 10:51")
(* * Jump the window to show a named mark)
(let ((mark (MenuChooseMark ss w))
compr)
(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: "23-May-85 12:08")
(if mark
then (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: "23-May-85 12:21")
(* * 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 ss:points=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 \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)))
(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 \MarkOprInProgress)
)
[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))
(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"))
(SETQ BackgroundMenu NIL)
(DEFPRINT 'SignalSegment
'PrintSignalSegment)
(SETSYNTAX '#
'(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)
PCDAC MOVEDATA)
(PUTPROPS SETFILEPTR-IN-CREATEHASHFILE READVICE [(CREATEHASHFILE . SETFILEPTR)
(BEFORE NIL (for i from (GETFILEPTR FILE)
to ADR do (BOUT FILE 0])
(PUTPROPS TOTOPW-IN-TOPATTACHEDWINDOWS READVICE [(TOPATTACHEDWINDOWS . TOTOPW)
(BEFORE NIL (COND ((NOT (OPENWP WINDOW))
(RETURN])
(READVISE SETFILEPTR-IN-CREATEHASHFILE TOTOPW-IN-TOPATTACHEDWINDOWS)
(PUTPROPS AspectProperty ARGNAMES (NIL (segment aspect propertyName {propertyValue}) . N))
(DECLARE: DOEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(CLISPDEC '(MIXED))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(FILESLOAD (SYSLOAD)
PCDAC NOBOX MOVEDATA)
)
(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 (5319 14665 (DSL 5329 . 5592) (ChooseMarkSelectFn 5594 . 5814) (MenuChooseMark 5816 .
6222) (MakeAndShowSS 6224 . 7736) (DSLControlWindowButtonFn 7738 . 8163) (MakeDSLControlW 8165 . 9025)
(MakeSSForFile 9027 . 9998) (PrintSSName 10000 . 10206) (SSDir 10208 . 10468) (FindAndShowSS 10470 .
10811) (GetSS 10813 . 11986) (\FindSSDir 11988 . 12322) (UpdateDir 12324 . 12525) (SFNames 12527 .
12745) (CloseDir 12747 . 12982) (SSOneDir 12984 . 13168) (NoticeDir 13170 . 13397) (CreateDir 13399 .
13806) (SSDir1 13808 . 14418) (DTYPE 14420 . 14663)) (17708 39251 (CloseSignalFile 17718 . 18207) (
CloseSignalWindow 18209 . 18599) (CompressionButtonFn 18601 . 19394) (NewCompression 19396 . 19769) (
PositionSignalWindow 19771 . 20578) (NewShow 20580 . 22732) (MakePrompt 22734 . 23440) (LinkShow 23442
. 23649) (\ComputeZoomOffset 23651 . 23801) (ZoomWindow 23803 . 24178) (\MakeLinkedWindow 24180 .
25610) (UnlinkWindow 25612 . 25923) (ClearSignalWindow 25925 . 26105) (RepaintSingleValuedAspect 26107
. 26418) (RepaintSingleValuedAspect/File 26420 . 29067) (RedisplayMarks 29069 . 30257) (
ReshapeSignalWindow 30259 . 30926) (\UpdateLinks 30928 . 31663) (\UpdateLinkedWindows 31665 . 32895) (
\ChangeLinkedOffset 32897 . 33544) (UpdateSignalCompression 33546 . 34075) (UpdateSignalOrigin 34077
. 34522) (TrueLeftMargin 34524 . 34745) (ScrollSignalWindow 34747 . 34963) (SetupSignalFile 34965 .
35962) (UpdateScaleFactor 35964 . 36560) (RedisplayScale 36562 . 37492) (ReshapeScaleWindow 37494 .
37791) (CarefulSFP 37793 . 38025) (SecPrint 38027 . 38368) (ShowMark 38370 . 39249)) (39289 46066 (
PrintSignalSegment 39299 . 39515) (SSFullName 39517 . 40048) (FindSS 40050 . 41300) (PromptForSSFile
41302 . 41799) (SSFile 41801 . 42590) (CleanupSSFiles 42592 . 42885) (SaveSS 42887 . 44072) (SSRead
44074 . 44524) (SSFromFile 44526 . 45497) (SSFileForm 45499 . 45828) (SSNewName 45830 . 46064)) (46131
49036 (RepaintSingleValuedAspect/Array 46141 . 47276) (\RepaintSignalSliceFromArray 47278 . 49034)) (
49435 68041 (RecordSegment 49445 . 55079) (RecordToCoreFile 55081 . 57912) (RecordToDisplayOnly 57914
. 60668) (RecordToDskFile 60670 . 64233) (PlaySeg 64235 . 64522) (PlayFileSeg 64524 . 65534) (
PlayArraySeg 65536 . 65858) (MaxSampleRate 65860 . 66287) (SkipSize 66289 . 67170) (PlaySubSS 67172 .
67371) (PLAY.IT 67373 . 68039)) (72539 79424 (AddAspect 72549 . 72773) (ChooseAspect 72775 . 72972) (
ClipSeg 72974 . 73927) (ClipSubSeg 73929 . 74129) (DescribeAspect 74131 . 74647) (TrueSS 74649 . 75043
) (InheritAspect 75045 . 75649) (SpawnShow 75651 . 75849) (AddProperty 75851 . 76432) (DSLPromptRead
76434 . 77439) (ButtonSignalWindow 77441 . 78043) (SetAspect 78045 . 78587) (CopyCoreFileToDsk 78589
. 79422)) (79498 81440 (GetAspect 79508 . 79761) (AspectProperty 79763 . 80274) (UndisplayAspect
80276 . 80589) (\PutAspectProperty 80591 . 81191) (\GetAspectProperty 81193 . 81438)) (81471 92892 (
NearMark 81481 . 81762) (InvertMark 81764 . 82107) (GrabMark 82109 . 83910) (ChooseMark 83912 . 84315)
(DeleteMark 84317 . 84739) (ScrubSS 84741 . 85310) (InsertMark 85312 . 85640) (\MoveMark1 85642 .
88465) (NewMark 88467 . 88922) (NewSS 88924 . 89331) (AddSS 89333 . 89810) (JumpTo 89812 . 90320) (
ToggleMarks 90322 . 91051) (\DeleteMark1 91053 . 91267) (\RedisplayMark 91269 . 91678) (MoveMark 91680
. 92890)) (96662 97714 (MakeFake 96672 . 97532) (SinPoint 97534 . 97712)))))
STOP