[etoys-dev] Etoys Inbox: EnvelopeEditorRevival-kfr.1.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 23 07:30:52 EDT 2012
A new version of EnvelopeEditorRevival was added to project Etoys Inbox:
http://source.squeak.org/etoysinbox/EnvelopeEditorRevival-kfr.1.mcz
==================== Summary ====================
Name: EnvelopeEditorRevival-kfr.1
Author: kfr
Time: 23 October 2012, 1:29:38 pm
UUID: 1cd87ee6-8007-0140-abff-0680e1816067
Ancestors:
EnvelopeEditor was removed from image due to copyright issues. Here it is revived with a new ScaleMorph. ScaleMorph is reimplemented from Russell Swan's version.
==================== Snapshot ====================
SystemOrganization addCategory: #EnvelopeEditorRevival!
RectangleMorph subclass: #EnvelopeEditorMorph
instanceVariableNames: 'sound soundName envelope hScale vScale graphArea pixPerTick limits limitXs limitHandles line prevMouseDown sampleDuration showAllEnvelopes denominator keyboard'
classVariableNames: ''
poolDictionaries: ''
category: 'EnvelopeEditorRevival'!
----- Method: EnvelopeEditorMorph class>>openOn:title: (in category 'as yet unclassified') -----
openOn: aSound title: aString
"EnvelopeEditorMorph openOn: (AbstractSound soundNamed: 'brass1') copy title: 'brass1'"
(self basicNew initOnSound: aSound title: aString) openInWorld!
----- Method: EnvelopeEditorMorph>>acceptGraphPoint:at: (in category 'editing') -----
acceptGraphPoint: p at: index
| ms val points whichLim linePoint other boundedP |
boundedP := p adhereTo: graphArea bounds.
ms := self msFromX: boundedP x.
points := envelope points.
ms := self
constrain: ms
adjacentTo: index
in: points.
(index = 1
or: [(whichLim := limits indexOf: index) > 0])
ifTrue: ["Limit points must not move laterally"
ms := (points at: index) x].
val := self valueFromY: boundedP y.
points at: index put: ms @ val.
linePoint := (self xFromMs: ms)
@ (self yFromValue: val).
(whichLim notNil
and: [whichLim between: 1 and: 2])
ifTrue: ["Loop start and loop end must be tied
together "
other := limits at: 3 - whichLim.
"1 <--> 2"
points at: other put: (points at: other) x @ val.
line vertices at: other put: (line vertices at: other) x @ linePoint y.
line computeBounds].
"Make sure envelope feels the change in points array... "
envelope
setPoints: points
loopStart: (limits at: 1)
loopEnd: (limits at: 2).
^ linePoint!
----- Method: EnvelopeEditorMorph>>addControls (in category 'construction') -----
addControls
| chooser |
chooser _ PopUpChoiceMorph new extent: 180 at 40;
contentsClipped: 'editing ' , envelope name;
target: self;
actionSelector: #chooseFrom:envelopeItem:;
getItemsSelector: #curveChoices.
chooser arguments: (Array with: chooser).
self addMorph: chooser.
chooser align: chooser bounds topLeft with: graphArea bounds bottomLeft + (0 at 5).
chooser _ PopUpChoiceMorph new extent: 180 at 40;
contentsClipped: 'duration: ' , self durationName;
target: self;
actionSelector: #chooseFrom:durationItem:;
getItemsSelector: #durationChoices.
chooser arguments: (Array with: chooser).
self addMorph: chooser.
chooser align: chooser bounds topRight with: graphArea bounds bottomRight + (-50 at 5).
!
----- Method: EnvelopeEditorMorph>>addCurves (in category 'construction') -----
addCurves
"Add the polyLine corresponding to the currently selected envelope,
and possibly all the others, too."
| verts aLine |
sound envelopes do:
[:env |
(showAllEnvelopes or: [env == envelope]) ifTrue:
[verts _ env points collect:
[:p | (self xFromMs: p x) @ (self yFromValue: p y)].
aLine _ EnvelopeLineMorph basicNew
vertices: verts borderWidth: 1
borderColor: (self colorForEnvelope: env).
env == envelope
ifTrue: [aLine borderWidth: 2. line _ aLine]
ifFalse: [aLine on: #mouseUp send: #clickOnLine:evt:envelope:
to: self withValue: env.
self addMorph: aLine]]].
self addMorph: line "add the active one last (in front)"!
----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: menu hand: aHandMorph
super addCustomMenuItems: menu hand: aHandMorph.
menu addLine.
envelope updateSelector = #ratio: ifTrue:
[menu add: 'choose denominator...' action: #chooseDenominator:].
menu add: 'adjust scale...' action: #adjustScale:.
SoundPlayer isReverbOn
ifTrue: [menu add: 'turn reverb off' target: SoundPlayer selector: #stopReverb]
ifFalse: [menu add: 'turn reverb on' target: SoundPlayer selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' action: #chooseSound:.
menu add: 'put sound in lib' action: #saveSound:.
menu add: 'read sound from disk...' action: #readFromDisk:.
menu add: 'save sound on disk...' action: #saveToDisk:.
menu add: 'save library on disk...' action: #saveLibToDisk:.
!
----- Method: EnvelopeEditorMorph>>addEnvelopeNamed: (in category 'menu') -----
addEnvelopeNamed: envName
| points env |
points := OrderedCollection new.
points add: 0 at 0.0;
add: (envelope points at: envelope loopStartIndex) x at 1.0;
add: (envelope points at: envelope loopEndIndex) x at 1.0;
add: (envelope points last) x at 0.0.
envName = 'volume' ifTrue:
[env := VolumeEnvelope points: points loopStart: 2 loopEnd: 3.
env target: sound; scale: 0.7].
envName = 'modulation' ifTrue:
[env := Envelope points: (points collect: [:p | p x @ 0.5])
loopStart: 2 loopEnd: 3.
env target: sound; updateSelector: #modulation:;
scale: sound modulation*2.0].
envName = 'pitch' ifTrue:
[env := PitchEnvelope points: (points collect: [:p | p x @ 0.5])
loopStart: 2 loopEnd: 3.
env target: sound; updateSelector: #pitch:; scale: 0.5].
envName = 'ratio' ifTrue:
[denominator := 9999. "No gridding"
env := Envelope points: (points collect: [:p | p x @ 0.5])
loopStart: 2 loopEnd: 3.
env target: sound; updateSelector: #ratio:;
scale: sound ratio*2.0].
env ifNotNil:
[sound addEnvelope: env.
self editEnvelope: env]!
----- Method: EnvelopeEditorMorph>>addHandlesIn: (in category 'construction') -----
addHandlesIn: frame
| handle |
handle := PolygonMorph
vertices: (Array with: 0 at 0 with: 12 at 0 with: 6 at 12)
color: Color orange borderWidth: 1 borderColor: Color black.
handle addMorph: ((RectangleMorph
newBounds: ((self handleOffset: handle)-(2 at 0) extent: 1@(graphArea height-2))
color: Color orange) borderWidth: 0).
limitHandles := Array with: handle with: handle fullCopy with: handle fullCopy.
1 to: limitHandles size do:
[:i | handle := limitHandles at: i.
handle on: #mouseStillDown
send: #limitHandleMove:event:from:
to: self withValue: i.
self addMorph: handle.
handle position: ((self xFromMs: (envelope points at: (limits at: i)) x) @ (graphArea top)) - (self handleOffset: handle)]!
----- Method: EnvelopeEditorMorph>>addKeyboard (in category 'construction') -----
addKeyboard
keyboard := PianoKeyboardMorph new soundPrototype: sound.
keyboard align: keyboard bounds bottomCenter with: bounds bottomCenter - (0 at 4).
self addMorph: keyboard!
----- Method: EnvelopeEditorMorph>>adjustScale: (in category 'menu') -----
adjustScale: evt
| scaleString oldScale baseValue |
oldScale := envelope scale.
scaleString := FillInTheBlank request: 'Enter the new full-scale value...'
initialAnswer: oldScale printString.
scaleString isEmpty ifTrue: [^ self].
envelope scale: (Number readFrom: scaleString) asFloat.
baseValue := envelope updateSelector = #pitch: ifTrue: [0.5] ifFalse: [0.0].
envelope setPoints: (envelope points collect:
[:p |
p x @ (p y - baseValue * oldScale / envelope scale + baseValue
min: 1.0 max: 0.0)])
loopStart: (limits at: 1) loopEnd: (limits at: 2).
self buildView!
----- Method: EnvelopeEditorMorph>>buildGraphAreaIn: (in category 'construction') -----
buildGraphAreaIn: frame
| r y |
graphArea := RectangleMorph
newBounds: ((frame left + 60) @ (frame top + 60)
corner: (frame right+1) @ (frame bottom - 120))
color: Color lightGreen lighter lighter.
graphArea borderWidth: 1.
self addMorph: graphArea.
(envelope updateSelector = #pitch: and: [envelope scale <= 2.0]) ifTrue:
["Show half-steps"
r := graphArea innerBounds.
0.0 to: 1.0 by: 1.0/12.0/envelope scale do:
[:val |
y := self yFromValue: val.
graphArea addMorph: ((RectangleMorph
newBounds: (r left at y extent: r width at 1)
color: Color veryLightGray)
borderWidth: 0)]].
(envelope updateSelector = #ratio: and: [denominator ~= 9999]) ifTrue:
["Show denominator gridding"
r := graphArea innerBounds.
(0.0 to: 1.0 by: 1.0/denominator/envelope scale) do:
[:v |
y := self yFromValue: v.
graphArea addMorph: ((RectangleMorph
newBounds: (r left at y extent: r width at 1)
color: Color veryLightGray)
borderWidth: 0)]].
!
----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'construction') -----
buildScalesIn: frame
| env |
env _ envelope.
pixPerTick _ graphArea width // (self maxTime//10) max: 1.
hScale _ (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
start: 0 stop: self maxTime
minorTick: 10 minorTickLength: 3
majorTick: 100 majorTickLength: 10
caption: 'milliseconds' tickPrintBlock: [:v | v printString].
self addMorph: hScale.
vScale _ ScaleMorph newBounds: (0 at 0 extent: (graphArea height)@(graphArea left - frame left)).
env updateSelector = #pitch:
ifTrue:
[env scale >= 2.0
ifTrue:
[vScale start: 0 stop: env scale
minorTick: env scale / 24 minorTickLength: 3
majorTick: env scale / 2.0 majorTickLength: 10
caption: 'pitch (octaves)'
tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: 1.0/48.0 minorTickLength: 3
majorTick: 1.0/12.0 majorTickLength: 10
caption: 'pitch (half-steps)'
tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: env scale / 50.0 minorTickLength: 3
majorTick: env scale / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]].
vScale _ TransformationMorph new asFlexOf: vScale.
vScale angle: Float pi / 2.0.
self addMorph: vScale.
vScale position: (frame left)@(graphArea top-1).
!
----- Method: EnvelopeEditorMorph>>buildView (in category 'construction') -----
buildView
| frame |
self color: Color lightGreen.
self removeAllMorphs.
frame := self innerBounds.
self buildGraphAreaIn: frame.
self buildScalesIn: frame.
self addHandlesIn: frame.
self addCurves.
line addHandles.
self addControls.
self addKeyboard!
----- Method: EnvelopeEditorMorph>>chooseDenominator: (in category 'menu') -----
chooseDenominator: evt
| menu |
menu := MenuMorph new.
(Integer primesUpTo: 30) do:
[:i |
menu add: i printString
target: self selector: #setDenominator:
argument: i].
menu addLine.
menu add: 'none' target: self selector: #setDenominator: argument: 9999.
menu popUpAt: evt hand position event: evt.
!
----- Method: EnvelopeEditorMorph>>chooseEnvelope: (in category 'menu') -----
chooseEnvelope: choice
| name |
(choice beginsWith: 'edit ') ifTrue:
[name := choice copyFrom: 'edit ' size+1 to: choice size.
^ self editEnvelope: (sound envelopes detect:
[:env | env name = name])].
(choice beginsWith: 'add ') ifTrue:
[name := choice copyFrom: 'add ' size+1 to: choice size.
^ self addEnvelopeNamed: name].
(choice beginsWith: 'remove ') ifTrue:
[^ self removeEnvelope "the current one"].
!
----- Method: EnvelopeEditorMorph>>chooseFrom:durationItem: (in category 'menu') -----
chooseFrom: chooserMorph durationItem: item
| str |
(item first isDigit and: [item asNumber ~= 0])
ifTrue: [sampleDuration := item asNumber].
item = 'other' ifTrue:
[str := FillInTheBlank request: 'duration in milliseconds'
initialAnswer: sampleDuration printString.
sampleDuration := str asNumber].
item = 'held' ifTrue: [sampleDuration := 9999].
sound duration: sampleDuration / 1000.0.
chooserMorph contentsClipped: 'duration: ' , self durationName!
----- Method: EnvelopeEditorMorph>>chooseFrom:envelopeItem: (in category 'menu') -----
chooseFrom: chooserMorph envelopeItem: item
| name |
(item beginsWith: 'edit ') ifTrue:
[name := item copyFrom: 'edit ' size+1 to: item size.
self editEnvelope: (sound envelopes detect:
[:env | env name = name])].
(item beginsWith: 'add ') ifTrue:
[name := item copyFrom: 'add ' size+1 to: item size.
self addEnvelopeNamed: name].
(item beginsWith: 'remove ') ifTrue:
[self removeEnvelope "the current one"].
chooserMorph contentsClipped: envelope name!
----- Method: EnvelopeEditorMorph>>chooseFrom:soundItem: (in category 'menu') -----
chooseFrom: chooserMorph soundItem: item
self editSoundNamed: item.
!
----- Method: EnvelopeEditorMorph>>chooseSound: (in category 'menu') -----
chooseSound: evt
| menu |
menu := MenuMorph new.
menu add: 'new' target: self selector: #editNewSound.
menu addLine.
AbstractSound soundNames do:
[:name |
menu add: name
target: self selector: #editSoundNamed:
argument: name].
menu popUpInWorld
!
----- Method: EnvelopeEditorMorph>>clickOn:evt:from: (in category 'editing') -----
clickOn: env evt: anEvent from: aLine
self editEnvelope: env!
----- Method: EnvelopeEditorMorph>>clickOnLine:evt:envelope: (in category 'editing') -----
clickOnLine: aLine evt: anEvent envelope: env
self editEnvelope: env!
----- Method: EnvelopeEditorMorph>>colorForEnvelope: (in category 'construction') -----
colorForEnvelope: env
| name index |
name _ env name.
index _ #('volume' 'modulation' 'pitch' 'ratio') indexOf: name
ifAbsent: [5].
^ Color perform: (#(red green blue magenta black) at: index)!
----- Method: EnvelopeEditorMorph>>constrain:adjacentTo:in: (in category 'editing') -----
constrain: xVal adjacentTo: ix in: points
"Return xVal, restricted between points adjacent to vertX"
| newVal |
newVal := xVal.
ix > 1 ifTrue: [newVal := newVal max: (points at: ix-1) x].
ix < points size ifTrue: [newVal := newVal min: (points at: ix+1) x].
^ newVal!
----- Method: EnvelopeEditorMorph>>curveChoices (in category 'construction') -----
curveChoices
| extant others |
extant _ sound envelopes collect: [:env | env name].
others _ #('volume' 'modulation' 'pitch' 'ratio') reject: [:x | extant includes: x].
^ (extant collect: [:name | 'edit ' , name])
, (others collect: [:name | 'add ' , name])
, (sound envelopes size > 1
ifTrue: [Array with: 'remove ' , envelope name]
ifFalse: [Array new])!
----- Method: EnvelopeEditorMorph>>deletePoint: (in category 'editing') -----
deletePoint: ix
"If the point is a limit point, return false,
otherwise, delete the point at ix, and return
true. "
(limits includes: ix)
ifTrue: [^ false].
1
to: limits size
do: [:i | "Decrease limit indices beyond the deletion"
(limits at: i)
> ix
ifTrue: [limits at: i put: (limits at: i)
- 1]].
envelope
setPoints: (envelope points
copyReplaceFrom: ix
to: ix
with: Array new)
loopStart: (limits at: 1)
loopEnd: (limits at: 2).
^ true!
----- Method: EnvelopeEditorMorph>>durationChoices (in category 'construction') -----
durationChoices
^ #(
'125ms'
'250ms'
'500ms'
'1000ms'
'2000ms'
'other'
'held'
)!
----- Method: EnvelopeEditorMorph>>durationName (in category 'construction') -----
durationName
self durationChoices do: [:c |
(c first isDigit and: [c asNumber = sampleDuration]) ifTrue: [^ c]].
sampleDuration = 9999 ifTrue: [^ 'held'].
^ sampleDuration printString
!
----- Method: EnvelopeEditorMorph>>editEnvelope: (in category 'initialization') -----
editEnvelope: env
envelope := env.
limits := Array
with: envelope loopStartIndex
with: envelope loopEndIndex
with: envelope points size.
limitXs := limits
collect: [:i | (envelope points at: i) x].
self buildView!
----- Method: EnvelopeEditorMorph>>editNewSound (in category 'menu') -----
editNewSound
| known i |
known := AbstractSound soundNames.
i := 0.
[soundName := 'unnamed' , i printString.
known includes: soundName]
whileTrue: [i := 1+1].
soundName := soundName.
self editSound: FMSound default copy!
----- Method: EnvelopeEditorMorph>>editSound: (in category 'initialization') -----
editSound: aSound
| p |
sound := aSound.
sound envelopes isEmpty ifTrue: [
"provide a default volume envelope"
p := OrderedCollection new.
p add: 0 at 0.0; add: 10 at 1.0; add: 100 at 1.0; add: 120 at 0.0.
sound addEnvelope: (VolumeEnvelope points: p loopStart: 2 loopEnd: 3)].
self editEnvelope: sound envelopes first.
keyboard soundPrototype: sound.
!
----- Method: EnvelopeEditorMorph>>editSoundNamed: (in category 'menu') -----
editSoundNamed: name
soundName := name.
self editSound: (AbstractSound soundNamed: soundName) copy!
----- Method: EnvelopeEditorMorph>>extent: (in category 'scaling') -----
extent: newExtent
super extent: (newExtent max: (self maxTime//10*3+50 max: 500) @ 400).
self buildView!
----- Method: EnvelopeEditorMorph>>handleOffset: (in category 'construction') -----
handleOffset: handle
"This is the offset from position to the bottom vertex"
^ (handle width//2+1) @ handle height
!
----- Method: EnvelopeEditorMorph>>initOnSound:title: (in category 'initialization') -----
initOnSound: aSound title: title
sound := aSound.
soundName := title.
self initialize.
!
----- Method: EnvelopeEditorMorph>>initialize (in category 'initialization') -----
initialize
super initialize.
prevMouseDown := false.
showAllEnvelopes := true.
self editSound: (sound ifNil: [FMSound brass1 copy]).
soundName ifNil: [soundName := 'test'].
sampleDuration _ 250. sound duration: sampleDuration.
sound duration: sampleDuration / 1000.0.
denominator := 7.
self extent: 10 at 10. "ie the minimum"
!
----- Method: EnvelopeEditorMorph>>insertPointAfter: (in category 'editing') -----
insertPointAfter: ix
"If there is not enough roon (in x) then return
false. Otherwise insert a point between ix and
ix+1 and return true."
| points pt |
points := envelope points.
(points at: ix + 1) x - (points at: ix) x < 20
ifTrue: [^ false].
pt := (points at: ix + 1)
+ (points at: ix) // 2.
1
to: limits size
do: [:i | "Increase limit indices beyond the insertion"
(limits at: i)
> ix
ifTrue: [limits at: i put: (limits at: i)
+ 1]].
envelope
setPoints: (points
copyReplaceFrom: ix + 1
to: ix
with: (Array with: pt))
loopStart: (limits at: 1)
loopEnd: (limits at: 2).
^ true!
----- Method: EnvelopeEditorMorph>>limitHandleMove:event:from: (in category 'editing') -----
limitHandleMove: index event: evt from: handle
"index is the handle index = 1, 2 or 3"
| ix p ms x points limIx |
ix := limits at: index.
"index of corresponding vertex"
p := evt cursorPoint adhereTo: graphArea bounds.
ms := self msFromX: p x + (self handleOffset: handle) x.
"Constrain move to adjacent points on ALL envelopes "
sound envelopes
do: [:env |
limIx := env
perform: (#(#loopStartIndex #loopEndIndex #decayEndIndex ) at: index).
ms := self
constrain: ms
adjacentTo: limIx
in: env points].
"Update the handle, the vertex and the line being edited "
x := self xFromMs: ms.
handle position: x @ graphArea top
- (self handleOffset: handle).
line verticesAt: ix put: x @ (line vertices at: ix) y.
sound envelopes
do: [:env |
limIx := env
perform: (#(#loopStartIndex #loopEndIndex #decayEndIndex ) at: index).
points := env points.
points at: limIx put: ms @ (points at: limIx) y.
env
setPoints: points
loopStart: env loopStartIndex
loopEnd: env loopEndIndex]!
----- Method: EnvelopeEditorMorph>>limitHandleMoveEvent:from:index: (in category 'editing') -----
limitHandleMoveEvent: arg1 from: arg2 index: arg3
"Reorder the arguments for existing event handlers"
(arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages].
^self limitHandleMove: arg1 event: arg2 from: arg3!
----- Method: EnvelopeEditorMorph>>maxTime (in category 'scaling') -----
maxTime
^ (envelope points at: limits last) x + 100!
----- Method: EnvelopeEditorMorph>>msFromX: (in category 'scaling') -----
msFromX: x
^ (x - graphArea left)//pixPerTick*10!
----- Method: EnvelopeEditorMorph>>playChoices (in category 'construction') -----
playChoices
^ #(now afterEdits duringEdits)!
----- Method: EnvelopeEditorMorph>>playNothing (in category 'playing') -----
playNothing
!
----- Method: EnvelopeEditorMorph>>readFileNamed: (in category 'menu') -----
readFileNamed: fileName
| snd |
snd := Compiler evaluate:
(FileStream readOnlyFileNamed: fileName) contentsOfEntireFile.
soundName := fileName copyFrom: 1 to: fileName size-4. "---.fmp"
self editSound: snd!
----- Method: EnvelopeEditorMorph>>readFromDisk: (in category 'menu') -----
readFromDisk: evt
| menu |
menu := MenuMorph new.
(FileDirectory default fileNamesMatching: '*.fmp') do:
[:fileName |
menu add: fileName
target: self selector: #readFileNamed:
argument: fileName].
menu popUpAt: evt hand position event: evt.
!
----- Method: EnvelopeEditorMorph>>removeEnvelope (in category 'menu') -----
removeEnvelope
(PopUpMenu confirm: 'Really remove ' , envelope name , '?')
ifFalse: [^ self].
sound removeEnvelope: envelope.
self editEnvelope: sound envelopes first.!
----- Method: EnvelopeEditorMorph>>saveLibToDisk: (in category 'menu') -----
saveLibToDisk: evt
| newName f snd |
newName := FillInTheBlank request: 'Please confirm name for library...'
initialAnswer: 'MySounds'.
newName isEmpty ifTrue: [^ self].
f := FileStream newFileNamed: newName , '.fml'.
AbstractSound soundNames do:
[:name | snd := AbstractSound soundNamed: name.
"snd isStorable" true ifTrue: [f nextChunkPut: 'AbstractSound soundNamed: ' , name , ' put: ' , snd storeString; cr; cr]
ifFalse: [PopUpMenu notify: name , ' is not currently storable']].
f close!
----- Method: EnvelopeEditorMorph>>saveSound: (in category 'menu') -----
saveSound: evt
| newName |
newName := FillInTheBlank request: 'Please confirm name for save...'
initialAnswer: soundName.
newName isEmpty ifTrue: [^ self].
AbstractSound soundNamed: newName put: sound.
soundName := newName.!
----- Method: EnvelopeEditorMorph>>saveToDisk: (in category 'menu') -----
saveToDisk: evt
| newName f |
newName := FillInTheBlank request: 'Please confirm name for save...'
initialAnswer: soundName.
newName isEmpty ifTrue: [^ self].
f := FileStream newFileNamed: newName , '.fmp'.
sound storeOn: f.
f close!
----- Method: EnvelopeEditorMorph>>setDenominator: (in category 'menu') -----
setDenominator: denom
denominator := denom.
self buildView!
----- Method: EnvelopeEditorMorph>>soundBeingEdited (in category 'initialization') -----
soundBeingEdited
^ sound!
----- Method: EnvelopeEditorMorph>>soundChoices (in category 'construction') -----
soundChoices
^ #('new...') , AbstractSound soundNames!
----- Method: EnvelopeEditorMorph>>step (in category 'stepping') -----
step
| mouseDown hand |
hand := self world firstHand.
(bounds containsPoint: hand position) ifFalse: [^ self].
mouseDown := hand lastEvent redButtonPressed.
mouseDown not & prevMouseDown ifTrue:
["Mouse just went up"
limitXs = (limits collect: [:i | (envelope points at: i) x]) ifFalse:
["Redisplay after changing limits"
self editEnvelope: envelope]].
prevMouseDown := mouseDown!
----- Method: EnvelopeEditorMorph>>stepTime (in category 'stepping') -----
stepTime
^ 100!
----- Method: EnvelopeEditorMorph>>valueFromY: (in category 'scaling') -----
valueFromY: y
"The convention is that envelope values are between 0.0 and 1.0"
| value |
value := (graphArea bottom - y) asFloat / (graphArea height).
envelope updateSelector = #ratio: ifTrue:
["Ratio gets gridded by denominator"
^ (value * envelope scale * denominator) rounded asFloat / denominator / envelope scale].
^ value!
----- Method: EnvelopeEditorMorph>>wantsRoundedCorners (in category 'rounding') -----
wantsRoundedCorners
^ Preferences roundedWindowCorners or: [super wantsRoundedCorners]!
----- Method: EnvelopeEditorMorph>>xFromMs: (in category 'scaling') -----
xFromMs: ms
^ graphArea left + (ms//10*pixPerTick)!
----- Method: EnvelopeEditorMorph>>yFromValue: (in category 'scaling') -----
yFromValue: val
"The convention is that envelope values are between 0.0 and 1.0"
^ graphArea bottom - (val* (graphArea height))!
RectangleMorph subclass: #ScaleMorph
instanceVariableNames: 'caption start stop minorTick minorTickLength majorTick majorTickLength tickPrintBlock'
classVariableNames: 'ClassVarName1 ClassVarName2'
poolDictionaries: ''
category: 'EnvelopeEditorRevival'!
----- Method: ScaleMorph>>buildLabels (in category 'as yet unclassified') -----
buildLabels
| scale x1 y1 y2 x captionMorph tickMorph loopStart |
self removeAllMorphs.
caption
ifNotNil: [captionMorph := StringMorph contents: caption.
captionMorph align: captionMorph bounds bottomCenter with: self bounds bottomCenter - (0 @ majorTickLength) - (0 @ (captionMorph height + 2)).
self addMorph: captionMorph].
tickPrintBlock
ifNotNil: [scale := self innerBounds width - 1 / ((stop - start) max: 0.1 )asFloat.
x1 := self innerBounds left.
y1 := self innerBounds bottom.
y2 := y1 - majorTickLength.
"Start loop on multiple of majorTick"
loopStart := (start / majorTick) ceiling * majorTick.
loopStart
to: stop
by: majorTick
do: [:v |
x := x1 + (scale * (v - start)).
tickMorph := StringMorph
contents: (tickPrintBlock value: v).
tickMorph align: tickMorph bounds bottomCenter with: x @ y2.
tickMorph left < self left
ifTrue: [tickMorph position: self left @ tickMorph top].
tickMorph right > self right
ifTrue: [tickMorph position: self right - tickMorph width @ tickMorph top].
self addMorph: tickMorph]]!
----- Method: ScaleMorph>>drawOn: (in category 'as yet unclassified') -----
drawOn: aCanvas
| scale x1 y1 y2 x y3 even yy loopStart checkStart |
super drawOn: aCanvas.
scale := self innerBounds width - 1 / (stop - start) asFloat.
x1 := self innerBounds left.
y1 := self innerBounds bottom - 1.
y2 := y1 - minorTickLength.
loopStart := (start / minorTick) ceiling * minorTick.
loopStart
to: stop
by: minorTick
do: [:v |
x := x1 + (scale * (v - start)).
aCanvas
line: x @ y1
to: x @ y2
width: 1
color: Color black].
x1 := self innerBounds left.
y2 := y1 - majorTickLength.
y3 := y1 - (minorTickLength + majorTickLength // 2).
even := true.
"Make sure major ticks start drawing on a multiple of majorTick"
loopStart := (start / majorTick) ceiling * majorTick.
checkStart := (start / (majorTick / 2.0)) ceiling * majorTick.
"Check to see if semimajor tick should be drawn
before majorTick"
checkStart = (loopStart * 2)
ifFalse: [loopStart := checkStart / 2.0.
even := false].
loopStart
to: stop
by: majorTick / 2.0
do: [:v |
x := x1 + (scale * (v - start)).
yy := even
ifTrue: [y2]
ifFalse: [y3].
aCanvas
line: x @ y1
to: x @ yy
width: 1
color: Color black.
even := even not]!
----- Method: ScaleMorph>>extent: (in category 'as yet unclassified') -----
extent: newExtent
| pixPerTick newWidth |
pixPerTick := newExtent x - (self borderWidth * 2) - 1 / ((stop - start) asFloat / minorTick).
pixPerTick := pixPerTick
detentBy: 0.1
atMultiplesOf: 1.0
snap: false.
newWidth := pixPerTick * ((stop - start) asFloat / minorTick) + (self borderWidth * 2) + 1.
super extent: newWidth @ newExtent y.
self buildLabels!
----- Method: ScaleMorph>>initialize (in category 'as yet unclassified') -----
initialize
super initialize.
borderWidth := 0.
color := Color lightGreen.
start := 0.
stop := 100.
minorTick := 1.
majorTick := 10.
minorTickLength := 3.
majorTickLength := 10.
caption := 'sample'.
tickPrintBlock := [:v | v printString]!
----- Method: ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:caption:tickPrintBlock: (in category 'as yet unclassified') -----
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk
start := strt.
stop := stp.
minorTick := mnt.
minorTickLength := mntLen.
majorTick := mjt.
majorTickLength := mjtLen.
caption := cap.
tickPrintBlock := blk fixTemps.
self buildLabels!
PolygonMorph subclass: #EnvelopeLineMorph
instanceVariableNames: 'editor'
classVariableNames: ''
poolDictionaries: ''
category: 'EnvelopeEditorRevival'!
----- Method: EnvelopeLineMorph>>defaultColor (in category 'initialization') -----
defaultColor
"answer the default color/fill style for the receiver"
^ Color transparent!
----- Method: EnvelopeLineMorph>>dragVertex:event:fromHandle: (in category 'editing') -----
dragVertex: ix event: evt fromHandle: handle
| p |
super dragVertex: ix event: evt fromHandle: handle.
p := owner acceptGraphPoint: evt cursorPoint at: ix.
self verticesAt: ix put: p.
!
----- Method: EnvelopeLineMorph>>dragVertex:fromHandle:vertIndex: (in category 'as yet unclassified') -----
dragVertex: evt fromHandle: handle vertIndex: ix
| p |
super dragVertex: evt fromHandle: handle vertIndex: ix.
p := owner acceptGraphPoint: evt cursorPoint at: ix.
vertices at: ix put: p.
self computeBounds!
----- Method: EnvelopeLineMorph>>dropVertex:event:fromHandle: (in category 'editing') -----
dropVertex: ix event: evt fromHandle: handle
| oldVerts |
oldVerts := vertices.
super dropVertex: ix event: evt fromHandle: handle.
vertices = oldVerts ifFalse: [owner deletePoint: ix "deleted a vertex"]!
----- Method: EnvelopeLineMorph>>dropVertex:fromHandle:vertIndex: (in category 'as yet unclassified') -----
dropVertex: evt fromHandle: handle vertIndex: ix
| oldVerts |
oldVerts := vertices.
super dropVertex: evt fromHandle: handle vertIndex: ix.
vertices = oldVerts ifFalse: [owner deletePoint: ix "deleted a vertex"]!
----- Method: EnvelopeLineMorph>>newVertex:event:fromHandle: (in category 'editing') -----
newVertex: ix event: evt fromHandle: handle
"Install a new vertex if there is room."
(owner insertPointAfter: ix) ifFalse: [^ self "not enough room"].
super newVertex: ix event: evt fromHandle: handle.
self verticesAt: ix+1 put: (owner acceptGraphPoint: evt cursorPoint at: ix+1).
!
----- Method: EnvelopeLineMorph>>newVertex:fromHandle:afterVert: (in category 'as yet unclassified') -----
newVertex: evt fromHandle: handle afterVert: ix
"Install a new vertex if there is room."
(owner insertPointAfter: ix) ifFalse: [^ self "not enough room"].
super newVertex: evt fromHandle: handle afterVert: ix.
vertices at: ix+1 put: (owner acceptGraphPoint: evt cursorPoint at: ix+1).
self computeBounds!
----- Method: EnvelopeLineMorph>>vertices:borderWidth:borderColor: (in category 'as yet unclassified') -----
vertices: verts borderWidth: bw borderColor: bc
super initialize.
vertices := verts.
color := Color transparent.
borderWidth := bw.
borderColor := bc.
closed := false.
arrows := #none.
self computeBounds!
More information about the etoys-dev
mailing list