Smalltalk › Squeak › Squeak - Dev

[squeak-dev] The Trunk: MorphicExtras-AdditionalSupport-edc.1.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

[squeak-dev] The Trunk: MorphicExtras-AdditionalSupport-edc.1.mcz

Edgar J. De Cleene uploaded a new version of MorphicExtras-AdditionalSupport to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-AdditionalSupport-edc.1.mcz

==================== Summary ====================

Name: MorphicExtras-AdditionalSupport-edc.1
Author: edc
Time: 1 September 2009, 11:51:09 am
UUID: 8ee10d83-a6ec-4745-b351-d4536350953e
Ancestors:

==================== Snapshot ====================

SystemOrganization addCategory: #'MorphicExtras-AdditionalSupport'!

HandMorph subclass: #HandMorphForReplay
instanceVariableNames: 'recorder'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicExtras-AdditionalSupport'!

!HandMorphForReplay commentStamp: '<historical>' prior: 0!
I am a hand for replaying events stored in an EventRecorderMorph. When there are no more events, I delete myself.!

----- Method: HandMorphForReplay>>initialize (in category 'initialization') -----
initialize
super initialize.
self showTemporaryCursor: Cursor normal.
!

----- Method: HandMorphForReplay>>needsToBeDrawn (in category 'drawing') -----
needsToBeDrawn

^true!

----- Method: HandMorphForReplay>>pauseEventRecorderIn: (in category 'event handling') -----
pauseEventRecorderIn: aWorld
"Suspend my recorder prior to a project change, and return it.
It will be resumed after starting the new project."

^ recorder pauseIn: aWorld!

----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
processEvents
"Play back the next event"

| evt hadMouse hadAny |
hadMouse := hadAny := false.
[(evt := recorder nextEventToPlay) isNil] whileFalse:
[evt type == #EOF
ifTrue:
[recorder pauseIn: self world.
^self].
evt type == #startSound
ifTrue:
[evt argument play.
recorder synchronize.
^self].
evt isMouse ifTrue: [hadMouse := true].
(evt isMouse or: [evt isKeyboard])
ifTrue:
[self handleEvent: (evt setHand: self) resetHandlerFields.
hadAny := true]].
(mouseClickState notNil and: [hadMouse not])
ifTrue:
["No mouse events during this cycle. Make sure click states time out accordingly"

mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
hadAny
ifFalse:
["No pending events. Make sure z-order is up to date"

self mouseOverHandler processMouseOver: lastMouseEvent]!

----- Method: HandMorphForReplay>>recorder: (in category 'initialization') -----
recorder: anEventRecorder
recorder := anEventRecorder!

----- Method: HandMorphForReplay>>showTemporaryCursor:hotSpotOffset: (in category 'cursor') -----
showTemporaryCursor: cursorOrNil hotSpotOffset: hotSpotOffset
"When I show my cursor, it appears double size,
unless it is a form such as a paint brush."

cursorOrNil
ifNil: ["Setting cursor to nil cannot revert to hardware cursor -- just show normal."
^ self showTemporaryCursor: Cursor normal hotSpotOffset: Cursor normal offset]
ifNotNil:
[(cursorOrNil isKindOf: Cursor)
ifTrue: ["Show cursors magnified for visibility"
^ super showTemporaryCursor:
(CursorWithMask derivedFrom: (cursorOrNil magnifyBy: 2))
hotSpotOffset: (cursorOrNil offset negated*2) + hotSpotOffset]
ifFalse: [^ super showTemporaryCursor: cursorOrNil
hotSpotOffset: hotSpotOffset]]!

----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
^ self copy!

HandMorph subclass: #RemoteHandMorph
instanceVariableNames: 'remoteWorldExtent remoteAddress sendSocket sendBuffer sendState socket waitingForConnection receiveBuffer'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicExtras-AdditionalSupport'!

----- Method: RemoteHandMorph class>>ensureNetworkConnected (in category 'utilities') -----
ensureNetworkConnected
"Try to ensure that an intermittent network connection, such as a dialup or ISDN line, is actually connected. This is necessary to make sure a server is visible in order to accept an incoming connection."
"RemoteHandMorph ensureNetworkConnected"

Utilities
informUser: 'Contacting domain name server...'
during: [
NetNameResolver
addressForName: 'squeak.org'
timeout: 30].
!

----- Method: RemoteHandMorph>>appendNewDataToReceiveBuffer (in category 'private') -----
appendNewDataToReceiveBuffer
"Append all available raw data to my receive buffer. Assume that my socket is not nil."

| newData tempBuf bytesRead |
socket dataAvailable ifTrue: [
"get all the data currently available"
newData := WriteStream on: (String new: receiveBuffer size + 1000).
newData nextPutAll: receiveBuffer.
tempBuf := String new: 1000.
[socket dataAvailable] whileTrue: [
bytesRead := socket receiveDataInto: tempBuf.
1 to: bytesRead do: [:i | newData nextPut: (tempBuf at: i)]].
receiveBuffer := newData contents].
!

----- Method: RemoteHandMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
"For remote cursors, always draw the hand itself (i.e., the cursor)."

super drawOn: aCanvas.
aCanvas paintImage: NormalCursor at: self position.
!

----- Method: RemoteHandMorph>>getNextRemoteEvent (in category 'private') -----
getNextRemoteEvent
"Return the next remote event, or nil if the receive buffer does not contain a full event record. An event record is the storeString for a MorphicEvent terminated by a <CR> character."

| i s evt |
self receiveData.
receiveBuffer isEmpty ifTrue: [^ nil].

i := receiveBuffer indexOf: Character cr ifAbsent: [^ nil].
s := receiveBuffer copyFrom: 1 to: i - 1.
receiveBuffer := receiveBuffer copyFrom: i + 1 to: receiveBuffer size.
evt := (MorphicEvent readFromString: s).
evt ifNil:[^nil].
evt setHand: self.
evt isKeyboard ifTrue:[evt setPosition: self position].
^evt resetHandlerFields!

----- Method: RemoteHandMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Transmit the event to interested listeners"
| currentExtent |
currentExtent := self worldBounds extent.
self lastWorldExtent ~= currentExtent ifTrue: [
self transmitEvent: (MorphicUnknownEvent new setType: #worldExtent argument: currentExtent).
self lastWorldExtent: currentExtent].
self transmitEvent: anEvent.!

----- Method: RemoteHandMorph>>initialize (in category 'initialization') -----
initialize

super initialize.
remoteWorldExtent := 100@100. "initial guess"
socket := nil.
waitingForConnection := false.
receiveBuffer := ''.
sendState := #unconnected.!

----- Method: RemoteHandMorph>>lastEventTransmitted (in category 'connections') -----
lastEventTransmitted
^self valueOfProperty: #lastEventTransmitted!

----- Method: RemoteHandMorph>>lastEventTransmitted: (in category 'connections') -----
lastEventTransmitted: anEvent
^self setProperty: #lastEventTransmitted toValue: anEvent!

----- Method: RemoteHandMorph>>lastWorldExtent (in category 'connections') -----
lastWorldExtent
^self valueOfProperty: #lastWorldExtent!

----- Method: RemoteHandMorph>>lastWorldExtent: (in category 'connections') -----
lastWorldExtent: extent
^self setProperty: #lastWorldExtent toValue: extent!

----- Method: RemoteHandMorph>>needsToBeDrawn (in category 'drawing') -----
needsToBeDrawn

^true!

----- Method: RemoteHandMorph>>processEvents (in category 'event handling') -----
processEvents
"Process user input events from the remote input devices."

| evt |
evt := self getNextRemoteEvent.
[evt notNil] whileTrue:
[evt type == #worldExtent
ifTrue:
[remoteWorldExtent := evt argument.
^self].
self handleEvent: evt.
evt := self getNextRemoteEvent]!

----- Method: RemoteHandMorph>>readyToTransmit (in category 'connections') -----
readyToTransmit
"Return true if the receiver is ready to send."

(sendState == #connected) ifTrue:[
sendSocket sendDone ifFalse:[^false].
^true].

sendState == #opening ifTrue:[
sendSocket isConnected ifTrue:[^true].
sendSocket isWaitingForConnection ifFalse:[
Transcript show: 'trying connection again...'; cr.
sendSocket destroy.
sendSocket := Socket new.
sendSocket connectTo: self remoteHostAddress port: 54323]].

sendState == #closing ifTrue:[
sendSocket isUnconnectedOrInvalid ifTrue:[
sendSocket destroy.
sendState := #unconnected]].

^false!

----- Method: RemoteHandMorph>>receiveData (in category 'private') -----
receiveData
"Check my connection status and withdraw from the world if the connection has been broken. Append any data that has arrived to receiveBuffer. "

socket ifNotNil: [
socket isConnected
ifTrue: [ "connected"
waitingForConnection ifTrue: [
Transcript show: 'Remote hand ', userInitials, ' connected'; cr.
waitingForConnection := false].
self appendNewDataToReceiveBuffer]
ifFalse: [ "not connected"
waitingForConnection ifFalse: [
"connection was established, then broken"
self withdrawFromWorld.
receiveBuffer := '']]].
!

----- Method: RemoteHandMorph>>remoteHostAddress (in category 'connections') -----
remoteHostAddress
"Return the address of the remote host or zero if not connected."
^remoteAddress ifNil:[0]!

----- Method: RemoteHandMorph>>startListening (in category 'connections') -----
startListening
"Create a socket and start listening for a connection."

self stopListening.
Transcript show: 'My address is ', NetNameResolver localAddressString; cr.
Transcript show: 'Remote hand ', self userInitials, ' waiting for a connection...'; cr.
socket := Socket new.
socket listenOn: 54323.
waitingForConnection := true.
!

----- Method: RemoteHandMorph>>startTransmittingEvents (in category 'connections') -----
startTransmittingEvents
"Attempt to broadcast events from this hand to a remote hand on the host with the given address. This method just creates the new socket and initiates a connection; it does not wait for the other end to answer."
(sendSocket notNil and:[sendSocket isConnected]) ifTrue:[^self].
Transcript
show: 'Connecting to remote WorldMorph at ';
show: (NetNameResolver stringFromAddress: self remoteHostAddress), ' ...'; cr.
sendSocket := OldSimpleClientSocket new.
sendSocket connectTo: self remoteHostAddress port: 54323.
sendState := #opening.
owner primaryHand addEventListener: self.!

----- Method: RemoteHandMorph>>startTransmittingEventsTo: (in category 'connections') -----
startTransmittingEventsTo: remoteAddr
"Attempt to broadcast events from this hand to a remote hand on the host with the given address. This method just creates the new socket and initiates a connection; it does not wait for the other end to answer."
remoteAddress := remoteAddr.
(sendSocket notNil and:[sendSocket isConnected]) ifTrue:[^self].
Transcript
show: 'Connecting to remote WorldMorph at ';
show: (NetNameResolver stringFromAddress: self remoteHostAddress), ' ...'; cr.
sendSocket := OldSimpleClientSocket new.
sendSocket connectTo: self remoteHostAddress port: 54323.
sendState := #opening.
owner primaryHand addEventListener: self.!

----- Method: RemoteHandMorph>>stopListening (in category 'connections') -----
stopListening
"Destroy the socket, if any, terminating the connection."

socket ifNotNil: [
socket destroy.
socket := nil].
!

----- Method: RemoteHandMorph>>stopTransmittingEvents (in category 'connections') -----
stopTransmittingEvents
"Stop broadcasting events from this world's cursor to a remote cursor on the host with the given address. This method issues a 'close' but does not destroy the socket; it will be destroyed when the other end reads the last data and closes the connection."
(sendSocket isUnconnectedOrInvalid) ifFalse:[
sendSocket close.
sendState := #closing].
owner primaryHand removeEventListener: self.!

----- Method: RemoteHandMorph>>transmitEvent: (in category 'event handling') -----
transmitEvent: aMorphicEvent
"Transmit the given event to all remote connections."
| firstEvt |
self readyToTransmit ifFalse: [^ self].
self lastEventTransmitted = aMorphicEvent ifTrue: [^ self].
sendBuffer ifNil: [sendBuffer _ WriteStream on: (String new: 10000)].
sendBuffer nextPutAll: aMorphicEvent storeString; cr.
self lastEventTransmitted: aMorphicEvent.

sendSocket isConnected ifTrue:[
sendState = #opening ifTrue: [
"connection established; disable TCP delays on sends"
sendSocket setOption: 'TCP_NODELAY' value: true.
"send worldExtent as first event"
firstEvt _ MorphicUnknownEvent type: #worldBounds argument: self worldBounds extent.
sendSocket sendData: firstEvt storeString, (String with: Character cr).
Transcript
show: 'Connection established with remote WorldMorph at ';
show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr.
sendState _ #connected].
sendSocket sendData: sendBuffer contents.
] ifFalse: [
owner primaryHand removeEventListener: self.
sendState = #connected ifTrue: [
"other end has closed; close our end"
Transcript
show: 'Closing connection with remote WorldMorph at ';
show: (NetNameResolver stringFromAddress: sendSocket remoteAddress); cr.
sendSocket close.
sendState _ #closing]].

sendBuffer reset.
!

----- Method: RemoteHandMorph>>withdrawFromWorld (in category 'other') -----
withdrawFromWorld
"Close the socket, if any, and remove this hand from the world."
| addr |
addr := self remoteHostAddress.
addr = 0 ifFalse: [self stopTransmittingEvents].
self stopListening.
Transcript show: 'Remote hand ', self userInitials, ' closed'; cr.
owner ifNotNil: [owner removeHand: self].
!

----- Method: RemoteHandMorph>>worldBounds (in category 'geometry') -----
worldBounds

^ 0@0 extent: remoteWorldExtent
!

TransformationMorph subclass: #BOBTransformationMorph
instanceVariableNames: 'worldBoundsToShow useRegularWarpBlt'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicExtras-AdditionalSupport'!

----- Method: BOBTransformationMorph>>adjustAfter: (in category 'private') -----
adjustAfter: changeBlock
"Cause this morph to remain cetered where it was before, and
choose appropriate smoothing, after a change of scale or rotation."
| |

"oldRefPos := self referencePosition."
changeBlock value.
self chooseSmoothing.
"self penUpWhile: [self position: self position + (oldRefPos - self referencePosition)]."
self layoutChanged.
owner ifNotNil: [owner invalidRect: bounds]
!

----- Method: BOBTransformationMorph>>changeWorldBoundsToShow: (in category 'as yet unclassified') -----
changeWorldBoundsToShow: aRectangle

aRectangle area = 0 ifTrue: [^self].
worldBoundsToShow := aRectangle.
owner myWorldChanged.!

----- Method: BOBTransformationMorph>>drawSubmorphsOn: (in category 'drawing') -----
drawSubmorphsOn: aCanvas

| t |
t := [
self drawSubmorphsOnREAL: aCanvas
] timeToRun.
"Q1 at: 3 put: t."
!

----- Method: BOBTransformationMorph>>drawSubmorphsOnREAL: (in category 'as yet unclassified') -----
drawSubmorphsOnREAL: aCanvas

| newClip |

(self innerBounds intersects: aCanvas clipRect) ifFalse: [^self].
newClip := ((self innerBounds intersect: aCanvas clipRect) expandBy: 1) truncated.
useRegularWarpBlt == true ifTrue: [
transform scale asFloat = 1.0 ifFalse: [
newClip := self innerBounds. "avoids gribblies"
].
^aCanvas
transformBy: transform
clippingTo: newClip
during: [:myCanvas |
submorphs reverseDo:[:m | myCanvas fullDrawMorph: m]
]
smoothing: smoothing
].
aCanvas
transform2By: transform "#transformBy: for pure WarpBlt"
clippingTo: newClip
during: [:myCanvas |
submorphs reverseDo:[:m | myCanvas fullDrawMorph: m]
]
smoothing: smoothing
!

----- Method: BOBTransformationMorph>>extent: (in category 'geometry') -----
extent: aPoint

| newExtent |

newExtent := aPoint truncated.
bounds extent = newExtent ifTrue: [^self].
bounds := bounds topLeft extent: newExtent.
self recomputeExtent.

!

----- Method: BOBTransformationMorph>>extentFromParent: (in category 'as yet unclassified') -----
extentFromParent: aPoint

| newExtent |

submorphs isEmpty ifTrue: [^self extent: aPoint].
newExtent := aPoint truncated.
bounds := bounds topLeft extent: newExtent.
newExtent := self recomputeExtent.
newExtent ifNil: [^self].
bounds := bounds topLeft extent: newExtent.

!

----- Method: BOBTransformationMorph>>layoutChanged (in category 'layout') -----
layoutChanged
"use the version from Morph"

| myGuy |
fullBounds := nil.
owner ifNotNil: [owner layoutChanged].
submorphs notEmpty
ifTrue:
[(myGuy := self firstSubmorph) isWorldMorph
ifFalse:
[worldBoundsToShow = myGuy bounds
ifFalse: [self changeWorldBoundsToShow: (worldBoundsToShow := myGuy bounds)]]

"submorphs do: [:m | m ownerChanged]" "<< I don't see any reason for this"]!

----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') -----
recomputeExtent

| scalePt newScale theGreenThingie greenIBE myNewExtent |

submorphs isEmpty ifTrue: [^self extent].
worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds].
worldBoundsToShow area = 0 ifTrue: [^self extent].
scalePt := owner innerBounds extent / worldBoundsToShow extent.
newScale := scalePt x min: scalePt y.
theGreenThingie := owner.
greenIBE := theGreenThingie innerBounds extent.
myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated.
self
scale: newScale;
offset: worldBoundsToShow origin * newScale.
smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1].
^myNewExtent!

----- Method: BOBTransformationMorph>>useRegularWarpBlt: (in category 'as yet unclassified') -----
useRegularWarpBlt: aBoolean

useRegularWarpBlt := aBoolean!

AlignmentMorph subclass: #AlignmentMorphBob1
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicExtras-AdditionalSupport'!

!AlignmentMorphBob1 commentStamp: 'sm 8/12/2009 22:34' prior: 0!
A quick and easy way to space things vertically in absolute or proportional amounts.!

----- Method: AlignmentMorphBob1>>acceptDroppingMorph:event: (in category 'as yet unclassified') -----
acceptDroppingMorph: aMorph event: evt

| handlerForDrops |

handlerForDrops := self valueOfProperty: #handlerForDrops ifAbsent: [
^super acceptDroppingMorph: aMorph event: evt
].
(handlerForDrops acceptDroppingMorph: aMorph event: evt in: self) ifFalse: [
aMorph rejectDropMorphEvent: evt. "send it back where it came from"
].!

----- Method: AlignmentMorphBob1>>addAColumn: (in category 'as yet unclassified') -----
addAColumn: aCollectionOfMorphs

| col |
col := self inAColumn: aCollectionOfMorphs.
self addMorphBack: col.
^col!

----- Method: AlignmentMorphBob1>>addARow: (in category 'as yet unclassified') -----
addARow: aCollectionOfMorphs

| row |
row := self inARow: aCollectionOfMorphs.
self addMorphBack: row.
^row!

----- Method: AlignmentMorphBob1>>addARowCentered: (in category 'as yet unclassified') -----
addARowCentered: aCollectionOfMorphs

^(self addARow: aCollectionOfMorphs)
hResizing: #shrinkWrap;
wrapCentering: #center;
cellPositioning: #leftCenter!

----- Method: AlignmentMorphBob1>>addARowCentered:cellInset: (in category 'as yet unclassified') -----
addARowCentered: aCollectionOfMorphs cellInset: cellInsetInteger

^(self addARow: aCollectionOfMorphs)
hResizing: #shrinkWrap;
wrapCentering: #center;
cellPositioning: #leftCenter;
cellInset: cellInsetInteger!

----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') -----
fancyText: aString font: aFont color: aColor
| answer tm col |
col := ColorTheme current dialog3DTitles
ifTrue: [aColor]
ifFalse: [aColor negated].
tm := TextMorph new.
tm beAllFont: aFont;
color: col;
contents: aString.
answer := self inAColumn: {tm}.
ColorTheme current dialog3DTitles
ifTrue: [""
tm addDropShadow.
tm shadowPoint: 5 @ 5 + tm bounds center].
tm lock.
^ answer!

----- Method: AlignmentMorphBob1>>fullDrawOn: (in category 'as yet unclassified') -----
fullDrawOn: aCanvas

| mask |
(aCanvas isVisible: self fullBounds) ifFalse:[^self].
super fullDrawOn: aCanvas.
mask := self valueOfProperty: #disabledMaskColor ifAbsent: [^self].
aCanvas fillRectangle: bounds color: mask.
!

----- Method: AlignmentMorphBob1>>inAColumn: (in category 'as yet unclassified') -----
inAColumn: aCollectionOfMorphs

| col |
col := AlignmentMorph newColumn
color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 1;
wrapCentering: #center;
cellPositioning: #topCenter.
aCollectionOfMorphs do: [ :each | col addMorphBack: each].
^col!

----- Method: AlignmentMorphBob1>>inARightColumn: (in category 'as yet unclassified') -----
inARightColumn: aCollectionOfMorphs
| col |
col := AlignmentMorph newColumn color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 1;
wrapCentering: #bottomRight;
cellPositioning: #topCenter.
aCollectionOfMorphs
do: [:each | col addMorphBack: each].
^ col!

----- Method: AlignmentMorphBob1>>inARow: (in category 'as yet unclassified') -----
inARow: aCollectionOfMorphs
| row |
row := AlignmentMorph newRow color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 2;
wrapCentering: #center;
cellPositioning: #leftCenter.
aCollectionOfMorphs
do: [:each | row addMorphBack: each].
^ row!

----- Method: AlignmentMorphBob1>>initialize (in category 'initialization') -----
initialize
super initialize.
self listDirection: #topToBottom.
self layoutInset: 0.
self hResizing: #rigid. "... this is very unlikely..."
self vResizing: #rigid!

----- Method: AlignmentMorphBob1>>simpleToggleButtonFor:attribute:help: (in category 'as yet unclassified') -----
simpleToggleButtonFor: target attribute: attribute help: helpText

^(EtoyUpdatingThreePhaseButtonMorph checkBox)
target: target;
actionSelector: #toggleChoice:;
arguments: {attribute};
getSelector: #getChoice:;
setBalloonText: helpText;
step

!

----- Method: AlignmentMorphBob1>>wantsDroppedMorph:event: (in category 'as yet unclassified') -----
wantsDroppedMorph: aMorph event: evt

| handlerForDrops |

handlerForDrops := self valueOfProperty: #handlerForDrops ifAbsent: [
^super wantsDroppedMorph: aMorph event: evt
].
^handlerForDrops wantsDroppedMorph: aMorph event: evt in: self!

AlignmentMorph subclass: #EmbeddedWorldBorderMorph
instanceVariableNames: 'heights minWidth minHeight'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicExtras-AdditionalSupport'!

----- Method: EmbeddedWorldBorderMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: menu hand: aHandMorph

super addCustomMenuItems: menu hand: aHandMorph.

self worldIEnclose
addScalingMenuItems: menu
hand: aHandMorph
!

----- Method: EmbeddedWorldBorderMorph>>appViewBoxArea (in category 'boxes') -----
appViewBoxArea

^self genericBoxArea: 1
!

----- Method: EmbeddedWorldBorderMorph>>boxesAndColorsAndSelectors (in category 'boxes') -----
boxesAndColorsAndSelectors

^{
{self zoomBoxArea. Color blue. #toggleZoom}.
{self appViewBoxArea. Color yellow. #goAppView}.
{self factoryViewBoxArea. Color red. #goFactoryView}.
{self fullViewBoxArea. Color cyan. #goFullView}.
{self normalEntryBoxArea. Color white. #goNormalProjectEntry}.
}!

----- Method: EmbeddedWorldBorderMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas

super drawOn: aCanvas.
self boxesAndColorsAndSelectors do: [ :each |
aCanvas fillRectangle: each first fillStyle: each second
].

!

----- Method: EmbeddedWorldBorderMorph>>extent: (in category 'geometry') -----
extent: aPoint

bounds extent = aPoint ifFalse: [
self changed.
bounds := bounds topLeft extent: aPoint.
self myWorldChanged.
].
!

----- Method: EmbeddedWorldBorderMorph>>factoryViewBoxArea (in category 'boxes') -----
factoryViewBoxArea

^self genericBoxArea: 2
!

----- Method: EmbeddedWorldBorderMorph>>fullViewBoxArea (in category 'boxes') -----
fullViewBoxArea

^self genericBoxArea: 3
!

----- Method: EmbeddedWorldBorderMorph>>genericBoxArea: (in category 'boxes') -----
genericBoxArea: countDownFromTop

^self innerBounds right @ (self top + (countDownFromTop * 2 * borderWidth))
extent: borderWidth @ borderWidth
!

----- Method: EmbeddedWorldBorderMorph>>goAppView (in category 'as yet unclassified') -----
goAppView

self worldIEnclose showApplicationView

!

----- Method: EmbeddedWorldBorderMorph>>goFactoryView (in category 'as yet unclassified') -----
goFactoryView

self worldIEnclose showFactoryView

!

----- Method: EmbeddedWorldBorderMorph>>goFullView (in category 'as yet unclassified') -----
goFullView

self worldIEnclose showFullView

!

----- Method: EmbeddedWorldBorderMorph>>goNormalProjectEntry (in category 'as yet unclassified') -----
goNormalProjectEntry

| w |
w := self worldIEnclose.
self delete.
w project enter.

!

----- Method: EmbeddedWorldBorderMorph>>handlesMouseDown: (in category 'event handling') -----
handlesMouseDown: evt

self boxesAndColorsAndSelectors do: [ :each |
(each first containsPoint: evt cursorPoint) ifTrue: [^true]
].
^false

!

----- Method: EmbeddedWorldBorderMorph>>initialize (in category 'initialization') -----
initialize

super initialize.
self setBalloonText: 'This is the frame of an embedded project. Click on the colored boxes:
blue - expand or reduce
yellow - app view
red - factory view
cyan - full view
white - enter the project completely' translated!

----- Method: EmbeddedWorldBorderMorph>>minHeight: (in category 'layout') -----
minHeight: anInteger

minHeight := anInteger!

----- Method: EmbeddedWorldBorderMorph>>minWidth: (in category 'layout') -----
minWidth: anInteger

minWidth := anInteger!

----- Method: EmbeddedWorldBorderMorph>>morphicLayerNumber (in category 'WiW support') -----
morphicLayerNumber

"helpful for insuring some morphs always appear in front of or behind others.
smaller numbers are in front"

^20 "Embedded worlds come in front of other worlds' Project navigation morphs"!

----- Method: EmbeddedWorldBorderMorph>>mouseDown: (in category 'event handling') -----
mouseDown: evt

self boxesAndColorsAndSelectors do: [ :each |
(each first containsPoint: evt cursorPoint) ifTrue: [
^self perform: each third
].
].

!

----- Method: EmbeddedWorldBorderMorph>>myTransformation (in category 'as yet unclassified') -----
myTransformation

^submorphs detect: [ :x | x isKindOf: TransformationMorph] ifNone: [nil]
!

----- Method: EmbeddedWorldBorderMorph>>myWorldChanged (in category 'as yet unclassified') -----
myWorldChanged
| trans |
trans := self myTransformation.
self changed.
self layoutChanged.
trans ifNotNil:[
trans extentFromParent: self innerBounds extent.
bounds := bounds topLeft extent: trans extent + (borderWidth * 2).
].
self changed.
!

----- Method: EmbeddedWorldBorderMorph>>normalEntryBoxArea (in category 'boxes') -----
normalEntryBoxArea

^self genericBoxArea: 4
!

----- Method: EmbeddedWorldBorderMorph>>toggleZoom (in category 'as yet unclassified') -----
toggleZoom

self bounds: (
bounds area > (Display boundingBox area * 0.9) ifTrue: [
Display extent // 4 extent: Display extent // 2.
] ifFalse: [
Display boundingBox
]
)

!

----- Method: EmbeddedWorldBorderMorph>>worldIEnclose (in category 'as yet unclassified') -----
worldIEnclose

^self myTransformation firstSubmorph
"quick hack since this is the only usage pattern at the moment"
!

----- Method: EmbeddedWorldBorderMorph>>zoomBoxArea (in category 'boxes') -----
zoomBoxArea

^self genericBoxArea: 0
!

AlignmentMorph subclass: #EventRecorderMorph
instanceVariableNames: 'tape state time deltaTime recHand playHand lastEvent lastDelta tapeStream saved statusLight voiceRecorder startSoundEvent recordMeter caption journalFile'
classVariableNames: ''
poolDictionaries: ''
category: 'MorphicExtras-AdditionalSupport'!

!EventRecorderMorph commentStamp: '<historical>' prior: 0!
During recording, the EventRecorder subscribes to all events of the normal morphic hand, and saves them as they occur.

For replay, a second playback hand is created that reads events from the recorder and plays them back in the world.

The EventRecorder began with the work of Ted Kaehler and John Malone. This was then signifcantly expanded by Leandro Caniglia and Valeria Murgia as a tutorial aid for the Morphic Wrapper project.

Since that time, I have...
Changed to a simple inboard array for the tape (event storage).
Provided the ability to condense linear mouse movement with interpolation at replay.
Made simple provisions for wrap-around of the millisecond clock.
Eliminated step methods in favor of using the processEvents cycle in the playback hand.
Provided a pause/resume mechanism that is capable of surviving project changes.
Added the ability to spawn a simple 'play me' button that can be saved as a morph.
Caused the playback hand to display its cursor double size for visibility.
Integrated a voice recorder with on-the-fly compression.
This currently does NOT survive project changes, not is its data stored on the tape.
Right now it can only be saved by saving the entire recorder as a morph.
This will be fixed by adding a startSound event at each project change.
We will also convert read/write file to use saveOnFile.
Added a journal file facility for recording sequences that end in a crash.
The above two features can be engaged via the ER's morph menu.
- Dan Ingalls 3/6/99!

----- Method: EventRecorderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description for use in a parts bin"

^ self partName: 'Event Recorder'
categories: #(Presentation Tools)
documentation: 'Lets you record and play back interactions'!

----- Method: EventRecorderMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
fileReaderServicesForFile: fullName suffix: suffix

^(suffix = 'tape') | (suffix = '*')
ifTrue: [ self services]
ifFalse: [#()]

!

----- Method: EventRecorderMorph class>>fromFileNamed: (in category 'instance creation') -----
fromFileNamed: aFileName
| file answer |
file := FileStream readOnlyFileNamed: aFileName.
answer := self readFrom: file setConverterForCode.
file close.
^ answer!

----- Method: EventRecorderMorph class>>initialize (in category 'class initialization') -----
initialize

FileList registerFileReader: self!

----- Method: EventRecorderMorph class>>openTapeFromFile: (in category 'instance creation') -----
openTapeFromFile: fullName
"Open an eventRecorder tape for playback."

(self new) readTape: fullName; openInWorld!

----- Method: EventRecorderMorph class>>readFrom: (in category 'instance creation') -----
readFrom: aStream
^ self new readFrom: aStream!

----- Method: EventRecorderMorph class>>services (in category 'fileIn/Out') -----
services

^{SimpleServiceEntry
provider: self
label: 'open for playback'
selector: #openTapeFromFile:.}
!

----- Method: EventRecorderMorph class>>unload (in category 'initialize-release') -----
unload

FileList unregisterFileReader: self !

----- Method: EventRecorderMorph>>addButtons (in category 'initialization') -----
addButtons
| r b |

caption ifNotNil: ["Special setup for play-only interface"
(r := self makeARowForButtons)
addMorphBack: (SimpleButtonMorph new target: self;
label: caption; actionSelector: #play);
addMorphBack: self makeASpacer;
addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer.
^ self addMorphBack: r
].

(r := self makeARowForButtons)
addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}).
self addMorphBack: r.

(r := self makeARowForButtons)
addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}).
self addMorphBack: r.

(r := self makeARowForButtons)
addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
addMorphBack: self makeASpacer;
addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#button. b width. 'Make a simple button to play this recording'}).
self addMorph: r.
self setStatusLight: #ready.!

----- Method: EventRecorderMorph>>addCustomMenuItems:hand: (in category 'initialization') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph

super addCustomMenuItems: aCustomMenu hand: aHandMorph.
aCustomMenu add: 'add voice controls' translated action: #addVoiceControls.
aCustomMenu add: 'add journal file' translated action: #addJournalFile.
!

----- Method: EventRecorderMorph>>addJournalFile (in category 'initialization') -----
addJournalFile
"In case there is a chance of not regaining control to stop recording and save a file, the EventRecorder can write directly to file as it is recording. This is useful for capturing a sequence that results in a nasty crash."

journalFile ifNotNil: [journalFile close].
journalFile := FileStream newFileNamed: 'EventRecorder.tape'.
journalFile nextPutAll:'Event Tape v1 ASCII'; cr.!

----- Method: EventRecorderMorph>>button (in category 'commands') -----
button
"Make a simple button interface for replay only"
| butnCaption erm |
butnCaption := UIManager default request: 'Caption for this butn?' translated initialAnswer: 'play' translated.
butnCaption isEmpty ifTrue: [^ self].
erm := (EventRecorderMorph basicNew
caption: butnCaption
voiceRecorder: voiceRecorder copy
tape: tape) initialize.
self world primaryHand attachMorph: erm!

----- Method: EventRecorderMorph>>button: (in category 'accessing') -----
button: label
^ self allMorphs
detect: [:one | (one isKindOf: SimpleButtonMorph)
and: [one label = label]]
ifNone: []!

----- Method: EventRecorderMorph>>buttonFor: (in category 'initialization') -----
buttonFor: data

| b |
b := SimpleButtonMorph new
target: self;
label: data first asString translated;
actionSelector: data first.
data second ifNotNil: [b width < data second ifTrue: [b width: data second]].
data third ifNotNil: [b setBalloonText: data third translated].
^b!

----- Method: EventRecorderMorph>>caption:voiceRecorder:tape: (in category 'initialization') -----
caption: butnCaption voiceRecorder: butnRecorder tape: butnTape
caption := butnCaption.
voiceRecorder := butnRecorder.
tape := butnTape!

----- Method: EventRecorderMorph>>checkTape (in category 'fileIn/Out') -----
checkTape
"See if this tape was already converted to the new format"

tape ifNil: [^self].
tape isEmpty ifTrue: [^self].
(tape first isKindOf: Association)
ifTrue: [tape := self convertV0Tape: tape]!

----- Method: EventRecorderMorph>>condense (in category 'commands') -----
condense
"Shorten the tape by deleting mouseMove events that can just as well be
interpolated later at playback time."

"e1, e2, and e3 are three consecutive events on the tape.
t1, t2, and t3 are the associated time steps for each of them."

| e1 e2 t1 t2 e3 t3 |
tape := Array streamContents:
[:tStream |
e1 := e2 := e3 := nil.
t1 := t2 := t3 := nil.
1 to: tape size
do:
[:i |
e1 := e2.
t1 := t2.
e2 := e3.
t2 := t3.
e3 := tape at: i.
t3 := e3 timeStamp.
((e1 notNil and:
[e2 type == #mouseMove
& (e1 type == #mouseMove or: [e3 type == #mouseMove])])
and:
["Middle point within 3 pixels of mean of outer two"

e2 position
onLineFrom: e1 position
to: e3 position
within: 2.5])
ifTrue:
["Delete middle mouse move event. Absorb its time into e3"

e2 := e1.
t2 := t1]
ifFalse: [e1 ifNotNil: [tStream nextPut: (e1 copy setTimeStamp: t1)]]].
e2 ifNotNil: [tStream nextPut: (e2 copy setTimeStamp: t2)].
e3 ifNotNil: [tStream nextPut: (e3 copy setTimeStamp: t3)]]!

----- Method: EventRecorderMorph>>convertV0Tape: (in category 'fileIn/Out') -----
convertV0Tape: anArray
"Convert the tape into the new format"
| lastKey evt |
lastKey := 0.
^anArray collect:[:assn|
evt := assn value.
evt setTimeStamp: (lastKey := lastKey + assn key).
evt]!

----- Method: EventRecorderMorph>>defaultBorderColor (in category 'initialization') -----
defaultBorderColor
"answer the default border color/fill style for the receiver"
^ #raised!

----- Method: EventRecorderMorph>>defaultBorderWidth (in category 'initialization') -----
defaultBorderWidth
"answer the default border width for the receiver"
^ 2!

----- Method: EventRecorderMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color red!

----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Record the given event"
(state == #record and:[anEvent hand == recHand])
ifFalse:[^self].
anEvent = lastEvent ifTrue: [^ self].
(anEvent isKeyboard and:[anEvent keyValue = 27 "esc"])
ifTrue: [^ self stop].
time := anEvent timeStamp.
tapeStream nextPut: (anEvent copy setHand: nil).
journalFile ifNotNil:
[journalFile store: anEvent; cr; flush].
lastEvent := anEvent.!

----- Method: EventRecorderMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
saved := true.
self listDirection: #topToBottom;
wrapCentering: #center;
cellPositioning: #topCenter;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 2;
minCellSize: 4;
addButtons!

----- Method: EventRecorderMorph>>makeARowForButtons (in category 'initialization') -----
makeARowForButtons

^AlignmentMorph newRow
vResizing: #shrinkWrap;
wrapCentering: #center;
cellPositioning: #leftCenter;
minCellSize: 4;
color: Color blue!

----- Method: EventRecorderMorph>>makeASpacer (in category 'initialization') -----
makeASpacer

^AlignmentMorph newSpacer: Color transparent!

----- Method: EventRecorderMorph>>makeStatusLight (in category 'initialization') -----
makeStatusLight

^statusLight := EllipseMorph new
extent: 11 @ 11;
color: Color green;
borderWidth: 0!

----- Method: EventRecorderMorph>>nextEventToPlay (in category 'event handling') -----
nextEventToPlay
"Return the next event when it is time to be replayed.
If it is not yet time, then return an interpolated mouseMove.
Return nil if nothing has happened.
Return an EOF event if there are no more events to be played."
| nextEvent now nextTime lastP delta |
(tapeStream isNil or:[tapeStream atEnd])
ifTrue:[^MorphicUnknownEvent new setType: #EOF argument: nil].
now := Time millisecondClockValue.
nextEvent := tapeStream next.
"nextEvent isKeyboard ifTrue: [ nextEvent setPosition: self position ]."
deltaTime ifNil:[deltaTime := now - nextEvent timeStamp].
nextTime := nextEvent timeStamp + deltaTime.
now < time ifTrue:["clock rollover"
time := now.
deltaTime := nil.
^nil "continue it on next cycle"].
time := now.
(now >= nextTime) ifTrue:[
nextEvent := nextEvent copy setTimeStamp: nextTime.
nextEvent isMouse ifTrue:[lastEvent := nextEvent] ifFalse:[lastEvent := nil].
^nextEvent].
tapeStream skip: -1.
"Not time for the next event yet, but interpolate the mouse.
This allows tapes to be compressed when velocity is fairly constant."
lastEvent ifNil: [^ nil].
lastP := lastEvent position.
delta := (nextEvent position - lastP) * (now - lastEvent timeStamp) // (nextTime - lastEvent timeStamp).
delta = lastDelta ifTrue: [^ nil]. "No movement"
lastDelta := delta.
^MouseMoveEvent new
setType: #mouseMove
startPoint: lastEvent position endPoint: lastP + delta
trail: #() buttons: lastEvent buttons hand: nil stamp: now.!

----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') -----
pauseIn: aWorld
"Suspend playing or recording, either as part of a stop command,
or as part of a project switch, after which it will be resumed."

self setStatusLight: #ready.
state = #play ifTrue:
[state := #suspendedPlay.
playHand delete.
aWorld removeHand: playHand.
playHand := nil].
state = #record ifTrue:
[state := #suspendedRecord.
recHand removeEventListener: self.
recHand := nil].

voiceRecorder ifNotNil:
[voiceRecorder pause.
startSoundEvent ifNotNil:
[startSoundEvent argument: voiceRecorder recordedSound.
voiceRecorder clearRecordedSound.
startSoundEvent := nil]].
!

----- Method: EventRecorderMorph>>play (in category 'commands') -----
play

self isInWorld ifFalse: [^ self].
self stop.
tape ifNil: [^ self].
tapeStream := ReadStream on: tape.
self resumePlayIn: self world.
self setStatusLight: #nowPlaying.

!

----- Method: EventRecorderMorph>>readFrom: (in category 'fileIn/Out') -----
readFrom: aStream
"Private"
| cr header |
cr := Character cr.
header := aStream upTo: cr.
(header = 'Event Tape v1 BINARY') ifTrue:[^aStream fileInObjectAndCode].
(header = 'Event Tape v1 ASCII') ifTrue:[^self readFromV1: aStream].
"V0 had no header so guess"
aStream reset.
header first isDigit ifFalse:[^self convertV0Tape: (aStream fileInObjectAndCode)].
^self convertV0Tape: (self readFromV0: aStream).
!

----- Method: EventRecorderMorph>>readFromV0: (in category 'fileIn/Out') -----
readFromV0: aStream
| cr line lineStream t evt |
cr := Character cr.
^Array streamContents:[:tStream |
[aStream atEnd] whileFalse:
[line := aStream upTo: cr.
line isEmpty "Some MW tapes have an empty record at the end"
ifFalse: [lineStream := ReadStream on: line.
t := Integer readFrom: lineStream.
[lineStream peek isLetter] whileFalse: [lineStream next].
evt := MorphicEvent readFromObsolete: lineStream.
tStream nextPut: t -> evt]]].!

----- Method: EventRecorderMorph>>readFromV1: (in category 'fileIn/Out') -----
readFromV1: aStream
| cr |
cr := Character cr.
^Array streamContents:[:tStream |
[aStream atEnd] whileFalse:[
tStream nextPut: (MorphicEvent readFromString: (aStream upTo: cr))]]!

----- Method: EventRecorderMorph>>readTape (in category 'fileIn/Out') -----
readTape
^ self readTape: (UIManager default
request: 'Tape to read'
initialAnswer: 'tapeName.tape').!

----- Method: EventRecorderMorph>>readTape: (in category 'fileIn/Out') -----
readTape: fileName
| file |
self writeCheck.
(FileStream isAFileNamed: fileName) ifFalse: [^ nil].
file := FileStream oldFileNamed: fileName.
tape := self readFrom: file.
file close.
saved := true "Still exists on file"!

----- Method: EventRecorderMorph>>record (in category 'commands') -----
record

self isInWorld ifFalse: [^ self].
self stop.
self writeCheck.
self addJournalFile.
tapeStream := WriteStream on: (Array new: 10000).
self resumeRecordIn: self world.
self setStatusLight: #nowRecording.
!

----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') -----
resumeIn: aWorld
"Resume playing or recording after a project switch."

state = #suspendedPlay ifTrue:
[self resumePlayIn: aWorld].
state = #suspendedRecord ifTrue:
[self resumeRecordIn: aWorld].
!

----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') -----
resumePlayIn: aWorld

playHand := HandMorphForReplay new recorder: self.
playHand position: tapeStream peek position.
aWorld addHand: playHand.
playHand newKeyboardFocus: aWorld.
playHand userInitials: 'play' andPicture: nil.

lastEvent := nil.
lastDelta := 0@0.
state := #play.

self synchronize.
!

----- Method: EventRecorderMorph>>resumeRecordIn: (in category 'pause/resume') -----
resumeRecordIn: aWorld

recHand := aWorld activeHand ifNil: [aWorld primaryHand].
recHand newKeyboardFocus: aWorld.
recHand addEventListener: self.

lastEvent := nil.
state := #record.

voiceRecorder ifNotNil:
[voiceRecorder clearRecordedSound.
voiceRecorder resumeRecording.
startSoundEvent := MorphicUnknownEvent new setType: #startSound argument: nil hand: nil stamp: Time millisecondClockValue.
tapeStream nextPut: startSoundEvent].

self synchronize.
!

----- Method: EventRecorderMorph>>setStatusLight: (in category 'commands') -----
setStatusLight: aSymbol

aSymbol == #ready ifTrue: [
statusLight color: Color green.
tape ifNil: [
statusLight setBalloonText: 'Ready to record'.
] ifNotNil: [
statusLight setBalloonText: 'Ready to record or play'.
].
^self
].
aSymbol == #nowRecording ifTrue: [
statusLight
color: Color red;
setBalloonText: 'Recording is active'.
^self
].
aSymbol == #nowPlaying ifTrue: [
statusLight
color: Color yellow;
setBalloonText: 'Now playing'.
^self
].
!

----- Method: EventRecorderMorph>>shrink (in category 'commands') -----
shrink
"Shorten the tape by deleting mouseMove events that can just as well be
interpolated later at playback time."

| oldSize priorSize |
self writeCheck.
oldSize := priorSize := tape size.
[self condense. tape size < priorSize] whileTrue: [priorSize := tape size].
self inform: ('{1} events reduced to {2}' translated format:{oldSize. tape size}).
voiceRecorder ifNotNil: [voiceRecorder suppressSilence].
saved := false.
!

----- Method: EventRecorderMorph>>step (in category 'stepping and presenter') -----
step

(state == #record and: [voiceRecorder notNil]) ifTrue: [
recordMeter width: (voiceRecorder meterLevel + 1).
].
!

----- Method: EventRecorderMorph>>stepTime (in category 'testing') -----
stepTime

^500
!

----- Method: EventRecorderMorph>>stop (in category 'stepping and presenter') -----
stop

state = #record ifTrue:
[tape := tapeStream contents.
saved := false].
journalFile ifNotNil:
[journalFile close].
self pauseIn: self world.
tapeStream := nil.
state := nil.
self setStatusLight: #ready.
recordMeter ifNotNil: [recordMeter width: 1].

self checkTape.!

----- Method: EventRecorderMorph>>synchronize (in category 'event handling') -----
synchronize

time := Time millisecondClockValue.
deltaTime := nil.!

----- Method: EventRecorderMorph>>wantsSteps (in category 'testing') -----
wantsSteps

^true
!

----- Method: EventRecorderMorph>>writeCheck (in category 'fileIn/Out') -----
writeCheck
(saved not and: [self confirm: 'The current tape has not been saved.
Would you like to do so now?']) ifTrue:
[self writeTape].
!

----- Method: EventRecorderMorph>>writeFileNamed: (in category 'fileIn/Out') -----
writeFileNamed: fileName
| file noVoice delta |
file := FileStream newFileNamed: fileName.
noVoice := true.
tape do:[:evt | evt type = #startSound ifTrue: [noVoice := false]].
noVoice
ifTrue: ["Simple format (reads fast) for no voice"
file nextPutAll:'Event Tape v1 ASCII'; cr.
delta := tape first timeStamp.
tape do: [:evt | file store: (evt copy setTimeStamp: evt timeStamp-delta); cr].
file close]
ifFalse: ["Inclusion of voice events requires general object storage"
file nextPutAll:'Event Tape v1 BINARY'; cr.
file fileOutClass: nil andObject: tape].
saved := true.
^ file name!

----- Method: EventRecorderMorph>>writeTape (in category 'fileIn/Out') -----
writeTape
| args b |
args := (b := self button: 'writeTape') isNil
ifTrue: [#()]
ifFalse: [b arguments].
(args notEmpty and: [args first notEmpty])
ifTrue:
[args first.
self writeTape: args first]
ifFalse:
[^self writeTape: (UIManager default request: 'Tape to write'
initialAnswer: 'tapeName.tape')].!

----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') -----
writeTape: fileName
| b name |
name := self writeFileNamed: fileName.
(b := self button: 'writeTape') ifNotNil: [
b actionSelector: #writeTape:.
b arguments: (Array with: name)].
!