Smalltalk › Frameworks & Tools › eToys Development

Etoys Inbox: EnvelopeEditorRevival-kfr.2.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

Etoys Inbox: EnvelopeEditorRevival-kfr.2.mcz

A new version of EnvelopeEditorRevival was added to project Etoys Inbox:
http://source.squeak.org/etoysinbox/EnvelopeEditorRevival-kfr.2.mcz

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

Name: EnvelopeEditorRevival-kfr.2
Author: kfr
Time: 24 October 2012, 8:41:50 am
UUID: b53d6123-ce47-b040-a8a6-0161d9731ea3
Ancestors:

Newer version from Squeak 4.3. ScaleMorph not changed

==================== 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
(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: [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: [other := limits at: 3 - whichLim.
points at: other put: (points at: other) x @ val.
line verticesAt: other put: (line vertices at: other) x @ linePoint y].
envelope
setPoints: points
loopStart: limits first
loopEnd: limits second.
^ linePoint!

----- Method: EnvelopeEditorMorph>>addControls (in category 'construction') -----
addControls
| chooser |
chooser := PopUpChoiceMorph new extent: 200 @ 20;
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 @ 5).
chooser := PopUpChoiceMorph new extent: 250 @ 20;
contentsClipped: 'Timbre: ' , soundName;
target: self;
actionSelector: #chooseFrom:soundItem:;
getItemsSelector: #soundChoices.
chooser
arguments: (Array with: chooser).
self addMorph: chooser.
chooser align: chooser bounds topRight with: graphArea bounds bottomRight + (-50 @ 5)!

----- Method: EnvelopeEditorMorph>>addCurves (in category 'construction') -----
addCurves
| aLine verts |
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: #clickOn:evt:from:
to: self
withValue: env.
self addMorph: aLine]]].
self addMorph: line!

----- 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...' translated action: #chooseDenominator:].
menu add: 'adjust scale...' translated action: #adjustScale:.
SoundPlayer isReverbOn
ifTrue: [menu
add: 'turn reverb off' translated
target: SoundPlayer
selector: #stopReverb]
ifFalse: [menu
add: 'turn reverb on' translated
target: SoundPlayer
selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' translated action: #chooseSound:.
menu add: 'put sound in lib' translated action: #saveSound:.
menu add: 'read sound from disk...' translated action: #readFromDisk:.
menu add: 'save sound on disk...' translated action: #saveToDisk:.
menu add: 'save library on disk...' translated action: #saveLibToDisk:!

----- Method: EnvelopeEditorMorph>>addEnvelopeNamed: (in category 'editing') -----
addEnvelopeNamed: envName
| points env |
points := OrderedCollection new.
points add: 0 @ 0.0;
add: (envelope points at: envelope loopStartIndex) x @ 1.0;
add: (envelope points at: envelope loopEndIndex) x @ 1.0;
add: envelope points last x @ 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 = 'random pitch:'
ifTrue: [env := RandomEnvelope for: #pitch:.
points := OrderedCollection new.
points add: 0 @ (env delta * 5 + 0.5);
add: (envelope points at: envelope loopStartIndex) x @ (env highLimit - 1 * 5 + 0.5);
add: (envelope points at: envelope loopEndIndex) x @ (env highLimit - 1 * 5 + 0.5);
add: envelope points last x @ (env lowLimit - 1 * 5 + 0.5).
env
setPoints: points
loopStart: 2
loopEnd: 3.
env target: sound].
envName = 'ratio'
ifTrue: [denominator := 9999.
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 @ 0
with: 8 @ 0
with: 4 @ 8)
color: Color orange
borderWidth: 1
borderColor: Color black.
handle
addMorph: ((RectangleMorph
newBounds: ((self handleOffset: handle)
- (2 @ 0) extent: 1 @ (graphArea height - 2))
color: Color orange)
borderWidth: 0).
limitHandles := Array
with: handle
with: handle veryDeepCopy
with: handle veryDeepCopy.
1
to: limitHandles size
do: [:i |
handle := limitHandles at: i.
handle
on: #mouseDown
send: #limitHandleMove:event:from:
to: self
withValue: i.
handle
on: #mouseMove
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 @ 4).
self addMorph: keyboard!

----- Method: EnvelopeEditorMorph>>adjustScale: (in category 'menu') -----
adjustScale: evt
| scaleString oldScale baseValue |
oldScale := envelope scale.
scaleString := UIManager default 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 first
loopEnd: limits second.
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;
borderColor: Color black.
self addMorph: graphArea.
(envelope updateSelector = #pitch:
and: [envelope scale <= 2.0])
ifTrue: [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 @ y extent: r width @ 1)
color: Color veryLightGray)
borderWidth: 0)]].
(envelope updateSelector = #ratio:
and: [denominator ~= 9999])
ifTrue: [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 @ y extent: r width @ 1)
color: Color veryLightGray)
borderWidth: 0)]]!

----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'construction') -----
buildScalesIn: frame
| env hmajortick hminortick |
env := envelope.
pixPerTick := graphArea width // (self maxTime // 10) max: 1.
hminortick := 1 + (self maxTime // 800) * 10.
hmajortick := 1 + (self maxTime // 800) * 100.
hScale := (ScaleMorph
newBounds: (graphArea left @ frame top corner: (self xFromMs: self maxTime)
@ (graphArea top - 1)))
start: 0
stop: self maxTime
minorTick: hminortick
minorTickLength: 3
majorTick: hmajortick
majorTickLength: 10
caption: 'milliseconds'
tickPrintBlock: [:v | v printString].
self addMorph: hScale.
vScale := ScaleMorph
newBounds: (0 @ 0 extent: graphArea height @ (graphArea left - frame left)).
env name = '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: [env name = 'random pitch:'
ifTrue: [vScale
start: 0.9
stop: 1.1
minorTick: 0.2 / 50.0
minorTickLength: 3
majorTick: 0.2 / 5.0
majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v 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) - (2 @ 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 popUpEvent: evt in: self world!

----- 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]!

----- 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].
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 popUpEvent: evt in: self world!

----- 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: arg1 evt: arg2 envelope: arg3
(arg3 isMorph
and: [arg3 eventHandler notNil])
ifTrue: [arg3 eventHandler fixReversedValueMessages].
^ self
clickOn: arg1
evt: arg2
from: arg3!

----- 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
| 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' 'random pitch:' 'ratio' )
reject: [:x | (extant includes: x)
| (x = 'pitch'
& (extant includes: 'random pitch:')) | (x = 'random pitch:'
& (extant includes: 'pitch'))].
^ (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
(limits includes: ix)
ifTrue: [^ false].
1
to: limits size
do: [:i | (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 first
loopEnd: limits second.
^ true!

----- 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 |
(aSound respondsTo: #envelopes)
ifFalse: [UIManager default inform: 'You selected a ' , aSound class name , '.' , String cr , 'I can''t handle these kinds of sounds.'.
^ self].
sound := aSound.
sound envelopes isEmpty
ifTrue: [p := OrderedCollection new.
p add: 0 @ 0.0;
add: 10 @ 1.0;
add: 100 @ 1.0;
add: 120 @ 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
name = 'new...'
ifTrue: [^ self editNewSound].
soundName := name.
self editSound: (AbstractSound soundNamed: soundName) copy!

----- Method: EnvelopeEditorMorph>>extent: (in category 'geometry') -----
extent: newExtent
super
extent: (newExtent max: (self maxTime // 10 * 3 + 700 max: 500)
@ 350).
self buildView!

----- Method: EnvelopeEditorMorph>>handleOffset: (in category 'construction') -----
handleOffset: handle
^ 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.
soundName
ifNil: [soundName := 'test'].
self
editSound: (sound
ifNil: [FMSound brass1 copy]).
sound duration: 0.25.
denominator := 7.
self extent: 10 @ 10!

----- Method: EnvelopeEditorMorph>>insertPointAfter: (in category 'editing') -----
insertPointAfter: ix
| 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 | (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 first
loopEnd: limits second.
^ true!

----- Method: EnvelopeEditorMorph>>limitHandleMove:event:from: (in category 'editing') -----
limitHandleMove: index event: evt from: handle
| ix p x ms limIx points |
ix := limits at: index.
p := evt cursorPoint adhereTo: graphArea bounds.
ms := self msFromX: p x + (self handleOffset: handle) x.
sound envelopes
do: [:env |
limIx := env
perform: (#(#loopStartIndex #loopEndIndex #decayEndIndex ) at: index).
ms := self
constrain: ms
adjacentTo: limIx
in: env points].
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
(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>>playNothing (in category 'playing') -----
playNothing
^ self!

----- Method: EnvelopeEditorMorph>>readFileNamed: (in category 'menu') -----
readFileNamed: fileName
| snd |
snd := Compiler evaluate: (FileStream readOnlyFileNamed: fileName) contentsOfEntireFile.
soundName := fileName copyFrom: 1 to: fileName size - 4.
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 popUpEvent: evt in: self world!

----- Method: EnvelopeEditorMorph>>removeEnvelope (in category 'menu') -----
removeEnvelope
(UIManager default 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 := UIManager default 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.
true
ifTrue: [f nextChunkPut: 'AbstractSound soundNamed: ' , name , ' put: ' , snd storeString;
cr;
cr]
ifFalse: [self inform: name , ' is not currently storable']].
f close!

----- Method: EnvelopeEditorMorph>>saveSound: (in category 'menu') -----
saveSound: evt
| newName |
newName := UIManager default 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 := UIManager default 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 and presenter') -----
step
| mouseDown hand |
hand := self world firstHand.
(bounds containsPoint: hand position)
ifFalse: [^ self].
mouseDown := hand lastEvent redButtonPressed.
mouseDown not & prevMouseDown
ifTrue: [limitXs
= (limits
collect: [:i | (envelope points at: i) x])
ifFalse: [self editEnvelope: envelope]].
prevMouseDown := mouseDown!

----- Method: EnvelopeEditorMorph>>stepTime (in category 'testing') -----
stepTime
^ 100!

----- Method: EnvelopeEditorMorph>>valueFromY: (in category 'scaling') -----
valueFromY: y
| value |
value := (graphArea bottom - y) asFloat / graphArea height.
envelope updateSelector = #ratio:
ifTrue: [^ (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
^ 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.
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.
loopStart := (start / majorTick) ceiling * majorTick.
checkStart := (start / (majorTick / 2.0)) ceiling * 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
^ 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>>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]!

----- Method: EnvelopeLineMorph>>newVertex:event:fromHandle: (in category 'editing') -----
newVertex: ix event: evt fromHandle: handle
(owner insertPointAfter: ix)
ifFalse: [^ self].
super
newVertex: ix
event: evt
fromHandle: handle.
self
verticesAt: ix + 1
put: (owner acceptGraphPoint: evt cursorPoint at: ix + 1)!

----- Method: EnvelopeLineMorph>>vertices:borderWidth:borderColor: (in category 'as yet unclassified') -----
vertices: verts borderWidth: bw borderColor: bc
super initialize.
vertices := verts.
borderWidth := bw.
borderColor := bc.
closed := false.
arrows := #none.
self computeBounds!

_______________________________________________
etoys-dev mailing list
[hidden email]
http://lists.squeakland.org/mailman/listinfo/etoys-dev