[squeak-dev] The Trunk: MorphicExtras-bf.154.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Dec 8 00:55:26 UTC 2014


Bert Freudenberg uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-bf.154.mcz

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

Name: MorphicExtras-bf.154
Author: bf
Time: 8 December 2014, 1:54:44.666 am
UUID: b83c0228-72c9-47e4-b1c8-af7c988b16da
Ancestors: MorphicExtras-nice.153

Restore timestamps lost in assignment conversion.

=============== Diff against MorphicExtras-nice.153 ===============

Item was changed:
  ----- Method: AIFFFileReader>>edit (in category '*MorphicExtras-Sound') -----
  edit
  
  	| ed |
  	ed := WaveEditor new.
  	ed data: channelData first.
  	ed loopEnd: markers last last.
  	ed loopLength: (markers last last - markers first last) + 1.
  	ed openInWorld.
  !

Item was changed:
  ----- Method: AbstractMediaEventMorph>>justDroppedIntoPianoRoll:event: (in category 'piano rolls') -----
  justDroppedIntoPianoRoll: pianoRoll event: evt
  	
  	| ambientEvent |
  	startTimeInScore := pianoRoll timeForX: self left.
  
  	ambientEvent := AmbientEvent new 
  		morph: self;
  		time: startTimeInScore.
  
  	pianoRoll score addAmbientEvent: ambientEvent.
  
  	"self endTime > pianoRoll scorePlayer durationInTicks ifTrue:
  		[pianoRoll scorePlayer updateDuration]"
  !

Item was changed:
  ----- Method: EventRecorderMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category 'sound-piano rolls') -----
  addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime
  
  	| startX myDurationInTicks endX |
  
  	startX := pianoRoll xForTime: t.
  	myDurationInTicks := pianoRoll scorePlayer ticksForMSecs: self myDurationInMS.
  	t > rightTime ifTrue: [^ self].  
  	(t + myDurationInTicks) < leftTime ifTrue: [^ self].
  	endX := pianoRoll xForTime: t + myDurationInTicks.
  
  	morphList add: 
  		(self hResizing: #spaceFill; left: startX; width: endX - startX).
  
  !

Item was changed:
  ----- Method: EventRecorderMorph>>addVoiceControls (in category 'sound') -----
  addVoiceControls 
  
  	| levelSlider r meterBox |
  	voiceRecorder := SoundRecorder new
  		desiredSampleRate: 11025.0;		"<==try real hard to get the low rate"
  		codec: (GSMCodec new).		"<--this should compress better than ADPCM.. is it too slow?"
  		"codec: (ADPCMCodec new initializeForBitsPerSample: 4 samplesPerFrame: 0)."
  
  	levelSlider := SimpleSliderMorph new
  		color: color;
  		extent: 100 at 2;
  		target: voiceRecorder;
  		actionSelector: #recordLevel:;
  		adjustToValue: voiceRecorder recordLevel.
  	r := AlignmentMorph newRow
  		color: color;
  		layoutInset: 0;
  		wrapCentering: #center; cellPositioning: #leftCenter;
  		hResizing: #shrinkWrap;
  		vResizing: #rigid;
  		height: 24.
  	r addMorphBack: (StringMorph contents: '0 ').
  	r addMorphBack: levelSlider.
  	r addMorphBack: (StringMorph contents: ' 10').
  	self addMorphBack: r.
  
  	meterBox := Morph new extent: 102 at 18; color: Color gray.
  	recordMeter := Morph new extent: 1 at 16; color: Color yellow.
  	recordMeter position: meterBox topLeft + (1 at 1).
  	meterBox addMorph: recordMeter.
  
  	r := AlignmentMorph newRow vResizing: #shrinkWrap.
  	r addMorphBack: meterBox.
  	self addMorphBack: r.
  !

Item was changed:
  ----- Method: EventRecorderMorph>>justDroppedIntoPianoRoll:event: (in category 'sound-piano rolls') -----
  justDroppedIntoPianoRoll: newOwner event: evt
  	
  	| startX lengthInTicks endX startTimeInScore endTimeInScore |
  
  	super justDroppedIntoPianoRoll: newOwner event: evt.
  
  	startTimeInScore := newOwner timeForX: self left.
  	lengthInTicks := newOwner scorePlayer ticksForMSecs: self myDurationInMS.
  	endTimeInScore := startTimeInScore + lengthInTicks.
  
  	endTimeInScore > newOwner scorePlayer durationInTicks ifTrue:
  		[newOwner scorePlayer updateDuration].
  
  	startX := newOwner xForTime: startTimeInScore.
  	endX := newOwner xForTime: endTimeInScore.
  	self width: endX - startX.
  !

Item was changed:
  ----- Method: GraphMorph>>openWaveEditor (in category 'sound') -----
  openWaveEditor
  
  	| scaleFactor scaledData editor |
  	self data: data.  "make sure maxVal and minVal are current"
  	scaleFactor := 32767 // ((minVal abs max: maxVal abs) max: 1).
  	scaledData := SoundBuffer newMonoSampleCount: data size.
  	1 to: data size do: [:i | scaledData at: i put: (scaleFactor * (data at: i)) truncated].
  	editor := WaveEditor new
  		data: scaledData;
  		samplingRate: 11025;
  		perceivedFrequency: 220.0.
  	editor openInWorld.
  !

Item was changed:
  ----- Method: KeyboardMorphForInput>>addRecordingControls (in category 'initialization') -----
  addRecordingControls
  	| button switch playRow durRow articRow modRow |
  
  	"Add chord, rest and delete buttons"
  	playRow := AlignmentMorph newRow.
  	playRow color: color; borderWidth: 0; layoutInset: 0.
  	playRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	playRow addMorphBack: (switch label: 'chord' translated; actionSelector: #buildChord:).
  	button := SimpleButtonMorph new target: self;
  		borderColor: #raised; borderWidth: 2; color: color.
  	playRow addMorphBack: (button label: '          rest          ' translated; actionSelector: #emitRest).
  	button := SimpleButtonMorph new target: self;
  		borderColor: #raised; borderWidth: 2; color: color.
  	playRow addMorphBack: (button label: 'del' translated; actionSelector: #deleteNotes).
  	self addMorph: playRow.
  	playRow align: playRow fullBounds topCenter
  			with: self fullBounds bottomCenter.
  
  	"Add note duration buttons"
  	durRow := AlignmentMorph newRow.
  	durRow color: color; borderWidth: 0; layoutInset: 0.
  	durRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	durRow addMorphBack: (switch label: 'whole' translated;
  				actionSelector: #duration:onOff:; arguments: #(1)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	durRow addMorphBack: (switch label: 'half' translated;
  				actionSelector: #duration:onOff:; arguments: #(2)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	durRow addMorphBack: (switch label: 'quarter' translated;
  				actionSelector: #duration:onOff:; arguments: #(4)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	durRow addMorphBack: (switch label: 'eighth' translated;
  				actionSelector: #duration:onOff:; arguments: #(8)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	durRow addMorphBack: (switch label: 'sixteenth' translated;
  				actionSelector: #duration:onOff:; arguments: #(16)).
  	self addMorph: durRow.
  	durRow align: durRow fullBounds topCenter
  			with: playRow fullBounds bottomCenter.
  
  	"Add note duration modifier buttons"
  	modRow := AlignmentMorph newRow.
  	modRow color: color; borderWidth: 0; layoutInset: 0.
  	modRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	modRow addMorphBack: (switch label: 'dotted' translated;
  				actionSelector: #durMod:onOff:; arguments: #(dotted)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	modRow addMorphBack: (switch label: 'normal' translated;
  				actionSelector: #durMod:onOff:; arguments: #(normal)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	modRow addMorphBack: (switch label: 'triplets' translated;
  				actionSelector: #durMod:onOff:; arguments: #(triplets)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	modRow addMorphBack: (switch label: 'quints' translated;
  				actionSelector: #durMod:onOff:; arguments: #(quints)).
  	self addMorph: modRow.
  	modRow align: modRow fullBounds topCenter
  			with: durRow fullBounds bottomCenter.
  
  	"Add articulation buttons"
  	articRow := AlignmentMorph newRow.
  	articRow color: color; borderWidth: 0; layoutInset: 0.
  	articRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	articRow addMorphBack: (switch label: 'legato' translated;
  				actionSelector: #articulation:onOff:; arguments: #(legato)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	articRow addMorphBack: (switch label: 'normal' translated;
  				actionSelector: #articulation:onOff:; arguments: #(normal)).
  	switch := SimpleSwitchMorph new target: self; borderWidth: 2;
  		offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false.
  	articRow addMorphBack: (switch label: 'staccato' translated;
  				actionSelector: #articulation:onOff:; arguments: #(staccato)).
  	self addMorph: articRow.
  	articRow align: articRow fullBounds topCenter
  			with: modRow fullBounds bottomCenter.
  
  	self bounds: (self fullBounds expandBy: (0 at 0 extent: 0 at borderWidth))
  !

Item was changed:
  ----- Method: KeyboardMorphForInput>>articulation:onOff: (in category 'note controls') -----
  articulation: artic onOff: ignored    "artic = eg, #legato, #normal, #staccato."
  	"Set the articulation of notes to be emitted when a key is pressed."
  
  	self allMorphsDo:
  		[:m | ((m isMemberOf: SimpleSwitchMorph)
  				and: [m actionSelector == #articulation:onOff:])
  				ifTrue: [m setSwitchState: m arguments first == artic]].
  	articulation := artic!

Item was changed:
  ----- Method: KeyboardMorphForInput>>durMod:onOff: (in category 'note controls') -----
  durMod: durMod onOff: ignored    "durMod = eg, #dotted, #normal, #triplets, #quints"
  	"Set the duration of notes to be emitted when a key is pressed."
  
  	self allMorphsDo:
  		[:m | ((m isMemberOf: SimpleSwitchMorph)
  				and: [m actionSelector == #durMod:onOff:])
  				ifTrue: [m setSwitchState: m arguments first = durMod]].
  	durationModifier := durMod!

Item was changed:
  ----- Method: KeyboardMorphForInput>>duration:onOff: (in category 'note controls') -----
  duration: denom onOff: ignored    "denom = eg, 1, 2, 4, 8, 16"
  	"Set the duration of notes to be emitted when a key is pressed."
  
  	self allMorphsDo:
  		[:m | ((m isMemberOf: SimpleSwitchMorph)
  				and: [m actionSelector == #duration:onOff:])
  				ifTrue: [m setSwitchState: m arguments first = denom]].
  	duration := denom.
  	self durMod: #normal onOff: true!

Item was changed:
  ----- Method: KeyboardMorphForInput>>emitRest (in category 'note controls') -----
  emitRest
  
  	| sel noteEvent |
  
  	"All this selection logic should be shared with mouseDown..."
  	(sel := pianoRoll selection) ifNil: [^ self].
  	insertMode ifTrue:
  		[sel := pianoRoll selectionForInsertion.
  		insertMode := false].
  	sel = prevSelection ifFalse:
  		["This is a new selection -- need to determine start time"
  		sel third = 0
  			ifTrue: [startOfNextNote := 0]
  			ifFalse: [startOfNextNote := ((pianoRoll score tracks at: sel first)
  										at: sel third) endTime.
  					startOfNextNote := startOfNextNote + self fullDuration - 1
  										truncateTo: self fullDuration]].
  	noteEvent := NoteEvent new time: startOfNextNote; duration: self noteDuration;
  			key: -1 "my flag for rest" velocity: self velocity channel: 1.
  	pianoRoll appendEvent: noteEvent fullDuration: self fullDuration.
  	soundPlaying ifNotNil: [soundPlaying stopGracefully].
  	prevSelection := pianoRoll selection.
  	startOfNextNote := startOfNextNote + self fullDuration.!

Item was changed:
  ----- Method: KeyboardMorphForInput>>fullDuration (in category 'note controls') -----
  fullDuration
  
  	| num denom |
  	num := denom := 1.
  	durationModifier == #dotted ifTrue: [num := 3.  denom := 2].
  	durationModifier == #triplets ifTrue: [num := 2.  denom := 3].
  	durationModifier == #quints ifTrue: [num := 2.  denom := 5].
  	^ pianoRoll score ticksPerQuarterNote * 4 * num // duration // denom!

Item was changed:
  ----- Method: KeyboardMorphForInput>>initialize (in category 'initialization') -----
  initialize
  "initialize the state of the receiver"
  	super initialize.
  ""
  	buildingChord := false.
  	self addRecordingControls.
  	self duration: 4 onOff: true.
  	self durMod: #normal onOff: true.
  	self articulation: #normal onOff: true.
  	insertMode := false!

Item was changed:
  ----- Method: KeyboardMorphForInput>>mouseDownPitch:event:noteMorph: (in category 'simple keyboard') -----
  mouseDownPitch: midiKey event: event noteMorph: keyMorph
  
  	| sel noteEvent |
  	event hand hasSubmorphs ifTrue: [^ self  "no response if drag something over me"].
  	keyMorph color: playingKeyColor.
  	(sel := pianoRoll selection) ifNil: [^ self].
  	insertMode ifTrue:
  		[sel := pianoRoll selectionForInsertion.
  		insertMode := false].
  	sel = prevSelection ifFalse:
  		["This is a new selection -- need to determine start time"
  		sel third = 0
  			ifTrue: [startOfNextNote := 0]
  			ifFalse: [startOfNextNote := ((pianoRoll score tracks at: sel first)
  										at: sel third) endTime.
  					startOfNextNote := startOfNextNote + self fullDuration - 1
  										truncateTo: self fullDuration]].
  	noteEvent := NoteEvent new time: startOfNextNote; duration: self noteDuration;
  			key: midiKey + 23 velocity: self velocity channel: 1.
  	pianoRoll appendEvent: noteEvent fullDuration: self fullDuration.
  	soundPlaying ifNotNil: [soundPlaying stopGracefully].
  	(soundPlaying := self soundForEvent: noteEvent inTrack: sel first) play.
  	prevSelection := pianoRoll selection.
  	startOfNextNote := startOfNextNote + self fullDuration.!

Item was changed:
  ----- Method: KeyboardMorphForInput>>pianoRoll: (in category 'initialization') -----
  pianoRoll: prMorph
  
  	pianoRoll := prMorph!

Item was changed:
  ----- Method: KeyboardMorphForInput>>soundForEvent:inTrack: (in category 'events') -----
  soundForEvent: noteEvent inTrack: trackIndex
  
  	| sound player |
  	player := pianoRoll scorePlayer.
  	sound := MixedSound new.
  	sound add: ((player instrumentForTrack: trackIndex)
  					soundForMidiKey: noteEvent midiKey
  					dur: noteEvent duration / (pianoRoll scorePlayer ticksForMSecs: 1000)
  					loudness: (noteEvent velocity asFloat / 127.0))
  			pan: (player panForTrack: trackIndex)
  			volume: player overallVolume *
  						(player volumeForTrack: trackIndex).
  	^ sound
  !

Item was changed:
  ----- Method: LoopedSampledSound>>edit (in category '*MorphicExtras-Sound') -----
  edit
  	"Open a WaveEditor on this sound."
  
  	| loopLen ed |
  	loopLen := scaledLoopLength asFloat / LoopIndexScaleFactor.
  	ed := WaveEditor new
  		data: leftSamples;
  		samplingRate: originalSamplingRate;
  		loopEnd: loopEnd;
  		loopLength: loopLen;
  		loopCycles: (loopLen / (originalSamplingRate asFloat / perceivedPitch)) rounded.
  	ed openInWorld.
  !

Item was changed:
  ----- Method: ObjectOut>>xxxFixup (in category 'fetch from disk') -----
  xxxFixup
  	"There is already an object in memory for my url.  All pointers to me need to be pointers to him.  Can't use become, because other pointers to him must stay valid."
  
  	| real temp list |
  	real := page contentsMorph.
  	real == self ifTrue: [page error: 'should be converted by now'].
  	temp := self.
  	list := (PointerFinder pointersTo: temp) asOrderedCollection.
  	list add: thisContext.  list add: thisContext sender.
  	list do: [:holder |
  		1 to: holder class instSize do:
  			[:i | (holder instVarAt: i) == temp ifTrue: [holder instVarAt: i put: real]].
  		1 to: holder basicSize do:
  			[:i | (holder basicAt: i) == temp ifTrue: [holder basicAt: i put: real]].
  		].
  	^ real!

Item was changed:
  ----- Method: PianoRollScoreMorph>>appendEvent:fullDuration: (in category 'editing') -----
  appendEvent: noteEvent fullDuration: fullDuration 
  
  	| sel x |
  	score appendEvent: noteEvent fullDuration: fullDuration at: (sel := self selection).
  	noteEvent midiKey = -1 ifFalse:  "Unless it is a rest..."
  		["Advance the selection to the note just entered"
  		selection := Array with: sel first with: sel third + 1 with: sel third + 1].
  
  	"This is all horribly inefficient..."
  	scorePlayer updateDuration.
  	(x := self xForTime: noteEvent endTime) > (self right - 30) ifTrue:
  		[self autoScrollForX: x + (30 + self width // 4)].
  	self updateLowestNote.
  	self rebuildFromScore!

Item was changed:
  ----- Method: PianoRollScoreMorph>>autoScrollForX: (in category 'scrolling') -----
  autoScrollForX: x
  	"Scroll by the amount x lies outside of my innerBounds.  Return true if this happens."
  
  	| d ticks |
  	((d := x - self innerBounds right) > 0
  		or: [(d := x - self innerBounds left) < 0])
  		ifTrue: [ticks := (self timeForX: self bounds center x + d+1)
  						min: score durationInTicks max: 0.
  				self moveCursorToTime: ticks.
  				scorePlayer ticksSinceStart: ticks.
  				^ true].
  	^ false
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>beatLinesOnOff (in category 'menu') -----
  beatLinesOnOff
  
  	showBeatLines := showBeatLines not.
  	self changed!

Item was changed:
  ----- Method: PianoRollScoreMorph>>contractTime (in category 'geometry') -----
  contractTime
  
  	timeScale := timeScale / 1.5.
  	self rebuildFromScore.
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>drawMeasureLinesOn: (in category 'drawing') -----
  drawMeasureLinesOn: aCanvas
  
  	| ticksPerMeas x measureLineColor inner |
  	showBeatLines ifNil: [showBeatLines := false].
  	showMeasureLines ifNil: [showMeasureLines := true].
  	notePerBeat ifNil: [self timeSignature: 4 over: 4].
  	showBeatLines ifTrue:
  		[measureLineColor := Color gray: 0.8.
  		ticksPerMeas := score ticksPerQuarterNote.
  		inner := self innerBounds.
  		(leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas)
  			to: ((self timeForX: self right - borderWidth) truncateTo: ticksPerMeas)
  			by: ticksPerMeas
  			do: [:tickTime | x := self xForTime: tickTime.
  				aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height)
  					color: measureLineColor]].
  
  	showMeasureLines ifTrue:
  		[measureLineColor := Color gray: 0.7.
  		ticksPerMeas := beatsPerMeasure*score ticksPerQuarterNote*4//notePerBeat.
  		inner := self innerBounds.
  		(leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas)
  			to: ((self timeForX: self right - borderWidth) truncateTo: ticksPerMeas)
  			by: ticksPerMeas
  			do: [:tickTime | x := self xForTime: tickTime.
  				aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height)
  						color: (tickTime = 0 ifTrue: [Color black] ifFalse: [measureLineColor])]].
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>drawStaffOn: (in category 'drawing') -----
  drawStaffOn: aCanvas
  
  	| blackKeyColor l r topEdge y |
  	self drawMeasureLinesOn: aCanvas.
  
  	blackKeyColor := Color gray: 0.5.
  	l := self left + borderWidth.
  	r := self right - borderWidth.
  	topEdge := self top + borderWidth + 3.
  	lowestNote to: 127 do: [:k |
  		y := self yForMidiKey: k.
  		y <= topEdge ifTrue: [^ self].  "over the top!!"
  		(self isBlackKey: k) ifTrue: [
  			aCanvas
  				fillRectangle: (l at y corner: r@(y + 1))
  				color: blackKeyColor]].
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>expandTime (in category 'geometry') -----
  expandTime
  
  	timeScale := timeScale * 1.5.
  	self rebuildFromScore.
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>fullBounds (in category 'layout') -----
  fullBounds
  	"Overridden to clip submorph hit detection to my bounds."
  
  	fullBounds ifNil: [fullBounds := bounds].
  	^ bounds
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>goToTime: (in category 'scrolling') -----
  goToTime: scoreTime
  
  	| track trackSize index newLeftEdgeTime |
  	newLeftEdgeTime := scoreTime asInteger.
  	newLeftEdgeTime < leftEdgeTime
  		ifTrue: [indexInTrack := Array new: score tracks size+1 withAll: 1].
  	leftEdgeTime := newLeftEdgeTime.
  	1 to: score tracks size do: [:trackIndex |
  		track := score tracks at: trackIndex.
  		index := indexInTrack at: trackIndex.
  		trackSize := track size.
  		[(index < trackSize) and:
  		 [(track at: index) endTime < leftEdgeTime]]
  			whileTrue: [index := index + 1].
  		indexInTrack at: trackIndex put: index].
  	self addNotes.
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>initialize (in category 'initialization') -----
  initialize
  	"initialize the state of the receiver"
  	super initialize.
  	""
  	
  	self extent: 400 @ 300.
  	showMeasureLines := true.
  	showBeatLines := false.
  	self timeSignature: 4 over: 4.
  	self clipSubmorphs: true!

Item was changed:
  ----- Method: PianoRollScoreMorph>>invokeScoreMenu: (in category 'menu') -----
  invokeScoreMenu: evt
  	"Invoke the score's edit menu."
  
  	| menu subMenu |
  	menu := MenuMorph new defaultTarget: self.
  	menu addList:
  		{{'cut' translated.		#cutSelection}.
  		{'copy' translated.		#copySelection}.
  		{'paste' translated.		#insertSelection}.
  		{'paste...' translated.		#insertTransposed}}.
  	menu addLine.
  	menu addList:
  		{{'legato' translated.		#selectionBeLegato}.
  		{'staccato' translated.	#selectionBeStaccato}.
  		{'normal' translated.		#selectionBeNormal}}.
  	menu addLine.
  	menu addList:
  		{{'expand time' translated.		#expandTime}.
  		{'contract time' translated.		#contractTime}}.
  	menu addLine.
  	subMenu := MenuMorph new defaultTarget: self.
  		(2 to: 12) do: [:i | subMenu add: i printString selector: #beatsPerMeasure: argument: i].
  		menu add: 'time   ' translated, beatsPerMeasure printString subMenu: subMenu.
  	subMenu := MenuMorph new defaultTarget: self.
  		#(2 4 8) do: [:i | subMenu add: i printString selector: #notePerBeat: argument: i].
  		menu add: 'sig     ' translated, notePerBeat printString subMenu: subMenu.
  	menu addLine.
  	showMeasureLines
  		ifTrue: [menu add: 'hide measure lines' translated action: #measureLinesOnOff]
  		ifFalse: [menu add: 'show measure lines' translated action: #measureLinesOnOff].
  	showBeatLines
  		ifTrue: [menu add: 'hide beat lines' translated action: #beatLinesOnOff]
  		ifFalse: [menu add: 'show beat lines' translated action: #beatLinesOnOff].
  
  	menu addLine.
  	menu add: 'add keyboard' translated action: #addKeyboard.
  
  	menu popUpEvent: evt in: self world.
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>isBlackKey: (in category 'drawing') -----
  isBlackKey: midiKey
  	"Answer true if the given MIDI key corresponds to a black key on the piano keyboard."
  
  	| note |
  	note := midiKey \\ 12.
  	note = 1 ifTrue: [^ true].
  	note = 3 ifTrue: [^ true].
  	note = 6 ifTrue: [^ true].
  	note = 8 ifTrue: [^ true].
  	note = 10 ifTrue: [^ true].
  	^ false
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>measureLinesOnOff (in category 'menu') -----
  measureLinesOnOff
  
  	showMeasureLines := showMeasureLines not.
  	self changed!

Item was changed:
  ----- Method: PianoRollScoreMorph>>mouseUp: (in category 'event handling') -----
  mouseUp: evt
  
  	soundsPlayingMorph ifNotNil: [soundsPlayingMorph delete].
  	soundsPlaying ifNotNil: [soundsPlaying do: [:s | s stopGracefully]].
  	soundsPlayingMorph := soundsPlaying := nil
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>moveCursorToTime: (in category 'scrolling') -----
  moveCursorToTime: scoreTime
  
  	| cursorOffset desiredCursorHeight |
  	scorePlayer isPlaying
  		ifTrue:
  			[cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger.
  			(cursorOffset < 0
  				or: [cursorOffset > (self width-20)])
  				ifTrue:
  				[self goToTime: scoreTime - (20/timeScale).
  				cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]]
  		ifFalse:
  			[self goToTime: (scoreTime - (self width//2 / timeScale)
  							max: (self width//10 / timeScale) negated).
  			cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger].
  
  	cursor position: (self left + borderWidth + cursorOffset)@(self top + borderWidth).
  	desiredCursorHeight := self height.
  	cursor height ~= desiredCursorHeight ifTrue: [cursor extent: 1 at desiredCursorHeight].
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>movieClipPlayer: (in category 'accessing') -----
  movieClipPlayer: moviePlayer
  
  	movieClipPlayer := moviePlayer
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>on: (in category 'initialization') -----
  on: aScorePlayer
  
  	scorePlayer := aScorePlayer.
  	score := aScorePlayer score.
  	colorForTrack := Color wheel: score tracks size.
  	leftEdgeTime := 0.
  	timeScale := 0.1.
  	indexInTrack := Array new: score tracks size withAll: 1.
  	lastUpdateTick := -1.
  
  	self updateLowestNote
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>removedMorph: (in category 'private') -----
  removedMorph: aMorph
  	| trackSize |
  	trackSize := score ambientTrack size.
  	score removeAmbientEventWithMorph: aMorph.
  	trackSize = score ambientTrack size ifFalse:
  		["Update duration if we removed an event"
  		scorePlayer updateDuration].
  	^super removedMorph: aMorph!

Item was changed:
  ----- Method: PianoRollScoreMorph>>selection (in category 'accessing') -----
  selection
  	"Returns an array of 3 elements:
  		trackIndex
  		indexInTrack of first note
  		indexInTrack of last note"
  
  	| trackIndex track |
  	selection ifNil:  "If no selection, return last event of 1st non-muted track (or nil)"
  		[trackIndex := (1 to: score tracks size)
  			detect: [:i | (scorePlayer mutedForTrack: i) not] ifNone: [^ nil].
  		track := score tracks at: trackIndex.
  		^ Array with: trackIndex with: track size with: track size].
  	(scorePlayer mutedForTrack: selection first)
  		ifTrue: [selection := nil.  ^ self selection].
  	^ selection!

Item was changed:
  ----- Method: PianoRollScoreMorph>>selection: (in category 'accessing') -----
  selection: anArray
  
  	selection := anArray!

Item was changed:
  ----- Method: PianoRollScoreMorph>>step (in category 'stepping and presenter') -----
  step
  
  	| t |
  	score ifNil: [^ self].
  
  	lastMutedState ~= scorePlayer mutedState ifTrue: [
  		self rebuildFromScore.
  		lastMutedState := scorePlayer mutedState copy].
  
  	t := scorePlayer ticksSinceStart.
  	t = lastUpdateTick ifFalse: [
  		self moveCursorToTime: t.
  		lastUpdateTick := t].
  !

Item was changed:
  ----- Method: PianoRollScoreMorph>>timeSignature:over: (in category 'accessing') -----
  timeSignature: num over: denom
  
  	beatsPerMeasure := num.
  	notePerBeat := denom.  "a number like 2, 4, 8"
  	self changed!

Item was changed:
  ----- Method: ProjectNavigationMorph>>buttonSound (in category '*MorphicExtras-Sound') -----
  buttonSound
  
  	| myButton m |
  
  	myButton := RectangleMorph new 
  		borderWidth: 1;
  		cornerStyle: #rounded;
  		borderColor: #raised;
  		color: self colorForButtons;
  		setBalloonText: 'Change sound volume' translated;
  		on: #mouseDown send: #soundDownEvt:morph: to: self;
  		on: #mouseStillDown send: #soundStillDownEvt:morph: to: self;
  		on: #mouseUp send: #soundUpEvt:morph: to: self;
  		yourself.
  
  	myButton addMorph: (m := self speakerIcon lock).
  	myButton extent: m extent + (myButton borderWidth + 6).
  	m position: myButton center - (m extent // 2).
  	^myButton
  !

Item was changed:
  ----- Method: ProjectNavigationMorph>>soundDownEvt:morph: (in category '*MorphicExtras-Sound') -----
  soundDownEvt: a morph: b
  
  	soundSlider ifNotNil: [soundSlider delete].
  	(soundSlider := RectangleMorph new)
  		setProperty: #morphicLayerNumber toValue: 1;
  		extent: b width @ (b width * 3);
  		color: self colorForButtons;
  		borderColor: #raised;
  		bottomLeft: b boundsInWorld origin.
  	soundSlider addMorph: (
  		RectangleMorph new
  			color: self colorForButtons;
  			borderColor: #raised;
  			extent: b width @ 8;
  			center: soundSlider center x @ 
  				(soundSlider bottom - (soundSlider height * self getSoundVolume) asInteger)
  	).
  	soundSlider openInWorld.!

Item was changed:
  ----- Method: ProjectNavigationMorph>>soundStillDownEvt:morph: (in category '*MorphicExtras-Sound') -----
  soundStillDownEvt: evt morph: b
  
  	| y pct |
  
  	soundSlider ifNil: [^self].
  	y := evt hand position y.
  	(y between: soundSlider top and: soundSlider bottom) ifTrue: [
  		pct := (soundSlider bottom - y) asFloat / soundSlider height.
  		self setSoundVolume: pct.
  		soundSlider firstSubmorph top: y - 5.
  	]. 
  !

Item was changed:
  ----- Method: ProjectNavigationMorph>>soundUpEvt:morph: (in category '*MorphicExtras-Sound') -----
  soundUpEvt: a morph: b
  
  	soundSlider ifNotNil: [soundSlider delete].
  	soundSlider := nil.
  	Beeper beep !

Item was changed:
  ----- Method: String>>asPostscript (in category '*MorphicExtras-*morphic-Postscript Canvases') -----
  asPostscript
  
  	| temp |
  	temp := self asString copyReplaceAll: '(' with: '\('.
  	temp := temp copyReplaceAll: ')' with: '\)'.
  	temp := temp copyReplaceAll: '
  ' 
  			with: ''.
  	^ PostscriptEncoder mapMacStringToPS: temp!

Item was changed:
  ----- Method: ZASMCameraMarkMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category 'piano rolls') -----
  addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime
  
  	| startX pseudoEndTime |
  
  	startX := pianoRoll xForTime: startTimeInScore.
  	pseudoEndTime := pianoRoll timeForX: startX + self width.
  	startTimeInScore > rightTime ifTrue: [^ self].  
  	pseudoEndTime < leftTime ifTrue: [^ self].
  
  	morphList add: 
  		(self align: self bottomLeft
  			with: startX @ self bottom).
  
  !

Item was changed:
  ----- Method: ZASMCameraMarkMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'piano rolls') -----
  encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick
  
  	| nextAmbient m nextDurationInMs program now finalMark thisPage nextPage |
  
  	self gotoMark.
  	nextAmbient := nil.
  	index to: track size do: [ :i |
  		(nextAmbient isNil and: [((m := track at: i) morph) isKindOf: self class]) ifTrue: [
  			nextAmbient := m.
  		].
  	].
  	nextAmbient ifNil: [^self].
  	nextDurationInMs := (nextAmbient time - ticks * secsPerTick * 1000) rounded.
  	finalMark := nextAmbient morph.
  	thisPage := self valueOfProperty: #bookPage.
  	nextPage := finalMark valueOfProperty: #bookPage.
  	(thisPage = nextPage or: [thisPage isNil | nextPage isNil]) ifFalse: [^finalMark gotoMark].
  	now := Time millisecondClockValue.
  	program := Dictionary new.
  	program
  		at: #startTime put: now;
  		at: #endTime put: now + nextDurationInMs;
  		at: #startPoint put: (self valueOfProperty: #cameraPoint);
  		at: #endPoint put: (finalMark valueOfProperty: #cameraPoint);
  		at: #startZoom put: (self valueOfProperty: #cameraScale);
  		at: #endZoom put: (finalMark valueOfProperty: #cameraScale).
  
  	self cameraController setProgrammedMoves: {program}.
  
  !



More information about the Squeak-dev mailing list