[etoys-dev] Etoys Inbox: EnvelopeEditorRevival-kfr.2.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Oct 24 02:42:39 EDT 2012


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!



More information about the etoys-dev mailing list