Squeak-dev July 2013

squeak-dev@lists.squeakfoundation.org

50 participants
342 discussions

The Inbox: Kernel-cmm.761.mcz
by commits＠source.squeak.org 05 Jul '13

05 Jul '13

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-cmm.761.mcz ==================== Summary ==================== Name: Kernel-cmm.761 Author: cmm Time: 4 July 2013, 9:01:30.236 pm UUID: b9aaab83-9dfc-4c4f-a4e6-203167954cc1 Ancestors: Kernel-cmm.760 - Introduce AttributableObject, an abstract class whose subclass instances allow a variable number of attributes to be set and accessed at run time. =============== Diff against Kernel-cmm.760 =============== Item was added: + Object subclass: #AttributableObject + instanceVariableNames: 'attributes' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Models'! + + !AttributableObject commentStamp: 'cmm 10/7/2009 21:03' prior: 0! + Subclass from this abstract class to inherit an attribute Dictionary.! Item was added: + ----- Method: AttributableObject>>attributeNamed: (in category 'attributes') ----- + attributeNamed: aString + ^ attributes ifNotNil: + [ attributes + at: aString + ifAbsent: [ nil ] ]! Item was added: + ----- Method: AttributableObject>>attributeNamed:put: (in category 'attributes') ----- + attributeNamed: aString put: anObject + anObject ifNotNil: [ attributes ifNil: [ attributes := Dictionary new ] ]. + ^ anObject + ifNil: + [ self removeAttributeNamed: aString. + anObject ] + ifNotNil: + [ attributes + at: aString + put: anObject ]! Item was added: + ----- Method: AttributableObject>>attributesToDeepCopy (in category 'copying') ----- + attributesToDeepCopy + "Subclasses override." + ^ attributes + ifNil: [ Array empty ] + ifNotNil: [ attributes keys ]! Item was added: + ----- Method: AttributableObject>>removeAttributeNamed: (in category 'attributes') ----- + removeAttributeNamed: aString + ^ attributes ifNotNil: + [ | answer | + answer := attributes + removeKey: aString + ifAbsent: [ nil ]. + attributes ifEmpty: [ attributes := nil ]. + answer ]! Item was added: + ----- Method: AttributableObject>>veryDeepInner: (in category 'copying') ----- + veryDeepInner: aDeepCopier + super veryDeepInner: aDeepCopier. + attributes := attributes copy. + self attributesToDeepCopy do: + [ : eachAttribute | attributes + at: eachAttribute + ifPresent: + [ : value | attributes + at: eachAttribute + put: (value veryDeepCopyWith: aDeepCopier) ] + ifAbsent: [ self error: eachAttribute, ' is not an attribute.' ] ]!

1 0

Daily Commit Log
by commits＠source.squeak.org 05 Jul '13

05 Jul '13

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2013-July/006130.html Name: ReleaseBuilder-fbs.100 Ancestors: ReleaseBuilder-fbs.99 Log more during the release process. Use stdout because running this from a command line is the most common use case. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-July/006131.html Name: ST80Tests-fbs.1 Ancestors: ST-80's very own test suite. For now, just test that ST-80's package dependencies are as expected. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-July/006132.html Name: MorphicExtras-fbs.113 Ancestors: MorphicExtras-fbs.112 Sound -/-> MorphicExtras. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-July/006133.html Name: Morphic-fbs.663 Ancestors: Morphic-fbs.662 Sound -/-> Morphic. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-July/006134.html Name: Sound-fbs.35 Ancestors: Sound-nice.34 Sound -/-> {MorphicExtras. Morphic}. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-July/006135.html Name: Tests-fbs.234 Ancestors: Tests-fbs.233 Sound -/-> {MorphicExtras. Morphic}. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-July/006136.html Name: Tests-fbs.235 Ancestors: Tests-fbs.234 ST80Tests now defines this test. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2013-July/006137.html Name: System-fbs.557 Ancestors: System-fbs.556 Using #at:ifPresent: means never having to say KeyNotFound. =============================================

1 0

The Trunk: System-fbs.557.mcz
by commits＠source.squeak.org 04 Jul '13

04 Jul '13

Frank Shearar uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-fbs.557.mcz ==================== Summary ==================== Name: System-fbs.557 Author: fbs Time: 4 July 2013, 8:34:50.016 pm UUID: dc5bb9ff-688b-5a4c-a756-c096700f9f47 Ancestors: System-fbs.556 Using #at:ifPresent: means never having to say KeyNotFound. =============== Diff against System-fbs.556 =============== Item was changed: ----- Method: SmalltalkImage>>presumedSentMessages (in category 'shrinking') ----- presumedSentMessages | sent | "Smalltalk presumedSentMessages" "The following should be preserved for doIts, etc" sent := IdentitySet new. #(compactSymbolTable rebuildAllProjects browseAllSelect: lastRemoval scrollBarValue: vScrollBarValue: scrollBarMenuButtonPressed: withSelectionFrom: to: removeClassNamed: dragon: hilberts: mandala: web test3 factorial tinyBenchmarks benchFib newDepth: restoreAfter: zapAllMethods obsoleteClasses removeAllUnSentMessages abandonSources removeUnreferencedKeys reclaimDependents zapOrganization condenseChanges browseObsoleteReferences subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: methodsFor:stamp: methodsFor:stamp:prior: instanceVariableNames: startTimerInterruptWatcher unusedClasses) do: [:sel | sent add: sel]. "The following may be sent by perform: in dispatchOnChar..." + Smalltalk at: #ParagraphEditor ifPresent: [:paragraphEditor | - (Smalltalk at: #ParagraphEditor) ifNotNilDo: [:paragraphEditor | (paragraphEditor classPool at: #CmdActions) asSet do: [:sel | sent add: sel]. (paragraphEditor classPool at: #ShiftCmdActions) asSet do: [:sel | sent add: sel]]. ^ sent!

1 0

The Trunk: Tests-fbs.235.mcz
by commits＠source.squeak.org 04 Jul '13

04 Jul '13

Frank Shearar uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-fbs.235.mcz ==================== Summary ==================== Name: Tests-fbs.235 Author: fbs Time: 4 July 2013, 8:24:10.467 pm UUID: 208f0f37-7aa8-d244-85f4-48b55717dc6b Ancestors: Tests-fbs.234 ST80Tests now defines this test. =============== Diff against Tests-fbs.234 =============== Item was removed: - ----- Method: PackageDependencyTest>>testST80 (in category 'tests') ----- - testST80 - self testPackage: 'ST80' dependsExactlyOn: #( - Collections - Compiler - Files - Graphics - Kernel - Morphic - Multilingual - Network - SUnit - System - 'ToolBuilder-Kernel' - Tools - ).!

1 0

The Trunk: Tests-fbs.234.mcz
by commits＠source.squeak.org 04 Jul '13

04 Jul '13

Frank Shearar uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-fbs.234.mcz ==================== Summary ==================== Name: Tests-fbs.234 Author: fbs Time: 4 July 2013, 8:22:53.045 pm UUID: c7fb7220-2522-7345-85de-83f11c22e4d6 Ancestors: Tests-fbs.233 Sound -/-> {MorphicExtras. Morphic}. =============== Diff against Tests-fbs.233 =============== Item was changed: ----- Method: PackageDependencyTest>>testSound (in category 'tests') ----- testSound self testPackage: 'Sound' dependsExactlyOn: #( Collections Balloon Files Graphics Kernel - Morphic - MorphicExtras Network System 'ToolBuilder-Kernel' ).!

1 0

The Trunk: Sound-fbs.35.mcz
by commits＠source.squeak.org 04 Jul '13

04 Jul '13

Frank Shearar uploaded a new version of Sound to project The Trunk: http://source.squeak.org/trunk/Sound-fbs.35.mcz ==================== Summary ==================== Name: Sound-fbs.35 Author: fbs Time: 4 July 2013, 8:22:16.977 pm UUID: 51079db1-4e3d-1747-90b2-4b72fe3c96fe Ancestors: Sound-nice.34 Sound -/-> {MorphicExtras. Morphic}. =============== Diff against Sound-nice.34 =============== Item was removed: - ----- Method: AIFFFileReader>>edit (in category 'other') ----- - 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 removed: - ----- Method: AbstractMediaEventMorph>>justDroppedIntoPianoRoll:event: (in category '*sound-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 removed: - ----- Method: AbstractSound class>>updateScorePlayers (in category 'sound library-file in/out') ----- - updateScorePlayers - | soundsBeingEdited | - "Force all ScorePlayers to update their instrument list from the sound library. This may done after loading, unloading, or replacing a sound to make all ScorePlayers feel the change." - - ScorePlayer allSubInstancesDo: - [:p | p pause]. - SoundPlayer shutDown. - soundsBeingEdited := EnvelopeEditorMorph allSubInstances collect: [:ed | ed soundBeingEdited]. - ScorePlayerMorph allSubInstancesDo: - [:p | p updateInstrumentsFromLibraryExcept: soundsBeingEdited]. - ! Item was removed: - ----- Method: AbstractSound>>viewSamples (in category 'playing') ----- - viewSamples - "Open a WaveEditor on my samples." - - WaveEditor openOn: self samples. - ! Item was removed: - ----- Method: BookPageThumbnailMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category '*sound-piano rolls') ----- - encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick - "Flip to this page with no extra sound" - BookMorph turnOffSoundWhile: [self doPageFlip]! Item was removed: - ----- 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 removed: - ----- 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@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@18; color: Color gray. - recordMeter := Morph new extent: 1@16; color: Color yellow. - recordMeter position: meterBox topLeft + (1@1). - meterBox addMorph: recordMeter. - - r := AlignmentMorph newRow vResizing: #shrinkWrap. - r addMorphBack: meterBox. - self addMorphBack: r. - ! Item was removed: - ----- Method: EventRecorderMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category '*sound-piano rolls') ----- - encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick - - self play.! Item was removed: - ----- 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 removed: - ----- Method: EventRecorderMorph>>myDurationInMS (in category '*sound-piano rolls') ----- - myDurationInMS - - ^tape isEmptyOrNil ifTrue: [ - 10 - ] ifFalse: [ - tape last timeStamp - tape first timeStamp - ] - ! Item was removed: - ----- Method: GraphMorph>>addCustomMenuItems:hand: (in category '*sound') ----- - addCustomMenuItems: aCustomMenu hand: aHandMorph - - super addCustomMenuItems: aCustomMenu hand: aHandMorph. - aCustomMenu add: 'open wave editor' translated action: #openWaveEditor. - aCustomMenu add: 'read file' translated action: #readDataFromFile. - ! Item was removed: - ----- 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 removed: - ----- Method: GraphMorph>>readDataFromFile (in category '*sound') ----- - readDataFromFile - - | fileName | - fileName := UIManager default - request: 'File name?' translated - initialAnswer: ''. - fileName isEmpty ifTrue: [^ self]. - (StandardFileStream isAFileNamed: fileName) ifFalse: [ - ^ self inform: 'Sorry, I cannot find that file' translated]. - self data: (SampledSound fromAIFFfileNamed: fileName) samples. - - ! Item was removed: - PianoKeyboardMorph subclass: #KeyboardMorphForInput - instanceVariableNames: 'pianoRoll duration durationModifier articulation buildingChord insertMode prevSelection startOfNextNote' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Scores'! - - !KeyboardMorphForInput commentStamp: 'nice 3/24/2010 07:37' prior: 0! - This class adds state and controls to the basic PianoKeyboardMorph so that notes of reliable duration can be keyed into a score without the need for a real keyboard. - - To try this out, execute... - - | n score | n := 3. - score := (MIDIScore new tracks: ((1 to: n) collect: [:i | Array new]); - trackInfo: ((1 to: n) collect: [:i | 'Instrument' , i printString]); - tempoMap: nil; ticksPerQuarterNote: 96). - ScorePlayerMorph openOn: score title: 'empty score' - - Then open a pianoRoll and, from that, open a keyboard. The rule is that the keyboard will append after the current selection. If the current selection is muted or nil, then input will go to the end of the first non-muted track.! Item was removed: - ----- 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@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@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@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@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@0 extent: 0@borderWidth)) - ! Item was removed: - ----- 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 removed: - ----- Method: KeyboardMorphForInput>>backspaceNote (in category 'note controls') ----- - backspaceNote - - self deleteNotes! Item was removed: - ----- Method: KeyboardMorphForInput>>buildChord: (in category 'note controls') ----- - buildChord: onOff! Item was removed: - ----- Method: KeyboardMorphForInput>>deleteNotes (in category 'note controls') ----- - deleteNotes - - pianoRoll deleteSelection! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: KeyboardMorphForInput>>mouseUpPitch:event:noteMorph: (in category 'simple keyboard') ----- - mouseUpPitch: pitch event: event noteMorph: noteMorph - noteMorph color: ((#(0 1 3 5 6 8 10) includes: pitch\\12) - ifTrue: [whiteKeyColor] - ifFalse: [blackKeyColor]). - ! Item was removed: - ----- Method: KeyboardMorphForInput>>noteDuration (in category 'note controls') ----- - noteDuration - - articulation == #staccato ifTrue: [^ (self fullDuration * 0.65) asInteger]. - articulation == #normal ifTrue: [^ (self fullDuration * 0.8) asInteger]. - articulation == #legato ifTrue: [^ (self fullDuration * 0.95) asInteger]. - ! Item was removed: - ----- Method: KeyboardMorphForInput>>pianoRoll: (in category 'initialization') ----- - pianoRoll: prMorph - - pianoRoll := prMorph! Item was removed: - ----- 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 removed: - ----- Method: KeyboardMorphForInput>>velocity (in category 'note controls') ----- - velocity - - ^ 80 "Later put a slider on the keyboard control"! Item was removed: - ----- Method: LoopedSampledSound>>edit (in category 'other') ----- - 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 removed: - ----- Method: MIDIFileReader class>>playFileNamed: (in category 'as yet unclassified') ----- - playFileNamed: fileName - - ScorePlayerMorph - openOn: (self scoreFromFileNamed: fileName) - title: (FileDirectory localNameFor: fileName). - ! Item was removed: - ----- Method: MIDIFileReader class>>playStream: (in category 'as yet unclassified') ----- - playStream: binaryStream - - ScorePlayerMorph - openOn: (self scoreFromStream: binaryStream) - title: 'a MIDI stream' - ! Item was removed: - ----- Method: MIDIFileReader class>>playURLNamed: (in category 'as yet unclassified') ----- - playURLNamed: urlString - - | titleString | - titleString := urlString - copyFrom: (urlString findLast: [:c | c=$/]) + 1 - to: urlString size. - ScorePlayerMorph - openOn: (self scoreFromURL: urlString) - title: titleString. - ! Item was removed: - ----- Method: Morph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category '*sound-piano rolls') ----- - addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime - - "a hack to allow for abitrary morphs to be dropped into piano roll" - t > rightTime ifTrue: [^ self]. - t < leftTime ifTrue: [^ self]. - morphList add: (self left: (pianoRoll xForTime: t)). - ! Item was removed: - ----- Method: Morph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category '*sound-piano rolls') ----- - encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick - - "a hack to allow for abitrary morphs to be dropped into piano roll" - self triggerActionFromPianoRoll.! Item was removed: - ----- Method: Morph>>justDroppedIntoPianoRoll:event: (in category '*sound-piano rolls') ----- - justDroppedIntoPianoRoll: pianoRoll event: evt - - | ambientEvent startTimeInScore | - 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 removed: - ----- Method: Morph>>pauseFrom: (in category '*sound-piano rolls') ----- - pauseFrom: scorePlayer - - "subclasses should take five"! Item was removed: - ----- Method: Morph>>resetFrom: (in category '*sound-piano rolls') ----- - resetFrom: scorePlayer - - "subclasses should revert to their initial state"! Item was removed: - ----- Method: Morph>>resumeFrom: (in category '*sound-piano rolls') ----- - resumeFrom: scorePlayer - - "subclasses should continue from their current position" - "a hack to allow for abitrary morphs to be dropped into piano roll"! Item was removed: - ----- Method: Morph>>triggerActionFromPianoRoll (in category '*sound-piano rolls') ----- - triggerActionFromPianoRoll - - | evt | - "a hack to allow for abitrary morphs to be dropped into piano roll" - self world ifNil: [^self]. - evt := MouseEvent new setType: nil position: self center buttons: 0 hand: self world activeHand. - self programmedMouseUp: evt for: self. - - ! Item was removed: - Morph subclass: #PianoRollNoteMorph - instanceVariableNames: 'trackIndex indexInTrack hitLoc editMode selected notePlaying' - classVariableNames: 'SoundPlaying' - poolDictionaries: '' - category: 'Sound-Scores'! - - !PianoRollNoteMorph commentStamp: '<historical>' prior: 0! - A PianoRollNoteMorph is drawn as a simple mroph, but it carries the necessary state to locate its source sound event via its owner (a PianorRollScoreMorph) and the score therein. Simple editing of pitch and time placement is provided here.! Item was removed: - ----- Method: PianoRollNoteMorph>>deselect (in category 'selecting') ----- - deselect - - selected ifFalse: [^ self]. - self changed. - selected := false. - ! Item was removed: - ----- Method: PianoRollNoteMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - selected - ifTrue: [aCanvas frameAndFillRectangle: self fullBounds fillColor: color borderWidth: 1 borderColor: Color black] - ifFalse: [aCanvas fillRectangle: self bounds color: color]. - ! Item was removed: - ----- Method: PianoRollNoteMorph>>editPitch: (in category 'editing') ----- - editPitch: evt - - | mk note | - mk := owner midiKeyForY: evt cursorPoint y. - note := (owner score tracks at: trackIndex) at: indexInTrack. - note midiKey = mk ifTrue: [^ self]. - note midiKey: mk. - self playSound: (self soundOfDuration: 999.0). - self position: self position x @ ((owner yForMidiKey: mk) - 1) - ! Item was removed: - ----- Method: PianoRollNoteMorph>>fullBounds (in category 'layout') ----- - fullBounds - - selected - ifTrue: [^ bounds expandBy: 1] - ifFalse: [^ bounds]! Item was removed: - ----- Method: PianoRollNoteMorph>>gridToNextQuarter (in category 'editing') ----- - gridToNextQuarter - - owner score gridTrack: trackIndex toQuarter: 1 at: indexInTrack. - owner rebuildFromScore! Item was removed: - ----- Method: PianoRollNoteMorph>>gridToPrevQuarter (in category 'editing') ----- - gridToPrevQuarter - - owner score gridTrack: trackIndex toQuarter: -1 at: indexInTrack. - owner rebuildFromScore! Item was removed: - ----- Method: PianoRollNoteMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ owner scorePlayer isPlaying not! Item was removed: - ----- Method: PianoRollNoteMorph>>indexInTrack (in category 'accessing') ----- - indexInTrack - - ^ indexInTrack! Item was removed: - ----- Method: PianoRollNoteMorph>>invokeNoteMenu: (in category 'menu') ----- - invokeNoteMenu: evt - "Invoke the note's edit menu." - - | menu | - menu := MenuMorph new defaultTarget: self. - menu addList: - #(('grid to next quarter' gridToNextQuarter) - ('grid to prev quarter' gridToPrevQuarter)). - - menu popUpEvent: evt in: self world. - ! Item was removed: - ----- Method: PianoRollNoteMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - hitLoc := evt cursorPoint. - editMode := nil. - owner submorphsDo: - [:m | (m isKindOf: PianoRollNoteMorph) ifTrue: [m deselect]]. - selected := true. - self changed. - owner selection: (Array with: trackIndex with: indexInTrack with: indexInTrack). - self playSound! Item was removed: - ----- Method: PianoRollNoteMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - | delta offsetEvt | - editMode isNil - ifTrue: - ["First movement determines edit mode" - - ((delta := evt cursorPoint - hitLoc) dist: 0 @ 0) <= 2 - ifTrue: [^self "No significant movement yet."]. - delta x abs > delta y abs - ifTrue: - [delta x > 0 - ifTrue: - ["Horizontal drag" - - editMode := #selectNotes] - ifFalse: - [self playSound: nil. - offsetEvt := evt copy setCursorPoint: evt cursorPoint + (20 @ 0). - self invokeNoteMenu: offsetEvt]] - ifFalse: [editMode := #editPitch "Vertical drag"]]. - editMode == #editPitch ifTrue: [self editPitch: evt]. - editMode == #selectNotes ifTrue: [self selectNotes: evt]! Item was removed: - ----- Method: PianoRollNoteMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - - self playSound: nil! Item was removed: - ----- Method: PianoRollNoteMorph>>noteInScore (in category 'note playing') ----- - noteInScore - - ^ (owner score tracks at: trackIndex) at: indexInTrack - ! Item was removed: - ----- Method: PianoRollNoteMorph>>noteOfDuration: (in category 'note playing') ----- - noteOfDuration: duration - - | note | - note := self noteInScore. - ^ (owner scorePlayer instrumentForTrack: trackIndex) - soundForMidiKey: note midiKey - dur: duration - loudness: (note velocity asFloat / 127.0) - ! Item was removed: - ----- Method: PianoRollNoteMorph>>playSound (in category 'note playing') ----- - playSound - "This STARTS a single long sound. It must be stopped by playing another or nil." - - ^ self playSound: (self soundOfDuration: 999.0)! Item was removed: - ----- Method: PianoRollNoteMorph>>playSound: (in category 'note playing') ----- - playSound: aSoundOrNil - - SoundPlaying ifNotNil: [SoundPlaying stopGracefully]. - SoundPlaying := aSoundOrNil. - SoundPlaying ifNotNil: [SoundPlaying play].! Item was removed: - ----- Method: PianoRollNoteMorph>>select (in category 'selecting') ----- - select - - selected ifTrue: [^ self]. - selected := true. - self changed! Item was removed: - ----- Method: PianoRollNoteMorph>>selectFrom: (in category 'selecting') ----- - selectFrom: selection - (trackIndex = selection first and: - [indexInTrack >= (selection second) and: [indexInTrack <= (selection third)]]) - ifTrue: [selected ifFalse: [self select]] - ifFalse: [selected ifTrue: [self deselect]]! Item was removed: - ----- Method: PianoRollNoteMorph>>selectNotes: (in category 'selecting') ----- - selectNotes: evt - - | lastMorph oldEnd saveOwner | - saveOwner := owner. - (owner autoScrollForX: evt cursorPoint x) ifTrue: - ["If scroll talkes place I will be deleted and my x-pos will become invalid." - owner := saveOwner. - bounds := bounds withLeft: (owner xForTime: self noteInScore time)]. - oldEnd := owner selection last. - (owner notesInRect: (evt cursorPoint x @ owner top corner: owner bottomRight)) - do: [:m | m trackIndex = trackIndex ifTrue: [m deselect]]. - self select. lastMorph := self. - (owner notesInRect: (self left @ owner top corner: evt cursorPoint x @ owner bottom)) - do: [:m | m trackIndex = trackIndex ifTrue: [m select. lastMorph := m]]. - owner selection: (Array with: trackIndex with: indexInTrack with: lastMorph indexInTrack). - lastMorph indexInTrack ~= oldEnd ifTrue: - ["Play last note as selection grows or shrinks" - owner ifNotNil: [lastMorph playSound]] - ! Item was removed: - ----- Method: PianoRollNoteMorph>>selected (in category 'selecting') ----- - selected - - ^ selected! Item was removed: - ----- Method: PianoRollNoteMorph>>soundOfDuration: (in category 'note playing') ----- - soundOfDuration: duration - - | sound | - sound := MixedSound new. - sound add: (self noteOfDuration: duration) - pan: (owner scorePlayer panForTrack: trackIndex) - volume: owner scorePlayer overallVolume * - (owner scorePlayer volumeForTrack: trackIndex). - ^ sound reset - ! Item was removed: - ----- Method: PianoRollNoteMorph>>trackIndex (in category 'accessing') ----- - trackIndex - - ^ trackIndex! Item was removed: - ----- Method: PianoRollNoteMorph>>trackIndex:indexInTrack: (in category 'initialization') ----- - trackIndex: ti indexInTrack: i - - trackIndex := ti. - indexInTrack := i. - selected := false! Item was removed: - RectangleMorph subclass: #PianoRollScoreMorph - instanceVariableNames: 'scorePlayer score colorForTrack lowestNote leftEdgeTime timeScale indexInTrack lastUpdateTick lastMutedState cursor selection timeSignature beatsPerMeasure notePerBeat showMeasureLines showBeatLines soundsPlaying soundsPlayingMorph movieClipPlayer' - classVariableNames: 'NotePasteBuffer' - poolDictionaries: '' - category: 'Sound-Scores'! - - !PianoRollScoreMorph commentStamp: '<historical>' prior: 0! - A PianoRollScoreMorph displays a score such as a MIDIScore, and will scroll through it tracking the progress of a ScorePlayerMorph (from which it is usually spawned). - - timeScale is in pixels per score tick. - - Currently the ambient track (for synchronizing thumbnails, eg) is treated specially here and in the score. This should be cleaned up by adding a trackType or something like it in the score.! Item was removed: - ----- Method: PianoRollScoreMorph>>acceptDroppingMorph:event: (in category 'layout') ----- - acceptDroppingMorph: aMorph event: evt - "In addition to placing this morph in the pianoRoll, add a corresponding - event to the score so that it will always appear when played, in addition - to possibly triggering other actions" - - aMorph justDroppedIntoPianoRoll: self event: evt. - super acceptDroppingMorph: aMorph event: evt. - - ! Item was removed: - ----- Method: PianoRollScoreMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - - super addCustomMenuItems: aMenu hand: aHandMorph. - aMenu add: 'expand time' translated action: #expandTime. - aMenu add: 'contract time' translated action: #contractTime. - aMenu addLine. - aMenu add: 'add movie clip player' translated action: #addMovieClipPlayer. - (self valueOfProperty: #dragNDropEnabled) == true - ifTrue: [aMenu add: 'close drag and drop' translated action: #disableDragNDrop] - ifFalse: [aMenu add: 'open drag and drop' translated action: #enableDragNDrop]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>addKeyboard (in category 'menu') ----- - addKeyboard - - (KeyboardMorphForInput new pianoRoll: self) openInWorld! Item was removed: - ----- Method: PianoRollScoreMorph>>addNotes (in category 'drawing') ----- - addNotes - "Recompute the set of morphs that should be visible at the current scroll position." - - | visibleMorphs rightEdge topEdge rightEdgeTime | - visibleMorphs := OrderedCollection new: 500. - rightEdge := self right - borderWidth. - rightEdgeTime := self timeForX: rightEdge. - topEdge := self top + borderWidth + 1. - - "Add ambient morphs first (they will be front-most)" - score eventMorphsWithTimeDo: - [:m :t | m addMorphsTo: visibleMorphs pianoRoll: self eventTime: t - betweenTime: leftEdgeTime and: rightEdgeTime]. - - "Then add note morphs" - score tracks withIndexDo: - [:track :trackIndex | | done n i nRight nTop nLeft trackColor | - trackColor := colorForTrack at: trackIndex. - i := indexInTrack at: trackIndex. - done := scorePlayer mutedForTrack: trackIndex. - [done | (i > track size)] whileFalse: [ - n := track at: i. - (n isNoteEvent and: [n midiKey >= lowestNote]) ifTrue: [ - n time > rightEdgeTime - ifTrue: [done := true] - ifFalse: [ - nLeft := self xForTime: n time. - nTop := (self yForMidiKey: n midiKey) - 1. - nTop > topEdge ifTrue: [ - nRight := nLeft + (n duration * timeScale) truncated - 1. - visibleMorphs add: - ((PianoRollNoteMorph - newBounds: (nLeft@nTop corner: nRight@(nTop + 3)) - color: trackColor) - trackIndex: trackIndex indexInTrack: i)]]]. - i := i + 1]. - (selection notNil - and: [trackIndex = selection first - and: [i >= selection second and: [(indexInTrack at: trackIndex) <= selection third]]]) - ifTrue: [visibleMorphs do: - [:vm | (vm isKindOf: PianoRollNoteMorph) ifTrue: [vm selectFrom: selection]]]]. - - "Add the cursor morph in front of all notes; height and position are set later." - cursor ifNil: [cursor := Morph newBounds: (self topLeft extent: 1@1) color: Color red]. - visibleMorphs addFirst: cursor. - - self changed. - self removeAllMorphs. - self addAllMorphs: visibleMorphs. - ! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>beatLinesOnOff (in category 'menu') ----- - beatLinesOnOff - - showBeatLines := showBeatLines not. - self changed! Item was removed: - ----- Method: PianoRollScoreMorph>>beatsPerMeasure: (in category 'accessing') ----- - beatsPerMeasure: n - - ^ self timeSignature: n over: notePerBeat! Item was removed: - ----- Method: PianoRollScoreMorph>>contractTime (in category 'geometry') ----- - contractTime - - timeScale := timeScale / 1.5. - self rebuildFromScore. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>copySelection (in category 'editing') ----- - copySelection - selection isNil ifTrue: [^self]. - NotePasteBuffer := (score tracks at: selection first) - copyFrom: selection second - to: selection third! Item was removed: - ----- Method: PianoRollScoreMorph>>cutSelection (in category 'editing') ----- - cutSelection - selection isNil ifTrue: [^self]. - self copySelection. - self deleteSelection! Item was removed: - ----- Method: PianoRollScoreMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 1! Item was removed: - ----- Method: PianoRollScoreMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color white! Item was removed: - ----- Method: PianoRollScoreMorph>>deleteSelection (in category 'editing') ----- - deleteSelection - | selMorphs priorEvent x | - (selection isNil or: [selection second = 0]) ifTrue: [^self]. - score cutSelection: selection. - selection second > 1 - ifTrue: - [selection at: 2 put: selection second - 1. - selection at: 3 put: selection second. - priorEvent := (score tracks at: selection first) at: selection second. - (x := self xForTime: priorEvent time) < (self left + 30) - ifTrue: [self autoScrollForX: x - ((30 + self width) // 4)]] - ifFalse: [selection := nil]. - scorePlayer updateDuration. - self rebuildFromScore. - selMorphs := self - submorphsSatisfying: [:m | (m isKindOf: PianoRollNoteMorph) and: [m selected]]. - selMorphs isEmpty ifFalse: [(selMorphs last noteOfDuration: 0.3) play]! Item was removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>drawOn: (in category 'drawing') ----- - drawOn: aCanvas - - super drawOn: aCanvas. - self drawStaffOn: aCanvas. - ! Item was removed: - ----- 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@y corner: r@(y + 1)) - color: blackKeyColor]]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>expandTime (in category 'geometry') ----- - expandTime - - timeScale := timeScale * 1.5. - self rebuildFromScore. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>extent: (in category 'geometry') ----- - extent: aPoint - "Force rebuild when re-sized." - - super extent: aPoint. - score ifNotNil: [self updateLowestNote]. - self rebuildFromScore. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>fullBounds (in category 'layout') ----- - fullBounds - "Overridden to clip submorph hit detection to my bounds." - - fullBounds ifNil: [fullBounds := bounds]. - ^ bounds - ! Item was removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ true! Item was removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>insertSelection (in category 'editing') ----- - insertSelection - self selection isNil ifTrue: [^self]. - score insertEvents: NotePasteBuffer at: self selection. - scorePlayer updateDuration. - self rebuildFromScore! Item was removed: - ----- Method: PianoRollScoreMorph>>insertTransposed (in category 'editing') ----- - insertTransposed - | delta transposedNotes | - (delta := UIManager default - chooseFrom: ((12 to: -12 by: -1) collect: [:i | i printString]) - values: ((12 to: -12 by: -1) collect: [:i | i printString]) - title: 'offset...') ifNil: [^self]. - transposedNotes := NotePasteBuffer - collect: [:note | note copy midiKey: note midiKey + delta]. - selection isNil ifTrue: [^self]. - score insertEvents: transposedNotes at: self selection. - scorePlayer updateDuration. - self rebuildFromScore! Item was removed: - ----- 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 removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>layoutChanged (in category 'layout') ----- - layoutChanged - "Override this to avoid propagating 'layoutChanged' when just adding/removing note objects." - - fullBounds = bounds ifTrue: [^ self]. - super layoutChanged. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>measureLinesOnOff (in category 'menu') ----- - measureLinesOnOff - - showMeasureLines := showMeasureLines not. - self changed! Item was removed: - ----- Method: PianoRollScoreMorph>>midiKeyForY: (in category 'geometry') ----- - midiKeyForY: y - - ^ lowestNote - ((y - (bounds bottom - borderWidth - 4)) // 3) - ! Item was removed: - ----- Method: PianoRollScoreMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - - | noteMorphs chordRect | - (self notesInRect: ((evt cursorPoint extent: 1@0) expandBy: 2@30)) isEmpty - ifTrue: ["If not near a note, then put up score edit menu" - ^ self invokeScoreMenu: evt]. - - "Clicked near (but not on) a note, so play all notes at the cursor time" - noteMorphs := self notesInRect: ((evt cursorPoint extent: 1@0) expandBy: 0@self height). - chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: 1. - soundsPlayingMorph := Morph newBounds: chordRect color: Color green. - self addMorphBack: soundsPlayingMorph. - - soundsPlaying := IdentityDictionary new. - noteMorphs do: - [:m | | sound | sound := m soundOfDuration: 999.0. - soundsPlaying at: m put: sound. - SoundPlayer resumePlaying: sound quickStart: false]. - - ! Item was removed: - ----- Method: PianoRollScoreMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - - | noteMorphs chordRect | - soundsPlaying ifNil: [^ self]. - self autoScrollForX: evt cursorPoint x. - - "Play all notes at the cursor time" - noteMorphs := self notesInRect: ((evt cursorPoint extent: 1@0) expandBy: 0@self height). - chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: 1. - soundsPlayingMorph delete. - soundsPlayingMorph := Morph newBounds: chordRect color: Color green. - self addMorphBack: soundsPlayingMorph. - - noteMorphs do: - [:m | | sound | "Add any new sounds" - (soundsPlaying includesKey: m) - ifFalse: [sound := m soundOfDuration: 999.0. - soundsPlaying at: m put: sound. - SoundPlayer resumePlaying: sound quickStart: false]]. - soundsPlaying keys do: - [:m | "Remove any sounds no longer in selection." - (noteMorphs includes: m) - ifFalse: [(soundsPlaying at: m) stopGracefully. - soundsPlaying removeKey: m]]. - - ! Item was removed: - ----- 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 removed: - ----- 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@desiredCursorHeight]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>movieClipPlayer (in category 'accessing') ----- - movieClipPlayer - - ^ movieClipPlayer! Item was removed: - ----- Method: PianoRollScoreMorph>>movieClipPlayer: (in category 'accessing') ----- - movieClipPlayer: moviePlayer - - movieClipPlayer := moviePlayer - ! Item was removed: - ----- Method: PianoRollScoreMorph>>notePerBeat: (in category 'accessing') ----- - notePerBeat: n - - ^ self timeSignature: beatsPerMeasure over: n! Item was removed: - ----- Method: PianoRollScoreMorph>>notesInRect: (in category 'scrolling') ----- - notesInRect: timeSlice - - ^ self submorphsSatisfying: - [:m | (timeSlice intersects: m bounds) - and: [m isKindOf: PianoRollNoteMorph]]! Item was removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>rebuildFromScore (in category 'drawing') ----- - rebuildFromScore - "Rebuild my submorphs from the score. This method should be invoked after changing the time scale, the color or visibility of a track, the extent of this morph, etc." - - score ifNil: [^ self]. - self addNotes. - ! Item was removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>score (in category 'accessing') ----- - score - - ^ score! Item was removed: - ----- Method: PianoRollScoreMorph>>scorePlayer (in category 'accessing') ----- - scorePlayer - - ^ scorePlayer! Item was removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>selection: (in category 'accessing') ----- - selection: anArray - - selection := anArray! Item was removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>stepTime (in category 'testing') ----- - stepTime - - ^ 0 - ! Item was removed: - ----- Method: PianoRollScoreMorph>>tickTimeAtCursor (in category 'geometry') ----- - tickTimeAtCursor - cursor ifNil: [^ 0]. - ^ self timeForX: cursor left! Item was removed: - ----- Method: PianoRollScoreMorph>>timeForX: (in category 'geometry') ----- - timeForX: aNumber - - ^ ((aNumber - bounds left - borderWidth) asFloat / timeScale + leftEdgeTime) asInteger! Item was removed: - ----- Method: PianoRollScoreMorph>>timeScale (in category 'accessing') ----- - timeScale - - ^ timeScale "in pixels per tick"! Item was removed: - ----- 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 removed: - ----- Method: PianoRollScoreMorph>>updateLowestNote (in category 'initialization') ----- - updateLowestNote - "find the actual lowest note in the score" - - - lowestNote := 128 - (self innerBounds height // 3). - score tracks do: [:track | | n | - 1 to: track size do: [:i | - n := track at: i. - (n isNoteEvent and: [n midiKey < lowestNote]) - ifTrue: [lowestNote := n midiKey - 4]]]. - ! Item was removed: - ----- Method: PianoRollScoreMorph>>xForTime: (in category 'geometry') ----- - xForTime: aNumber - - ^ ((aNumber - leftEdgeTime) asFloat * timeScale) asInteger + bounds left + borderWidth - ! Item was removed: - ----- Method: PianoRollScoreMorph>>yForMidiKey: (in category 'geometry') ----- - yForMidiKey: midiKey - - ^ (bounds bottom - borderWidth - 4) - (3 * (midiKey - lowestNote)) - ! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonSound (in category '*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 removed: - ----- Method: ProjectNavigationMorph>>getSoundVolume (in category '*sound') ----- - getSoundVolume - - ^SoundPlayer soundVolume average! Item was removed: - ----- Method: ProjectNavigationMorph>>setSoundVolume: (in category '*sound') ----- - setSoundVolume: x - - SoundPlayer setVolumeLeft: x volumeRight: x. - ! Item was removed: - ----- Method: ProjectNavigationMorph>>soundDownEvt:morph: (in category '*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 removed: - ----- Method: ProjectNavigationMorph>>soundStillDownEvt:morph: (in category '*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 removed: - ----- Method: ProjectNavigationMorph>>soundUpEvt:morph: (in category '*sound') ----- - soundUpEvt: a morph: b - - soundSlider ifNotNil: [soundSlider delete]. - soundSlider := nil. - Beeper beep ! Item was removed: - ----- Method: ProjectNavigationMorph>>speakerIcon (in category '*sound') ----- - speakerIcon - - - ^ImageMorph new - image: ( - (Form - extent: 19@18 - depth: 8 - fromArray: #( 0 0 1493172224 0 0 0 0 1493172224 0 0 0 138 1493172224 0 0 0 35509 2315255808 0 0 0 9090522 2315255808 0 0 0 2327173887 2315255819 0 0 138 3051028442 2315255819 0 0 1505080590 4294957786 2315255808 184549376 0 3053453311 4292532917 1493172224 184549376 0 1505080714 3048584629 1493172224 184549376 0 9079434 3048584629 1493172224 184549376 0 138 2327164341 1493172235 0 0 0 2324346293 1493172235 0 0 0 9079477 1493172224 0 0 0 35466 1493172224 0 0 0 138 0 0 0 0 0 0 0 0 0 0 0 0 0) - offset: 0@0) - ); - setBalloonText: 'Quiet'; - on: #mouseUp send: #yourself to: 1 - ! Item was removed: - ----- Method: ProjectViewMorph>>triggerActionFromPianoRoll (in category '*sound-piano rolls') ----- - triggerActionFromPianoRoll - - WorldState addDeferredUIMessage: [ - project world setProperty: #letTheMusicPlay toValue: true. - self enter. - ]! Item was changed: ----- Method: SampledInstrument>>readSampleSetFrom: (in category 'other') ----- readSampleSetFrom: dirName "Answer a collection of sounds read from AIFF files in the given directory and sorted in ascending pitch order." | all dir | all := SortedCollection sortBlock: [:s1 :s2 | s1 pitch < s2 pitch]. dir := FileDirectory default on: dirName. dir fileNames do: [:n | | fullName snd | fullName := dir fullNameFor: n. + UIManager default - Utilities informUser: 'Reading AIFF file ', n during: [snd := LoopedSampledSound new fromAIFFFileNamed: fullName mergeIfStereo: true]. all add: snd]. ^ all asArray ! Item was removed: - ----- Method: SampledSound>>sonogramMorph:from:to:nPoints: (in category 'sound tracks') ----- - sonogramMorph: height from: start to: stop nPoints: nPoints - "FYI: It is very cool that we can do this, but for sound tracks on a movie, - simple volume is easier to read, easier to scale, and way faster to compute. - Code preserved here just in case it makes a useful example." - "In an inspector of a samplesSound... - self currentWorld addMorph: (self sonogramMorph: 32 from: 1 to: 50000 nPoints: 256) - " - | fft sonogramMorph width | - fft := FFT new: nPoints. - width := stop-start//nPoints. - sonogramMorph := Sonogram new - extent: width@height - minVal: 0.0 - maxVal: 1.0 - scrollDelta: width. - start to: stop-nPoints by: nPoints do: - [:i | | data | - data := fft transformDataFrom: samples startingAt: i. - data := data collect: [:v | v sqrt]. "square root compresses dynamic range" - data /= 200.0. - sonogramMorph plotColumn: data]. - ^ sonogramMorph - - ! Item was removed: - AlignmentMorph subclass: #ScorePlayerMorph - instanceVariableNames: 'scorePlayer trackInstNames instrumentSelector scrollSlider' - classVariableNames: 'LastMIDIPort' - poolDictionaries: '' - category: 'Sound-Scores'! - - !ScorePlayerMorph commentStamp: '<historical>' prior: 0! - A ScorePlayerMorph mediates between a score such as a MIDIScore, a PianoRollScoreMorph, and the actual SoundPlayer synthesizer. - - It provides control over volume, tempo, instrumentation, and location in the score.! Item was removed: - ----- Method: ScorePlayerMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'ScorePlayer' - categories: #('Multimedia') - documentation: ' Mediates between a score such as a MIDIScore, a PianoRollScoreMorph, and the actual SoundPlayer synthesizer'! Item was removed: - ----- Method: ScorePlayerMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- - fileReaderServicesForFile: fullName suffix: suffix - - ^(suffix = 'mid') | (suffix = '*') - ifTrue: [ self services] - ifFalse: [#()] - ! Item was removed: - ----- Method: ScorePlayerMorph class>>initialize (in category 'class initialization') ----- - initialize - - FileServices registerFileReader: self! Item was removed: - ----- Method: ScorePlayerMorph class>>onMIDIFileNamed: (in category 'system hookup') ----- - onMIDIFileNamed: fileName - "Return a ScorePlayerMorph on the score from the MIDI file of the given name." - - | score player | - score := MIDIFileReader scoreFromFileNamed: fileName . - player := ScorePlayer onScore: score. - ^ self new onScorePlayer: player title: fileName - ! Item was removed: - ----- Method: ScorePlayerMorph class>>openOn:title: (in category 'system hookup') ----- - openOn: aScore title: aString - - | player | - player := ScorePlayer onScore: aScore. - (self new onScorePlayer: player title: aString) openInWorld. - ! Item was removed: - ----- Method: ScorePlayerMorph class>>playMidiFile: (in category 'class initialization') ----- - playMidiFile: fullName - "Play a MIDI file." - - Smalltalk at: #MIDIFileReader ifPresent: [:midiReader | - | f score | - f := (FileStream oldFileNamed: fullName) binary. - score := (midiReader new readMIDIFrom: f) asScore. - f close. - self openOn: score title: (FileDirectory localNameFor: fullName)] - ! Item was removed: - ----- Method: ScorePlayerMorph class>>servicePlayMidiFile (in category 'class initialization') ----- - servicePlayMidiFile - "Answer a service for opening player on a midi file" - - ^ SimpleServiceEntry - provider: self - label: 'open in midi player' - selector: #playMidiFile: - description: 'open the midi-player tool on this file' - buttonLabel: 'open'! Item was removed: - ----- Method: ScorePlayerMorph class>>services (in category 'fileIn/Out') ----- - services - - ^ Array with: self servicePlayMidiFile - - ! Item was removed: - ----- Method: ScorePlayerMorph class>>unload (in category 'initialize-release') ----- - unload - - FileServices unregisterFileReader: self ! Item was removed: - ----- Method: ScorePlayerMorph>>atTrack:from:selectInstrument: (in category 'controls') ----- - atTrack: trackIndex from: aPopUpChoice selectInstrument: selection - | oldSnd name snd | - oldSnd := scorePlayer instrumentForTrack: trackIndex. - (selection beginsWith: 'edit ') - ifTrue: - [name := selection copyFrom: 6 to: selection size. - aPopUpChoice contentsClipped: name. - (oldSnd isKindOf: FMSound) | (oldSnd isKindOf: LoopedSampledSound) - ifTrue: [EnvelopeEditorMorph openOn: oldSnd title: name]. - (oldSnd isKindOf: SampledInstrument) - ifTrue: [EnvelopeEditorMorph openOn: oldSnd allNotes first title: name]. - ^self]. - snd := nil. - 1 to: instrumentSelector size - do: - [:i | - (trackIndex ~= i and: [selection = (instrumentSelector at: i) contents]) - ifTrue: [snd := scorePlayer instrumentForTrack: i]]. "use existing instrument prototype" - snd ifNil: - [snd := (selection = 'clink' - ifTrue: - [(SampledSound samples: SampledSound coffeeCupClink - samplingRate: 11025) ] - ifFalse: [(AbstractSound soundNamed: selection)]) copy]. - scorePlayer instrumentForTrack: trackIndex put: snd. - (instrumentSelector at: trackIndex) contentsClipped: selection! Item was removed: - ----- Method: ScorePlayerMorph>>closeMIDIPort (in category 'initialization') ----- - closeMIDIPort - - scorePlayer closeMIDIPort. - LastMIDIPort := nil. - ! Item was removed: - ----- Method: ScorePlayerMorph>>defaultBorderWidth (in category 'initialization') ----- - defaultBorderWidth - "answer the default border width for the receiver" - ^ 2! Item was removed: - ----- Method: ScorePlayerMorph>>defaultColor (in category 'initialization') ----- - defaultColor - "answer the default color/fill style for the receiver" - ^ Color veryLightGray! Item was removed: - ----- Method: ScorePlayerMorph>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self listDirection: #topToBottom; - wrapCentering: #center; - cellPositioning: #topCenter; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - layoutInset: 3; - onScorePlayer: ScorePlayer new initialize title: ' '; - extent: 20 @ 20 ! Item was removed: - ----- Method: ScorePlayerMorph>>instrumentChoicesForTrack: (in category 'menu') ----- - instrumentChoicesForTrack: trackIndex - | names | - names := AbstractSound soundNames asOrderedCollection. - names := names collect: [:n | - | inst | - inst := AbstractSound soundNamed: n. - (inst isKindOf: UnloadedSound) - ifTrue: [n, '(out)'] - ifFalse: [n]]. - names add: 'clink'. - names add: 'edit ', (instrumentSelector at: trackIndex) contents. - ^ names asArray - ! Item was removed: - ----- Method: ScorePlayerMorph>>invokeMenu (in category 'menu') ----- - invokeMenu - "Invoke a menu of additonal functions for this ScorePlayer." - - | aMenu | - aMenu := MenuMorph new defaultTarget: self. - aMenu add: 'open a MIDI file' translated action: #openMIDIFile. - aMenu addList: { - #-. - {'save as AIFF file' translated. #saveAsAIFF}. - {'save as WAV file' translated. #saveAsWAV}. - {'save as Sun AU file' translated. #saveAsSunAudio}. - #-}. - aMenu add: 'reload instruments' translated target: AbstractSound selector: #updateScorePlayers. - aMenu addLine. - scorePlayer midiPort - ifNil: [ - aMenu add: 'play via MIDI' translated action: #openMIDIPort] - ifNotNil: [ - aMenu add: 'play via built in synth' translated action: #closeMIDIPort. - aMenu add: 'new MIDI controller' translated action: #makeMIDIController:]. - aMenu addLine. - aMenu add: 'make a pause marker' translated action: #makeAPauseEvent:. - - aMenu popUpInWorld: self world. - ! Item was removed: - ----- Method: ScorePlayerMorph>>makeAPauseEvent: (in category 'menu') ----- - makeAPauseEvent: evt - - | newWidget | - - newWidget := AlignmentMorph newRow. - newWidget - color: Color orange; - borderWidth: 0; - layoutInset: 0; - hResizing: #shrinkWrap; - vResizing: #shrinkWrap; - extent: 5@5; - addMorph: (StringMorph contents: '[pause]' translated) lock; - addMouseUpActionWith: ( - MessageSend receiver: self selector: #showResumeButtonInTheWorld - ). - - evt hand attachMorph: newWidget.! Item was removed: - ----- Method: ScorePlayerMorph>>makeControls (in category 'layout') ----- - makeControls - - | bb r reverbSwitch repeatSwitch | - r := AlignmentMorph newRow. - r color: color; borderWidth: 0; layoutInset: 0. - r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. - bb := SimpleButtonMorph new target: self; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: '<>'; actWhen: #buttonDown; - actionSelector: #invokeMenu). - bb := SimpleButtonMorph new target: self; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Piano Roll' translated; actionSelector: #makePianoRoll). - bb := SimpleButtonMorph new target: self; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Rewind' translated; actionSelector: #rewind). - bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Play' translated; actionSelector: #resumePlaying). - bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; - borderWidth: 2; color: color. - r addMorphBack: (bb label: 'Pause' translated; actionSelector: #pause). - reverbSwitch := SimpleSwitchMorph new - offColor: color; - onColor: (Color r: 1.0 g: 0.6 b: 0.6); - borderWidth: 2; - label: 'Reverb Disable' translated; - actionSelector: #disableReverb:; - target: scorePlayer; - setSwitchState: SoundPlayer isReverbOn not. - r addMorphBack: reverbSwitch. - scorePlayer ifNotNil: - [repeatSwitch := SimpleSwitchMorph new - offColor: color; - onColor: (Color r: 1.0 g: 0.6 b: 0.6); - borderWidth: 2; - label: 'Repeat' translated; - actionSelector: #repeat:; - target: scorePlayer; - setSwitchState: scorePlayer repeat. - r addMorphBack: repeatSwitch]. - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>makeMIDIController: (in category 'layout') ----- - makeMIDIController: evt - - self world activeHand attachMorph: - (MIDIControllerMorph new midiPort: scorePlayer midiPort). - ! Item was removed: - ----- Method: ScorePlayerMorph>>makePianoRoll (in category 'layout') ----- - makePianoRoll - "Create a piano roll viewer for this score player." - - | pianoRoll hand | - pianoRoll := PianoRollScoreMorph new on: scorePlayer. - hand := self world activeHand. - hand ifNil: [self world addMorph: pianoRoll] - ifNotNil: [hand attachMorph: pianoRoll. - hand lastEvent shiftPressed ifTrue: - ["Special case for NOBM demo" - pianoRoll contractTime; contractTime; enableDragNDrop]]. - pianoRoll startStepping. - ! Item was removed: - ----- Method: ScorePlayerMorph>>makeRow (in category 'layout') ----- - makeRow - - ^ AlignmentMorph newRow - color: color; - layoutInset: 0; - wrapCentering: #center; cellPositioning: #leftCenter; - hResizing: #spaceFill; - vResizing: #shrinkWrap - ! Item was removed: - ----- Method: ScorePlayerMorph>>onScorePlayer:title: (in category 'initialization') ----- - onScorePlayer: aScorePlayer title: scoreName - | divider col r | - scorePlayer := aScorePlayer. - scorePlayer ifNotNil: - [scorePlayer reset. - instrumentSelector := Array new: scorePlayer score tracks size]. - - self removeAllMorphs. - self addMorphBack: self makeControls. - scorePlayer ifNil: [^ self]. - - r := self makeRow - hResizing: #shrinkWrap; - vResizing: #shrinkWrap. - r addMorphBack: self rateControl; - addMorphBack: (Morph newBounds: (0@0 extent: 20@0) color: Color transparent); - addMorphBack: self volumeControl. - self addMorphBack: r. - self addMorphBack: self scrollControl. - - col := AlignmentMorph newColumn color: color; layoutInset: 0. - self addMorphBack: col. - 1 to: scorePlayer trackCount do: [:trackIndex | - divider := AlignmentMorph new - extent: 10@1; - borderWidth: 1; - layoutInset: 0; - borderColor: #raised; - color: color; - hResizing: #spaceFill; - vResizing: #rigid. - col addMorphBack: divider. - col addMorphBack: (self trackControlsFor: trackIndex)]. - - LastMIDIPort ifNotNil: [ - "use the most recently set MIDI port" - scorePlayer openMIDIPort: LastMIDIPort]. - ! Item was removed: - ----- Method: ScorePlayerMorph>>openMIDIFile (in category 'initialization') ----- - openMIDIFile - "Open a MIDI score and re-init controls..." - | score fileName f player | - fileName := Utilities chooseFileWithSuffixFromList: #('.mid' '.midi') - withCaption: 'Choose a MIDI file to open' translated. - (fileName isNil or: [ fileName == #none ]) - ifTrue: [^ self inform: 'No .mid/.midi files found in the Squeak directory' translated]. - f := FileStream readOnlyFileNamed: fileName. - score := (MIDIFileReader new readMIDIFrom: f binary) asScore. - f close. - player := ScorePlayer onScore: score. - self onScorePlayer: player title: fileName! Item was removed: - ----- Method: ScorePlayerMorph>>openMIDIPort (in category 'initialization') ----- - openMIDIPort - - | portNum | - portNum := SimpleMIDIPort outputPortNumFromUser. - portNum ifNil: [^ self]. - scorePlayer openMIDIPort: portNum. - LastMIDIPort := portNum. - ! Item was removed: - ----- Method: ScorePlayerMorph>>panAndVolControlsFor: (in category 'layout') ----- - panAndVolControlsFor: trackIndex - - | volSlider panSlider c r middleLine pianoRollColor | - pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. - volSlider := SimpleSliderMorph new - color: color; - sliderColor: pianoRollColor; - extent: 101@2; - target: scorePlayer; - arguments: (Array with: trackIndex); - actionSelector: #volumeForTrack:put:; - minVal: 0.0; - maxVal: 1.0; - adjustToValue: (scorePlayer volumeForTrack: trackIndex). - panSlider := SimpleSliderMorph new - color: color; - sliderColor: pianoRollColor; - extent: 101@2; - target: scorePlayer; - arguments: (Array with: trackIndex); - actionSelector: #panForTrack:put:; - minVal: 0.0; - maxVal: 1.0; - adjustToValue: (scorePlayer panForTrack: trackIndex). - c := AlignmentMorph newColumn - color: color; - layoutInset: 0; - wrapCentering: #center; cellPositioning: #topCenter; - hResizing: #spaceFill; - vResizing: #shrinkWrap. - middleLine := Morph new "center indicator for pan slider" - color: (Color r: 0.4 g: 0.4 b: 0.4); - extent: 1@(panSlider height - 4); - position: panSlider center x@(panSlider top + 2). - panSlider addMorphBack: middleLine. - r := self makeRow. - r addMorphBack: (StringMorph contents: '0'). - r addMorphBack: volSlider. - r addMorphBack: (StringMorph contents: '10'). - c addMorphBack: r. - r := self makeRow. - r addMorphBack: (StringMorph contents: 'L' translated). - r addMorphBack: panSlider. - r addMorphBack: (StringMorph contents: 'R' translated). - c addMorphBack: r. - ^ c - ! Item was removed: - ----- Method: ScorePlayerMorph>>rateControl (in category 'layout') ----- - rateControl - - | rateSlider middleLine r | - rateSlider := SimpleSliderMorph new - color: color; - sliderColor: Color gray; - extent: 180@2; - target: self; - actionSelector: #setLogRate:; - minVal: -1.0; - maxVal: 1.0; - adjustToValue: 0.0. - middleLine := Morph new "center indicator for pan slider" - color: (Color r: 0.4 g: 0.4 b: 0.4); - extent: 1@(rateSlider height - 4); - position: rateSlider center x@(rateSlider top + 2). - rateSlider addMorphBack: middleLine. - r := self makeRow - hResizing: #shrinkWrap; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: 'slow ' translated). - r addMorphBack: rateSlider. - r addMorphBack: (StringMorph contents: ' fast' translated). - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>rewind (in category 'controls') ----- - rewind - - scorePlayer pause; reset. - ! Item was removed: - ----- Method: ScorePlayerMorph>>saveAsAIFF (in category 'menu') ----- - saveAsAIFF - "Create a stereo AIFF audio file with the result of performing my score." - - | fileName | - fileName := UIManager default request: 'New file name?' translated. - fileName isEmpty ifTrue: [^ self]. - (fileName asLowercase endsWith: '.aif') ifFalse: [ - fileName := fileName, '.aif']. - - scorePlayer storeAIFFOnFileNamed: fileName. - ! Item was removed: - ----- Method: ScorePlayerMorph>>saveAsSunAudio (in category 'menu') ----- - saveAsSunAudio - "Create a stereo Sun audio file with the result of performing my score." - - | fileName | - fileName := UIManager default request: 'New file name?' translated. - fileName isEmpty ifTrue: [^ self]. - (fileName asLowercase endsWith: '.au') ifFalse: [ - fileName := fileName, '.au']. - - scorePlayer storeSunAudioOnFileNamed: fileName. - ! Item was removed: - ----- Method: ScorePlayerMorph>>saveAsWAV (in category 'menu') ----- - saveAsWAV - "Create a stereo WAV audio file with the result of performing my score." - - | fileName | - fileName := UIManager default request: 'New file name?' translated. - fileName isEmpty ifTrue: [^ self]. - (fileName asLowercase endsWith: '.wav') ifFalse: [ - fileName := fileName, '.wav']. - - scorePlayer storeWAVOnFileNamed: fileName. - ! Item was removed: - ----- Method: ScorePlayerMorph>>scorePlayer (in category 'accessing') ----- - scorePlayer - - ^ scorePlayer - ! Item was removed: - ----- Method: ScorePlayerMorph>>scrollControl (in category 'layout') ----- - scrollControl - - | r | - scrollSlider := SimpleSliderMorph new - color: color; - sliderColor: Color gray; - extent: 360@2; - target: scorePlayer; - actionSelector: #positionInScore:; - adjustToValue: scorePlayer positionInScore. - r := self makeRow - hResizing: #shrinkWrap; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: 'start ' translated). - r addMorphBack: scrollSlider. - r addMorphBack: (StringMorph contents: ' end' translated). - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>setLogRate: (in category 'controls') ----- - setLogRate: logOfRate - - scorePlayer rate: (3.5 raisedTo: logOfRate). - ! Item was removed: - ----- Method: ScorePlayerMorph>>showResumeButtonInTheWorld (in category 'layout') ----- - showResumeButtonInTheWorld - WorldState addDeferredUIMessage: [ - | w | - w := self world. - w ifNotNil: [ - w addMorphFront: - (self standaloneResumeButton position: (w right - 100) @ (w top + 10)). - scorePlayer pause. - ]. - ] - ! Item was removed: - ----- Method: ScorePlayerMorph>>standaloneResumeButton (in category 'layout') ----- - standaloneResumeButton - - | r | - - r := AlignmentMorph newRow. - r color: Color red; borderWidth: 0; layoutInset: 6; useRoundedCorners. - r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. - r addMorphBack: ( - SimpleButtonMorph new - target: [ - scorePlayer resumePlaying. - r delete - ]; - borderColor: #raised; - borderWidth: 2; - color: Color green; - label: 'Continue' translated; - actionSelector: #value - ). - r setBalloonText: 'Continue playing a paused presentation' translated. - ^r - - - ! Item was removed: - ----- Method: ScorePlayerMorph>>step (in category 'stepping and presenter') ----- - step - - scrollSlider adjustToValue: scorePlayer positionInScore. - - ! Item was removed: - ----- Method: ScorePlayerMorph>>trackControlsFor: (in category 'layout') ----- - trackControlsFor: trackIndex - - | r | - r := self makeRow - hResizing: #shrinkWrap; - vResizing: #shrinkWrap. - r addMorphBack: (self trackNumAndMuteButtonFor: trackIndex). - r addMorphBack: (Morph new extent: 10@5; color: color). "spacer" - r addMorphBack: (self panAndVolControlsFor: trackIndex). - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>trackNumAndMuteButtonFor: (in category 'layout') ----- - trackNumAndMuteButtonFor: trackIndex - - | muteButton instSelector pianoRollColor r | - muteButton := SimpleSwitchMorph new - onColor: (Color r: 1.0 g: 0.6 b: 0.6); - offColor: color; - color: color; - label: 'Mute' translated; - target: scorePlayer; - actionSelector: #mutedForTrack:put:; - arguments: (Array with: trackIndex). - instSelector := PopUpChoiceMorph new - extent: 95@14; - contentsClipped: 'oboe1'; - target: self; - actionSelector: #atTrack:from:selectInstrument:; - getItemsSelector: #instrumentChoicesForTrack:; - getItemsArgs: (Array with: trackIndex). - instSelector arguments: - (Array with: trackIndex with: instSelector). - instrumentSelector at: trackIndex put: instSelector. - - "select track color using same color list as PianoRollScoreMorph" - pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. - - r := self makeRow - hResizing: #rigid; - vResizing: #spaceFill; - extent: 70@10. - r addMorphBack: - ((StringMorph - contents: trackIndex printString - font: (TextStyle default fontOfSize: 24)) color: pianoRollColor). - trackIndex < 10 - ifTrue: [r addMorphBack: (Morph new color: color; extent: 19@8)] "spacer" - ifFalse: [r addMorphBack: (Morph new color: color; extent: 8@8)]. "spacer" - r addMorphBack: - (StringMorph new - extent: 140@14; - contentsClipped: (scorePlayer infoForTrack: trackIndex)). - r addMorphBack: (Morph new color: color; extent: 8@8). "spacer" - r addMorphBack: instSelector. - r addMorphBack: (AlignmentMorph newRow color: color). "spacer" - r addMorphBack: muteButton. - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>updateInstrumentsFromLibraryExcept: (in category 'menu') ----- - updateInstrumentsFromLibraryExcept: soundsBeingEdited - "The instrument library has been modified. Update my instruments with the new versions from the library. Use a single instrument prototype for all parts with the same name; this allows the envelope editor to edit all the parts by changing a single sound prototype." - - "soundsBeingEdited is a collection of sounds being edited (by an EnvelopeEditor). If any of my instruments share one of these, then they will be left alone so as not to disturb that dynamic linkage." - - | unloadPostfix myInstruments name displaysAsUnloaded isUnloaded | - unloadPostfix := '(out)'. - myInstruments := Dictionary new. - 1 to: instrumentSelector size do: [:i | - name := (instrumentSelector at: i) contents. - displaysAsUnloaded := name endsWith: unloadPostfix. - displaysAsUnloaded ifTrue: [ - name := name copyFrom: 1 to: name size - unloadPostfix size]. - (myInstruments includesKey: name) ifFalse: [ - myInstruments at: name put: - (name = 'clink' - ifTrue: [ - (SampledSound - samples: SampledSound coffeeCupClink - samplingRate: 11025) copy] - ifFalse: [ - (AbstractSound - soundNamed: name - ifAbsent: [ - (instrumentSelector at: i) contentsClipped: 'default'. - FMSound default]) copy])]. - (soundsBeingEdited includes: (scorePlayer instrumentForTrack: i)) ifFalse: - ["Do not update any instrument that is currently being edited" - scorePlayer instrumentForTrack: i put: (myInstruments at: name)]. - - "update loaded/unloaded status in instrumentSelector if necessary" - isUnloaded := (myInstruments at: name) isKindOf: UnloadedSound. - (displaysAsUnloaded and: [isUnloaded not]) - ifTrue: [(instrumentSelector at: i) contentsClipped: name]. - (displaysAsUnloaded not and: [isUnloaded]) - ifTrue: [(instrumentSelector at: i) contentsClipped: name, unloadPostfix]]. - ! Item was removed: - ----- Method: ScorePlayerMorph>>volumeControl (in category 'layout') ----- - volumeControl - - | volumeSlider r | - volumeSlider := SimpleSliderMorph new - color: color; - sliderColor: Color gray; - extent: 80@2; - target: scorePlayer; - actionSelector: #overallVolume:; - adjustToValue: scorePlayer overallVolume. - r := self makeRow - hResizing: #shrinkWrap; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: 'soft ' translated). - r addMorphBack: volumeSlider. - r addMorphBack: (StringMorph contents: ' loud' translated). - ^ r - ! Item was removed: - ----- Method: ScorePlayerMorph>>wantsRoundedCorners (in category 'rounding') ----- - wantsRoundedCorners - ^ Preferences roundedWindowCorners or: [super wantsRoundedCorners]! Item was removed: - ImageMorph subclass: #Sonogram - instanceVariableNames: 'lastX scrollDelta columnForm minVal maxVal pixValMap' - classVariableNames: '' - poolDictionaries: '' - category: 'Sound-Synthesis'! - - !Sonogram commentStamp: '<historical>' prior: 0! - Sonograms are imageMorphs that will repeatedly plot arrays of values as black on white columns moving to the right in time and scrolling left as necessary.! Item was removed: - ----- Method: Sonogram>>extent: (in category 'geometry') ----- - extent: newExtent - super image: (Form extent: newExtent depth: Display depth). - lastX := -1. - columnForm := Form extent: (32//image depth)@(image height) depth: image depth. - pixValMap := ((1 to: 256) collect: - [:i | columnForm pixelValueFor: (Color gray: (256-i)/255.0)]) - as: Bitmap. - ! Item was removed: - ----- Method: Sonogram>>extent:minVal:maxVal:scrollDelta: (in category 'all') ----- - extent: extent minVal: min maxVal: max scrollDelta: d - minVal := min. - maxVal := max. - scrollDelta := d. - self extent: extent. - - " try following with scrolldelta = 1, 20, 200 - | s data | - s := Sonogram new extent: 200@50 - minVal: 0.0 maxVal: 1.0 scrollDelta: 20. - World addMorph: s. - data := (1 to: 133) collect: [:i | 0.0]. - 1 to: 300 do: - [:i | data at: (i\\133)+1 put: 1.0. - s plotColumn: data. - data at: (i\\133)+1 put: 0.0. - World doOneCycleNow]. - s delete - "! Item was removed: - ----- Method: Sonogram>>plotColumn: (in category 'all') ----- - plotColumn: dataArray - | chm1 i normVal r | - columnForm unhibernate. - chm1 := columnForm height - 1. - 0 to: chm1 - do: - [:y | - i := y * (dataArray size - 1) // chm1 + 1. - normVal := ((dataArray at: i) - minVal) / (maxVal - minVal). - normVal := normVal max: 0.0. - normVal := normVal min: 1.0. - columnForm bits at: chm1 - y + 1 - put: (pixValMap at: (normVal * 255.0) truncated + 1)]. - (lastX := lastX + 1) > (image width - 1) ifTrue: [self scroll]. - image - copy: (r := lastX @ 0 extent: 1 @ image height) - from: (32 // image depth - 1) @ 0 - in: columnForm - rule: Form over. - "self changed." - self invalidRect: (r translateBy: self position)! Item was removed: - ----- Method: Sonogram>>scroll (in category 'all') ----- - scroll - image copy: (scrollDelta@0 extent: (image width-scrollDelta)@image height) - from: image to: 0@0 rule: Form over. - lastX := lastX - scrollDelta. - self changed! Item was changed: ----- Method: WaveletCodec>>encodeFrames:from:at:into:at: (in category 'subclass responsibilities') ----- encodeFrames: frameCount from: srcSoundBuffer at: srcIndex into: dstByteArray at: dstIndex "Encode the given number of frames starting at the given index in the given monophonic SoundBuffer and storing the encoded sound data into the given ByteArray starting at the given destination index. Encode only as many complete frames as will fit into the destination. Answer a pair containing the number of samples consumed and the number of bytes of compressed data produced." "Note: Assume that the sender has ensured that the given number of frames will not exhaust either the source or destination buffers." + | frameBase coeffs maxVal minVal c scale nullCount frameI outFrameSize threshold "sm" outStream cMin val | - | frameBase coeffs maxVal minVal c scale nullCount frameI outFrameSize threshold sm outStream cMin val | threshold := 2000. fwt ifNil: [samplesPerFrame := self samplesPerFrame. nLevels := 8. "Here are some sample mother wavelets, with the compression achieved on a sample of my voice at a threshold of 2000: compression achieved " alpha := 0.0. beta := 0.0. "12.1" alpha := 1.72. beta := 1.51. "14.0" alpha := -1.86. beta := -1.53. "14.4" alpha := 1.28. beta := -0.86. "15.9" alpha := -1.15. beta := 0.69. "16.0" fwt := FWT new. fwt nSamples: samplesPerFrame nLevels: nLevels. fwt setAlpha: alpha beta: beta]. (outStream := WriteStream on: dstByteArray from: dstIndex to: dstByteArray size) nextNumber: 4 put: frameCount; nextNumber: 4 put: samplesPerFrame; nextNumber: 4 put: nLevels; nextNumber: 4 put: alpha asIEEE32BitWord; nextNumber: 4 put: beta asIEEE32BitWord. frameBase := srcIndex. 1 to: frameCount do: [:frame | "Copy float values into the wavelet sample array" fwt samples: ((frameBase to: frameBase + samplesPerFrame-1) collect: [:i | (srcSoundBuffer at: i) asFloat]). "Compute the transform" fwt transformForward: true. frameI := outStream position+1. "Reserve space for frame size" outStream nextNumber: 2 put: 0. "Determine and output the scale for this frame" coeffs := fwt coeffs. maxVal := 0.0. minVal := 0.0. 5 to: coeffs size do: [:i | c := coeffs at: i. c > maxVal ifTrue: [maxVal := c]. c < minVal ifTrue: [minVal := c]]. scale := (maxVal max: minVal negated) / 16000.0. "Will scale all to -16k..16k: 15 bits" outStream nextNumber: 4 put: scale asIEEE32BitWord. "Copy scaled values, with run-coded sequences of 0's, to destByteArray" nullCount := 0. cMin := threshold / scale. 5 to: coeffs size do: [:i | c := (coeffs at: i) / scale. c abs < cMin ifTrue: ["Below threshold -- count nulls." nullCount := nullCount + 1] ifFalse: ["Above threshold -- emit prior null count and this sample." nullCount > 0 ifTrue: [nullCount <= 112 ifTrue: [outStream nextNumber: 1 put: nullCount-1] ifFalse: [outStream nextNumber: 2 put: (112*256) + nullCount-1]. nullCount := 0]. val := c asInteger + 16384 + 32768. "Map -16k..16k into 32k..64k" outStream nextNumber: 2 put: val]]. nullCount > 0 ifTrue: [nullCount <= 112 ifTrue: [outStream nextNumber: 1 put: nullCount-1] ifFalse: [outStream nextNumber: 2 put: (112*256) + nullCount-1]]. outFrameSize := outStream position+1 - frameI - 2. "Write frame size back at the beginning" (WriteStream on: dstByteArray from: frameI to: dstByteArray size) nextNumber: 2 put: outFrameSize. frameBase := frameBase + samplesPerFrame]. + "fbs: disabled because it induces a Sound -> Morphic dependency. It might still be useful as a debugging aid." "This displays a temporary indication of compression achieved" + "sm := TextMorph new contents: (((frameBase - srcIndex) *2.0 / (outStream position+1 - dstIndex) truncateTo: 0.1) printString , ' : 1') asText allBold. - sm := TextMorph new contents: (((frameBase - srcIndex) *2.0 / (outStream position+1 - dstIndex) truncateTo: 0.1) printString , ' : 1') asText allBold. sm position: Sensor cursorPoint + (-20@30). ActiveWorld addMorph: sm. World doOneCycleNow. + sm delete." - sm delete. outStream position > dstByteArray size ifTrue: ["The calling routine only provides buffer space for compression of 2:1 or better. If you are just testing things, you can increase it to, eg, codeFrameSize := frameSize*3, which would be sufficient for a threshold of 0 (lossless conversion)." self error: 'Buffer overrun']. ^ Array with: frameBase - srcIndex with: outStream position+1 - dstIndex! Item was removed: - ----- Method: ZASMCameraMarkMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category '*sound-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 removed: - ----- Method: ZASMCameraMarkMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category '*sound-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}. - - ! Item was removed: - ----- Method: ZASMCameraMarkMorph>>pauseFrom: (in category '*sound-piano rolls') ----- - pauseFrom: scorePlayer - - self cameraController pauseProgrammedMoves.! Item was removed: - ----- Method: ZASMCameraMarkMorph>>resumeFrom: (in category '*sound-piano rolls') ----- - resumeFrom: scorePlayer - - self cameraController resumeProgrammedMoves!

1 0

Re: [squeak-dev] The Trunk: ReleaseBuilder-fbs.99.mcz
by Frank Shearar 04 Jul '13

04 Jul '13

On 3 July 2013 22:15, <commits(a)source.squeak.org> wrote: > Frank Shearar uploaded a new version of ReleaseBuilder to project The Trunk: > http://source.squeak.org/trunk/ReleaseBuilder-fbs.99.mcz > > ==================== Summary ==================== > > Name: ReleaseBuilder-fbs.99 > Author: fbs > Time: 3 July 2013, 10:15:15.841 pm > UUID: c4defea8-9581-bd4f-b3d2-b1ddcdf5f90b > Ancestors: ReleaseBuilder-fbs.98 > > Ensure that ST80, ST80Tools and SmallLand-ColorTheme are loaded into a released 4..5 image. > > =============== Diff against ReleaseBuilder-fbs.98 =============== > > Item was changed: > ----- Method: ReleaseBuilder class>>loadWellKnownPackages (in category 'private') ----- > loadWellKnownPackages > "Load into the release image those packages that have been stripped from Trunk, but still deemed necessary for a release artifact." > #('311Deprecated' > '39Deprecated' > '45Deprecated' > 'Nebraska' > + 'SmallLand-ColorTheme' > + 'ST80' > + 'ST80Tools' So it should be clear I'm trying a semi-radical experiment here. The base image used in CI has had these three packages removed. This has caused some minor issues, but once I've fixed things, I'll mention a ReleaseSqueakTrunk version that I'd really like people to test. Especially Dave. frank

1 0

The Trunk: Morphic-fbs.663.mcz
by commits＠source.squeak.org 04 Jul '13

04 Jul '13

Frank Shearar uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-fbs.663.mcz ==================== Summary ==================== Name: Morphic-fbs.663 Author: fbs Time: 4 July 2013, 8:14:34.141 pm UUID: 98da4c65-8e7c-7149-ab6a-f260c49c25c7 Ancestors: Morphic-fbs.662 Sound -/-> Morphic. =============== Diff against Morphic-fbs.662 =============== Item was changed: SystemOrganization addCategory: #'Morphic-Balloon'! SystemOrganization addCategory: #'Morphic-Basic'! SystemOrganization addCategory: #'Morphic-Basic-NewCurve'! SystemOrganization addCategory: #'Morphic-Borders'! SystemOrganization addCategory: #'Morphic-Collections-Arrayed'! SystemOrganization addCategory: #'Morphic-Demo'! SystemOrganization addCategory: #'Morphic-Events'! SystemOrganization addCategory: #'Morphic-Explorer'! SystemOrganization addCategory: #'Morphic-Kernel'! SystemOrganization addCategory: #'Morphic-Layouts'! SystemOrganization addCategory: #'Morphic-Menus'! SystemOrganization addCategory: #'Morphic-Menus-DockingBar'! SystemOrganization addCategory: #'Morphic-Models'! SystemOrganization addCategory: #'Morphic-Pluggable Widgets'! + SystemOrganization addCategory: #'Morphic-Sound'! SystemOrganization addCategory: #'Morphic-Support'! SystemOrganization addCategory: #'Morphic-Multilingual'! SystemOrganization addCategory: #'Morphic-Text Support'! SystemOrganization addCategory: #'Morphic-ToolBuilder'! SystemOrganization addCategory: #'Morphic-TrueType'! SystemOrganization addCategory: #'Morphic-Widgets'! SystemOrganization addCategory: #'Morphic-Windows'! SystemOrganization addCategory: #'Morphic-Worlds'! + SystemOrganization addCategory: #'Morphic-Sound-Synthesis'! Item was added: + ----- Method: AbstractSound class>>updateScorePlayers (in category '*Morphic-Sounds-sound library-file in/out') ----- + updateScorePlayers + | soundsBeingEdited | + "Force all ScorePlayers to update their instrument list from the sound library. This may done after loading, unloading, or replacing a sound to make all ScorePlayers feel the change." + + ScorePlayer allSubInstancesDo: + [:p | p pause]. + SoundPlayer shutDown. + soundsBeingEdited := EnvelopeEditorMorph allSubInstances collect: [:ed | ed soundBeingEdited]. + ScorePlayerMorph allSubInstancesDo: + [:p | p updateInstrumentsFromLibraryExcept: soundsBeingEdited]. + ! Item was added: + ----- Method: MIDIFileReader class>>playFileNamed: (in category '*Morphic-Sounds') ----- + playFileNamed: fileName + + ScorePlayerMorph + openOn: (self scoreFromFileNamed: fileName) + title: (FileDirectory localNameFor: fileName). + ! Item was added: + ----- Method: MIDIFileReader class>>playStream: (in category '*Morphic-Sounds') ----- + playStream: binaryStream + + ScorePlayerMorph + openOn: (self scoreFromStream: binaryStream) + title: 'a MIDI stream' + ! Item was added: + ----- Method: MIDIFileReader class>>playURLNamed: (in category '*Morphic-Sounds') ----- + playURLNamed: urlString + + | titleString | + titleString := urlString + copyFrom: (urlString findLast: [:c | c=$/]) + 1 + to: urlString size. + ScorePlayerMorph + openOn: (self scoreFromURL: urlString) + title: titleString. + ! Item was added: + ----- Method: Morph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category '*Morphic-Sound-piano rolls') ----- + addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime + + "a hack to allow for abitrary morphs to be dropped into piano roll" + t > rightTime ifTrue: [^ self]. + t < leftTime ifTrue: [^ self]. + morphList add: (self left: (pianoRoll xForTime: t)). + ! Item was added: + ----- Method: Morph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category '*Morphic-Sound-piano rolls') ----- + encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick + + "a hack to allow for abitrary morphs to be dropped into piano roll" + self triggerActionFromPianoRoll.! Item was added: + ----- Method: Morph>>justDroppedIntoPianoRoll:event: (in category '*Morphic-Sound-piano rolls') ----- + justDroppedIntoPianoRoll: pianoRoll event: evt + + | ambientEvent startTimeInScore | + 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 added: + ----- Method: Morph>>pauseFrom: (in category '*Morphic-Sound-piano rolls') ----- + pauseFrom: scorePlayer + + "subclasses should take five"! Item was added: + ----- Method: Morph>>resetFrom: (in category '*Morphic-Sound-piano rolls') ----- + resetFrom: scorePlayer + + "subclasses should revert to their initial state"! Item was added: + ----- Method: Morph>>resumeFrom: (in category '*Morphic-Sound-piano rolls') ----- + resumeFrom: scorePlayer + + "subclasses should continue from their current position" + "a hack to allow for abitrary morphs to be dropped into piano roll"! Item was added: + ----- Method: Morph>>triggerActionFromPianoRoll (in category '*Morphic-Sound-piano rolls') ----- + triggerActionFromPianoRoll + + | evt | + "a hack to allow for abitrary morphs to be dropped into piano roll" + self world ifNil: [^self]. + evt := MouseEvent new setType: nil position: self center buttons: 0 hand: self world activeHand. + self programmedMouseUp: evt for: self. + + ! Item was added: + Morph subclass: #PianoRollNoteMorph + instanceVariableNames: 'trackIndex indexInTrack hitLoc editMode selected notePlaying' + classVariableNames: 'SoundPlaying' + poolDictionaries: '' + category: 'Morphic-Sound'! + + !PianoRollNoteMorph commentStamp: '<historical>' prior: 0! + A PianoRollNoteMorph is drawn as a simple mroph, but it carries the necessary state to locate its source sound event via its owner (a PianorRollScoreMorph) and the score therein. Simple editing of pitch and time placement is provided here.! Item was added: + ----- Method: PianoRollNoteMorph>>deselect (in category 'selecting') ----- + deselect + + selected ifFalse: [^ self]. + self changed. + selected := false. + ! Item was added: + ----- Method: PianoRollNoteMorph>>drawOn: (in category 'drawing') ----- + drawOn: aCanvas + + selected + ifTrue: [aCanvas frameAndFillRectangle: self fullBounds fillColor: color borderWidth: 1 borderColor: Color black] + ifFalse: [aCanvas fillRectangle: self bounds color: color]. + ! Item was added: + ----- Method: PianoRollNoteMorph>>editPitch: (in category 'editing') ----- + editPitch: evt + + | mk note | + mk := owner midiKeyForY: evt cursorPoint y. + note := (owner score tracks at: trackIndex) at: indexInTrack. + note midiKey = mk ifTrue: [^ self]. + note midiKey: mk. + self playSound: (self soundOfDuration: 999.0). + self position: self position x @ ((owner yForMidiKey: mk) - 1) + ! Item was added: + ----- Method: PianoRollNoteMorph>>fullBounds (in category 'layout') ----- + fullBounds + + selected + ifTrue: [^ bounds expandBy: 1] + ifFalse: [^ bounds]! Item was added: + ----- Method: PianoRollNoteMorph>>gridToNextQuarter (in category 'editing') ----- + gridToNextQuarter + + owner score gridTrack: trackIndex toQuarter: 1 at: indexInTrack. + owner rebuildFromScore! Item was added: + ----- Method: PianoRollNoteMorph>>gridToPrevQuarter (in category 'editing') ----- + gridToPrevQuarter + + owner score gridTrack: trackIndex toQuarter: -1 at: indexInTrack. + owner rebuildFromScore! Item was added: + ----- Method: PianoRollNoteMorph>>handlesMouseDown: (in category 'event handling') ----- + handlesMouseDown: evt + + ^ owner scorePlayer isPlaying not! Item was added: + ----- Method: PianoRollNoteMorph>>indexInTrack (in category 'accessing') ----- + indexInTrack + + ^ indexInTrack! Item was added: + ----- Method: PianoRollNoteMorph>>invokeNoteMenu: (in category 'menu') ----- + invokeNoteMenu: evt + "Invoke the note's edit menu." + + | menu | + menu := MenuMorph new defaultTarget: self. + menu addList: + #(('grid to next quarter' gridToNextQuarter) + ('grid to prev quarter' gridToPrevQuarter)). + + menu popUpEvent: evt in: self world. + ! Item was added: + ----- Method: PianoRollNoteMorph>>mouseDown: (in category 'event handling') ----- + mouseDown: evt + + hitLoc := evt cursorPoint. + editMode := nil. + owner submorphsDo: + [:m | (m isKindOf: PianoRollNoteMorph) ifTrue: [m deselect]]. + selected := true. + self changed. + owner selection: (Array with: trackIndex with: indexInTrack with: indexInTrack). + self playSound! Item was added: + ----- Method: PianoRollNoteMorph>>mouseMove: (in category 'event handling') ----- + mouseMove: evt + | delta offsetEvt | + editMode isNil + ifTrue: + ["First movement determines edit mode" + + ((delta := evt cursorPoint - hitLoc) dist: 0 @ 0) <= 2 + ifTrue: [^self "No significant movement yet."]. + delta x abs > delta y abs + ifTrue: + [delta x > 0 + ifTrue: + ["Horizontal drag" + + editMode := #selectNotes] + ifFalse: + [self playSound: nil. + offsetEvt := evt copy setCursorPoint: evt cursorPoint + (20 @ 0). + self invokeNoteMenu: offsetEvt]] + ifFalse: [editMode := #editPitch "Vertical drag"]]. + editMode == #editPitch ifTrue: [self editPitch: evt]. + editMode == #selectNotes ifTrue: [self selectNotes: evt]! Item was added: + ----- Method: PianoRollNoteMorph>>mouseUp: (in category 'event handling') ----- + mouseUp: evt + + self playSound: nil! Item was added: + ----- Method: PianoRollNoteMorph>>noteInScore (in category 'note playing') ----- + noteInScore + + ^ (owner score tracks at: trackIndex) at: indexInTrack + ! Item was added: + ----- Method: PianoRollNoteMorph>>noteOfDuration: (in category 'note playing') ----- + noteOfDuration: duration + + | note | + note := self noteInScore. + ^ (owner scorePlayer instrumentForTrack: trackIndex) + soundForMidiKey: note midiKey + dur: duration + loudness: (note velocity asFloat / 127.0) + ! Item was added: + ----- Method: PianoRollNoteMorph>>playSound (in category 'note playing') ----- + playSound + "This STARTS a single long sound. It must be stopped by playing another or nil." + + ^ self playSound: (self soundOfDuration: 999.0)! Item was added: + ----- Method: PianoRollNoteMorph>>playSound: (in category 'note playing') ----- + playSound: aSoundOrNil + + SoundPlaying ifNotNil: [SoundPlaying stopGracefully]. + SoundPlaying := aSoundOrNil. + SoundPlaying ifNotNil: [SoundPlaying play].! Item was added: + ----- Method: PianoRollNoteMorph>>select (in category 'selecting') ----- + select + + selected ifTrue: [^ self]. + selected := true. + self changed! Item was added: + ----- Method: PianoRollNoteMorph>>selectFrom: (in category 'selecting') ----- + selectFrom: selection + (trackIndex = selection first and: + [indexInTrack >= (selection second) and: [indexInTrack <= (selection third)]]) + ifTrue: [selected ifFalse: [self select]] + ifFalse: [selected ifTrue: [self deselect]]! Item was added: + ----- Method: PianoRollNoteMorph>>selectNotes: (in category 'selecting') ----- + selectNotes: evt + + | lastMorph oldEnd saveOwner | + saveOwner := owner. + (owner autoScrollForX: evt cursorPoint x) ifTrue: + ["If scroll talkes place I will be deleted and my x-pos will become invalid." + owner := saveOwner. + bounds := bounds withLeft: (owner xForTime: self noteInScore time)]. + oldEnd := owner selection last. + (owner notesInRect: (evt cursorPoint x @ owner top corner: owner bottomRight)) + do: [:m | m trackIndex = trackIndex ifTrue: [m deselect]]. + self select. lastMorph := self. + (owner notesInRect: (self left @ owner top corner: evt cursorPoint x @ owner bottom)) + do: [:m | m trackIndex = trackIndex ifTrue: [m select. lastMorph := m]]. + owner selection: (Array with: trackIndex with: indexInTrack with: lastMorph indexInTrack). + lastMorph indexInTrack ~= oldEnd ifTrue: + ["Play last note as selection grows or shrinks" + owner ifNotNil: [lastMorph playSound]] + ! Item was added: + ----- Method: PianoRollNoteMorph>>selected (in category 'selecting') ----- + selected + + ^ selected! Item was added: + ----- Method: PianoRollNoteMorph>>soundOfDuration: (in category 'note playing') ----- + soundOfDuration: duration + + | sound | + sound := MixedSound new. + sound add: (self noteOfDuration: duration) + pan: (owner scorePlayer panForTrack: trackIndex) + volume: owner scorePlayer overallVolume * + (owner scorePlayer volumeForTrack: trackIndex). + ^ sound reset + ! Item was added: + ----- Method: PianoRollNoteMorph>>trackIndex (in category 'accessing') ----- + trackIndex + + ^ trackIndex! Item was added: + ----- Method: PianoRollNoteMorph>>trackIndex:indexInTrack: (in category 'initialization') ----- + trackIndex: ti indexInTrack: i + + trackIndex := ti. + indexInTrack := i. + selected := false! Item was added: + ----- Method: ProjectViewMorph>>triggerActionFromPianoRoll (in category '*Morphic-Sound-piano rolls') ----- + triggerActionFromPianoRoll + + WorldState addDeferredUIMessage: [ + project world setProperty: #letTheMusicPlay toValue: true. + self enter. + ]! Item was added: + ----- Method: SampledSound>>sonogramMorph:from:to:nPoints: (in category '*Morphic-Sounds-sound tracks') ----- + sonogramMorph: height from: start to: stop nPoints: nPoints + "FYI: It is very cool that we can do this, but for sound tracks on a movie, + simple volume is easier to read, easier to scale, and way faster to compute. + Code preserved here just in case it makes a useful example." + "In an inspector of a samplesSound... + self currentWorld addMorph: (self sonogramMorph: 32 from: 1 to: 50000 nPoints: 256) + " + | fft sonogramMorph width | + fft := FFT new: nPoints. + width := stop-start//nPoints. + sonogramMorph := Sonogram new + extent: width@height + minVal: 0.0 + maxVal: 1.0 + scrollDelta: width. + start to: stop-nPoints by: nPoints do: + [:i | | data | + data := fft transformDataFrom: samples startingAt: i. + data := data collect: [:v | v sqrt]. "square root compresses dynamic range" + data /= 200.0. + sonogramMorph plotColumn: data]. + ^ sonogramMorph + + ! Item was added: + AlignmentMorph subclass: #ScorePlayerMorph + instanceVariableNames: 'scorePlayer trackInstNames instrumentSelector scrollSlider' + classVariableNames: 'LastMIDIPort' + poolDictionaries: '' + category: 'Morphic-Sound'! + + !ScorePlayerMorph commentStamp: '<historical>' prior: 0! + A ScorePlayerMorph mediates between a score such as a MIDIScore, a PianoRollScoreMorph, and the actual SoundPlayer synthesizer. + + It provides control over volume, tempo, instrumentation, and location in the score.! Item was added: + ----- Method: ScorePlayerMorph class>>descriptionForPartsBin (in category 'parts bin') ----- + descriptionForPartsBin + ^ self partName: 'ScorePlayer' + categories: #('Multimedia') + documentation: ' Mediates between a score such as a MIDIScore, a PianoRollScoreMorph, and the actual SoundPlayer synthesizer'! Item was added: + ----- Method: ScorePlayerMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') ----- + fileReaderServicesForFile: fullName suffix: suffix + + ^(suffix = 'mid') | (suffix = '*') + ifTrue: [ self services] + ifFalse: [#()] + ! Item was added: + ----- Method: ScorePlayerMorph class>>initialize (in category 'class initialization') ----- + initialize + + FileServices registerFileReader: self! Item was added: + ----- Method: ScorePlayerMorph class>>onMIDIFileNamed: (in category 'system hookup') ----- + onMIDIFileNamed: fileName + "Return a ScorePlayerMorph on the score from the MIDI file of the given name." + + | score player | + score := MIDIFileReader scoreFromFileNamed: fileName . + player := ScorePlayer onScore: score. + ^ self new onScorePlayer: player title: fileName + ! Item was added: + ----- Method: ScorePlayerMorph class>>openOn:title: (in category 'system hookup') ----- + openOn: aScore title: aString + + | player | + player := ScorePlayer onScore: aScore. + (self new onScorePlayer: player title: aString) openInWorld. + ! Item was added: + ----- Method: ScorePlayerMorph class>>playMidiFile: (in category 'class initialization') ----- + playMidiFile: fullName + "Play a MIDI file." + + Smalltalk at: #MIDIFileReader ifPresent: [:midiReader | + | f score | + f := (FileStream oldFileNamed: fullName) binary. + score := (midiReader new readMIDIFrom: f) asScore. + f close. + self openOn: score title: (FileDirectory localNameFor: fullName)] + ! Item was added: + ----- Method: ScorePlayerMorph class>>servicePlayMidiFile (in category 'class initialization') ----- + servicePlayMidiFile + "Answer a service for opening player on a midi file" + + ^ SimpleServiceEntry + provider: self + label: 'open in midi player' + selector: #playMidiFile: + description: 'open the midi-player tool on this file' + buttonLabel: 'open'! Item was added: + ----- Method: ScorePlayerMorph class>>services (in category 'fileIn/Out') ----- + services + + ^ Array with: self servicePlayMidiFile + + ! Item was added: + ----- Method: ScorePlayerMorph class>>unload (in category 'initialize-release') ----- + unload + + FileServices unregisterFileReader: self ! Item was added: + ----- Method: ScorePlayerMorph>>atTrack:from:selectInstrument: (in category 'controls') ----- + atTrack: trackIndex from: aPopUpChoice selectInstrument: selection + | oldSnd name snd | + oldSnd := scorePlayer instrumentForTrack: trackIndex. + (selection beginsWith: 'edit ') + ifTrue: + [name := selection copyFrom: 6 to: selection size. + aPopUpChoice contentsClipped: name. + (oldSnd isKindOf: FMSound) | (oldSnd isKindOf: LoopedSampledSound) + ifTrue: [EnvelopeEditorMorph openOn: oldSnd title: name]. + (oldSnd isKindOf: SampledInstrument) + ifTrue: [EnvelopeEditorMorph openOn: oldSnd allNotes first title: name]. + ^self]. + snd := nil. + 1 to: instrumentSelector size + do: + [:i | + (trackIndex ~= i and: [selection = (instrumentSelector at: i) contents]) + ifTrue: [snd := scorePlayer instrumentForTrack: i]]. "use existing instrument prototype" + snd ifNil: + [snd := (selection = 'clink' + ifTrue: + [(SampledSound samples: SampledSound coffeeCupClink + samplingRate: 11025) ] + ifFalse: [(AbstractSound soundNamed: selection)]) copy]. + scorePlayer instrumentForTrack: trackIndex put: snd. + (instrumentSelector at: trackIndex) contentsClipped: selection! Item was added: + ----- Method: ScorePlayerMorph>>closeMIDIPort (in category 'initialization') ----- + closeMIDIPort + + scorePlayer closeMIDIPort. + LastMIDIPort := nil. + ! Item was added: + ----- Method: ScorePlayerMorph>>defaultBorderWidth (in category 'initialization') ----- + defaultBorderWidth + "answer the default border width for the receiver" + ^ 2! Item was added: + ----- Method: ScorePlayerMorph>>defaultColor (in category 'initialization') ----- + defaultColor + "answer the default color/fill style for the receiver" + ^ Color veryLightGray! Item was added: + ----- Method: ScorePlayerMorph>>initialize (in category 'initialization') ----- + initialize + "initialize the state of the receiver" + super initialize. + "" + self listDirection: #topToBottom; + wrapCentering: #center; + cellPositioning: #topCenter; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + layoutInset: 3; + onScorePlayer: ScorePlayer new initialize title: ' '; + extent: 20 @ 20 ! Item was added: + ----- Method: ScorePlayerMorph>>instrumentChoicesForTrack: (in category 'menu') ----- + instrumentChoicesForTrack: trackIndex + | names | + names := AbstractSound soundNames asOrderedCollection. + names := names collect: [:n | + | inst | + inst := AbstractSound soundNamed: n. + (inst isKindOf: UnloadedSound) + ifTrue: [n, '(out)'] + ifFalse: [n]]. + names add: 'clink'. + names add: 'edit ', (instrumentSelector at: trackIndex) contents. + ^ names asArray + ! Item was added: + ----- Method: ScorePlayerMorph>>invokeMenu (in category 'menu') ----- + invokeMenu + "Invoke a menu of additonal functions for this ScorePlayer." + + | aMenu | + aMenu := MenuMorph new defaultTarget: self. + aMenu add: 'open a MIDI file' translated action: #openMIDIFile. + aMenu addList: { + #-. + {'save as AIFF file' translated. #saveAsAIFF}. + {'save as WAV file' translated. #saveAsWAV}. + {'save as Sun AU file' translated. #saveAsSunAudio}. + #-}. + aMenu add: 'reload instruments' translated target: AbstractSound selector: #updateScorePlayers. + aMenu addLine. + scorePlayer midiPort + ifNil: [ + aMenu add: 'play via MIDI' translated action: #openMIDIPort] + ifNotNil: [ + aMenu add: 'play via built in synth' translated action: #closeMIDIPort. + aMenu add: 'new MIDI controller' translated action: #makeMIDIController:]. + aMenu addLine. + aMenu add: 'make a pause marker' translated action: #makeAPauseEvent:. + + aMenu popUpInWorld: self world. + ! Item was added: + ----- Method: ScorePlayerMorph>>makeAPauseEvent: (in category 'menu') ----- + makeAPauseEvent: evt + + | newWidget | + + newWidget := AlignmentMorph newRow. + newWidget + color: Color orange; + borderWidth: 0; + layoutInset: 0; + hResizing: #shrinkWrap; + vResizing: #shrinkWrap; + extent: 5@5; + addMorph: (StringMorph contents: '[pause]' translated) lock; + addMouseUpActionWith: ( + MessageSend receiver: self selector: #showResumeButtonInTheWorld + ). + + evt hand attachMorph: newWidget.! Item was added: + ----- Method: ScorePlayerMorph>>makeControls (in category 'layout') ----- + makeControls + + | bb r reverbSwitch repeatSwitch | + r := AlignmentMorph newRow. + r color: color; borderWidth: 0; layoutInset: 0. + r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. + bb := SimpleButtonMorph new target: self; borderColor: #raised; + borderWidth: 2; color: color. + r addMorphBack: (bb label: '<>'; actWhen: #buttonDown; + actionSelector: #invokeMenu). + bb := SimpleButtonMorph new target: self; borderColor: #raised; + borderWidth: 2; color: color. + r addMorphBack: (bb label: 'Piano Roll' translated; actionSelector: #makePianoRoll). + bb := SimpleButtonMorph new target: self; borderColor: #raised; + borderWidth: 2; color: color. + r addMorphBack: (bb label: 'Rewind' translated; actionSelector: #rewind). + bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; + borderWidth: 2; color: color. + r addMorphBack: (bb label: 'Play' translated; actionSelector: #resumePlaying). + bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; + borderWidth: 2; color: color. + r addMorphBack: (bb label: 'Pause' translated; actionSelector: #pause). + reverbSwitch := SimpleSwitchMorph new + offColor: color; + onColor: (Color r: 1.0 g: 0.6 b: 0.6); + borderWidth: 2; + label: 'Reverb Disable' translated; + actionSelector: #disableReverb:; + target: scorePlayer; + setSwitchState: SoundPlayer isReverbOn not. + r addMorphBack: reverbSwitch. + scorePlayer ifNotNil: + [repeatSwitch := SimpleSwitchMorph new + offColor: color; + onColor: (Color r: 1.0 g: 0.6 b: 0.6); + borderWidth: 2; + label: 'Repeat' translated; + actionSelector: #repeat:; + target: scorePlayer; + setSwitchState: scorePlayer repeat. + r addMorphBack: repeatSwitch]. + ^ r + ! Item was added: + ----- Method: ScorePlayerMorph>>makeMIDIController: (in category 'layout') ----- + makeMIDIController: evt + + self world activeHand attachMorph: + (MIDIControllerMorph new midiPort: scorePlayer midiPort). + ! Item was added: + ----- Method: ScorePlayerMorph>>makePianoRoll (in category 'layout') ----- + makePianoRoll + "Create a piano roll viewer for this score player." + + | pianoRoll hand | + pianoRoll := PianoRollScoreMorph new on: scorePlayer. + hand := self world activeHand. + hand ifNil: [self world addMorph: pianoRoll] + ifNotNil: [hand attachMorph: pianoRoll. + hand lastEvent shiftPressed ifTrue: + ["Special case for NOBM demo" + pianoRoll contractTime; contractTime; enableDragNDrop]]. + pianoRoll startStepping. + ! Item was added: + ----- Method: ScorePlayerMorph>>makeRow (in category 'layout') ----- + makeRow + + ^ AlignmentMorph newRow + color: color; + layoutInset: 0; + wrapCentering: #center; cellPositioning: #leftCenter; + hResizing: #spaceFill; + vResizing: #shrinkWrap + ! Item was added: + ----- Method: ScorePlayerMorph>>onScorePlayer:title: (in category 'initialization') ----- + onScorePlayer: aScorePlayer title: scoreName + | divider col r | + scorePlayer := aScorePlayer. + scorePlayer ifNotNil: + [scorePlayer reset. + instrumentSelector := Array new: scorePlayer score tracks size]. + + self removeAllMorphs. + self addMorphBack: self makeControls. + scorePlayer ifNil: [^ self]. + + r := self makeRow + hResizing: #shrinkWrap; + vResizing: #shrinkWrap. + r addMorphBack: self rateControl; + addMorphBack: (Morph newBounds: (0@0 extent: 20@0) color: Color transparent); + addMorphBack: self volumeControl. + self addMorphBack: r. + self addMorphBack: self scrollControl. + + col := AlignmentMorph newColumn color: color; layoutInset: 0. + self addMorphBack: col. + 1 to: scorePlayer trackCount do: [:trackIndex | + divider := AlignmentMorph new + extent: 10@1; + borderWidth: 1; + layoutInset: 0; + borderColor: #raised; + color: color; + hResizing: #spaceFill; + vResizing: #rigid. + col addMorphBack: divider. + col addMorphBack: (self trackControlsFor: trackIndex)]. + + LastMIDIPort ifNotNil: [ + "use the most recently set MIDI port" + scorePlayer openMIDIPort: LastMIDIPort]. + ! Item was added: + ----- Method: ScorePlayerMorph>>openMIDIFile (in category 'initialization') ----- + openMIDIFile + "Open a MIDI score and re-init controls..." + | score fileName f player | + fileName := Utilities chooseFileWithSuffixFromList: #('.mid' '.midi') + withCaption: 'Choose a MIDI file to open' translated. + (fileName isNil or: [ fileName == #none ]) + ifTrue: [^ self inform: 'No .mid/.midi files found in the Squeak directory' translated]. + f := FileStream readOnlyFileNamed: fileName. + score := (MIDIFileReader new readMIDIFrom: f binary) asScore. + f close. + player := ScorePlayer onScore: score. + self onScorePlayer: player title: fileName! Item was added: + ----- Method: ScorePlayerMorph>>openMIDIPort (in category 'initialization') ----- + openMIDIPort + + | portNum | + portNum := SimpleMIDIPort outputPortNumFromUser. + portNum ifNil: [^ self]. + scorePlayer openMIDIPort: portNum. + LastMIDIPort := portNum. + ! Item was added: + ----- Method: ScorePlayerMorph>>panAndVolControlsFor: (in category 'layout') ----- + panAndVolControlsFor: trackIndex + + | volSlider panSlider c r middleLine pianoRollColor | + pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. + volSlider := SimpleSliderMorph new + color: color; + sliderColor: pianoRollColor; + extent: 101@2; + target: scorePlayer; + arguments: (Array with: trackIndex); + actionSelector: #volumeForTrack:put:; + minVal: 0.0; + maxVal: 1.0; + adjustToValue: (scorePlayer volumeForTrack: trackIndex). + panSlider := SimpleSliderMorph new + color: color; + sliderColor: pianoRollColor; + extent: 101@2; + target: scorePlayer; + arguments: (Array with: trackIndex); + actionSelector: #panForTrack:put:; + minVal: 0.0; + maxVal: 1.0; + adjustToValue: (scorePlayer panForTrack: trackIndex). + c := AlignmentMorph newColumn + color: color; + layoutInset: 0; + wrapCentering: #center; cellPositioning: #topCenter; + hResizing: #spaceFill; + vResizing: #shrinkWrap. + middleLine := Morph new "center indicator for pan slider" + color: (Color r: 0.4 g: 0.4 b: 0.4); + extent: 1@(panSlider height - 4); + position: panSlider center x@(panSlider top + 2). + panSlider addMorphBack: middleLine. + r := self makeRow. + r addMorphBack: (StringMorph contents: '0'). + r addMorphBack: volSlider. + r addMorphBack: (StringMorph contents: '10'). + c addMorphBack: r. + r := self makeRow. + r addMorphBack: (StringMorph contents: 'L' translated). + r addMorphBack: panSlider. + r addMorphBack: (StringMorph contents: 'R' translated). + c addMorphBack: r. + ^ c + ! Item was added: + ----- Method: ScorePlayerMorph>>rateControl (in category 'layout') ----- + rateControl + + | rateSlider middleLine r | + rateSlider := SimpleSliderMorph new + color: color; + sliderColor: Color gray; + extent: 180@2; + target: self; + actionSelector: #setLogRate:; + minVal: -1.0; + maxVal: 1.0; + adjustToValue: 0.0. + middleLine := Morph new "center indicator for pan slider" + color: (Color r: 0.4 g: 0.4 b: 0.4); + extent: 1@(rateSlider height - 4); + position: rateSlider center x@(rateSlider top + 2). + rateSlider addMorphBack: middleLine. + r := self makeRow + hResizing: #shrinkWrap; + vResizing: #rigid; + height: 24. + r addMorphBack: (StringMorph contents: 'slow ' translated). + r addMorphBack: rateSlider. + r addMorphBack: (StringMorph contents: ' fast' translated). + ^ r + ! Item was added: + ----- Method: ScorePlayerMorph>>rewind (in category 'controls') ----- + rewind + + scorePlayer pause; reset. + ! Item was added: + ----- Method: ScorePlayerMorph>>saveAsAIFF (in category 'menu') ----- + saveAsAIFF + "Create a stereo AIFF audio file with the result of performing my score." + + | fileName | + fileName := UIManager default request: 'New file name?' translated. + fileName isEmpty ifTrue: [^ self]. + (fileName asLowercase endsWith: '.aif') ifFalse: [ + fileName := fileName, '.aif']. + + scorePlayer storeAIFFOnFileNamed: fileName. + ! Item was added: + ----- Method: ScorePlayerMorph>>saveAsSunAudio (in category 'menu') ----- + saveAsSunAudio + "Create a stereo Sun audio file with the result of performing my score." + + | fileName | + fileName := UIManager default request: 'New file name?' translated. + fileName isEmpty ifTrue: [^ self]. + (fileName asLowercase endsWith: '.au') ifFalse: [ + fileName := fileName, '.au']. + + scorePlayer storeSunAudioOnFileNamed: fileName. + ! Item was added: + ----- Method: ScorePlayerMorph>>saveAsWAV (in category 'menu') ----- + saveAsWAV + "Create a stereo WAV audio file with the result of performing my score." + + | fileName | + fileName := UIManager default request: 'New file name?' translated. + fileName isEmpty ifTrue: [^ self]. + (fileName asLowercase endsWith: '.wav') ifFalse: [ + fileName := fileName, '.wav']. + + scorePlayer storeWAVOnFileNamed: fileName. + ! Item was added: + ----- Method: ScorePlayerMorph>>scorePlayer (in category 'accessing') ----- + scorePlayer + + ^ scorePlayer + ! Item was added: + ----- Method: ScorePlayerMorph>>scrollControl (in category 'layout') ----- + scrollControl + + | r | + scrollSlider := SimpleSliderMorph new + color: color; + sliderColor: Color gray; + extent: 360@2; + target: scorePlayer; + actionSelector: #positionInScore:; + adjustToValue: scorePlayer positionInScore. + r := self makeRow + hResizing: #shrinkWrap; + vResizing: #rigid; + height: 24. + r addMorphBack: (StringMorph contents: 'start ' translated). + r addMorphBack: scrollSlider. + r addMorphBack: (StringMorph contents: ' end' translated). + ^ r + ! Item was added: + ----- Method: ScorePlayerMorph>>setLogRate: (in category 'controls') ----- + setLogRate: logOfRate + + scorePlayer rate: (3.5 raisedTo: logOfRate). + ! Item was added: + ----- Method: ScorePlayerMorph>>showResumeButtonInTheWorld (in category 'layout') ----- + showResumeButtonInTheWorld + WorldState addDeferredUIMessage: [ + | w | + w := self world. + w ifNotNil: [ + w addMorphFront: + (self standaloneResumeButton position: (w right - 100) @ (w top + 10)). + scorePlayer pause. + ]. + ] + ! Item was added: + ----- Method: ScorePlayerMorph>>standaloneResumeButton (in category 'layout') ----- + standaloneResumeButton + + | r | + + r := AlignmentMorph newRow. + r color: Color red; borderWidth: 0; layoutInset: 6; useRoundedCorners. + r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5. + r addMorphBack: ( + SimpleButtonMorph new + target: [ + scorePlayer resumePlaying. + r delete + ]; + borderColor: #raised; + borderWidth: 2; + color: Color green; + label: 'Continue' translated; + actionSelector: #value + ). + r setBalloonText: 'Continue playing a paused presentation' translated. + ^r + + + ! Item was added: + ----- Method: ScorePlayerMorph>>step (in category 'stepping and presenter') ----- + step + + scrollSlider adjustToValue: scorePlayer positionInScore. + + ! Item was added: + ----- Method: ScorePlayerMorph>>trackControlsFor: (in category 'layout') ----- + trackControlsFor: trackIndex + + | r | + r := self makeRow + hResizing: #shrinkWrap; + vResizing: #shrinkWrap. + r addMorphBack: (self trackNumAndMuteButtonFor: trackIndex). + r addMorphBack: (Morph new extent: 10@5; color: color). "spacer" + r addMorphBack: (self panAndVolControlsFor: trackIndex). + ^ r + ! Item was added: + ----- Method: ScorePlayerMorph>>trackNumAndMuteButtonFor: (in category 'layout') ----- + trackNumAndMuteButtonFor: trackIndex + + | muteButton instSelector pianoRollColor r | + muteButton := SimpleSwitchMorph new + onColor: (Color r: 1.0 g: 0.6 b: 0.6); + offColor: color; + color: color; + label: 'Mute' translated; + target: scorePlayer; + actionSelector: #mutedForTrack:put:; + arguments: (Array with: trackIndex). + instSelector := PopUpChoiceMorph new + extent: 95@14; + contentsClipped: 'oboe1'; + target: self; + actionSelector: #atTrack:from:selectInstrument:; + getItemsSelector: #instrumentChoicesForTrack:; + getItemsArgs: (Array with: trackIndex). + instSelector arguments: + (Array with: trackIndex with: instSelector). + instrumentSelector at: trackIndex put: instSelector. + + "select track color using same color list as PianoRollScoreMorph" + pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. + + r := self makeRow + hResizing: #rigid; + vResizing: #spaceFill; + extent: 70@10. + r addMorphBack: + ((StringMorph + contents: trackIndex printString + font: (TextStyle default fontOfSize: 24)) color: pianoRollColor). + trackIndex < 10 + ifTrue: [r addMorphBack: (Morph new color: color; extent: 19@8)] "spacer" + ifFalse: [r addMorphBack: (Morph new color: color; extent: 8@8)]. "spacer" + r addMorphBack: + (StringMorph new + extent: 140@14; + contentsClipped: (scorePlayer infoForTrack: trackIndex)). + r addMorphBack: (Morph new color: color; extent: 8@8). "spacer" + r addMorphBack: instSelector. + r addMorphBack: (AlignmentMorph newRow color: color). "spacer" + r addMorphBack: muteButton. + ^ r + ! Item was added: + ----- Method: ScorePlayerMorph>>updateInstrumentsFromLibraryExcept: (in category 'menu') ----- + updateInstrumentsFromLibraryExcept: soundsBeingEdited + "The instrument library has been modified. Update my instruments with the new versions from the library. Use a single instrument prototype for all parts with the same name; this allows the envelope editor to edit all the parts by changing a single sound prototype." + + "soundsBeingEdited is a collection of sounds being edited (by an EnvelopeEditor). If any of my instruments share one of these, then they will be left alone so as not to disturb that dynamic linkage." + + | unloadPostfix myInstruments name displaysAsUnloaded isUnloaded | + unloadPostfix := '(out)'. + myInstruments := Dictionary new. + 1 to: instrumentSelector size do: [:i | + name := (instrumentSelector at: i) contents. + displaysAsUnloaded := name endsWith: unloadPostfix. + displaysAsUnloaded ifTrue: [ + name := name copyFrom: 1 to: name size - unloadPostfix size]. + (myInstruments includesKey: name) ifFalse: [ + myInstruments at: name put: + (name = 'clink' + ifTrue: [ + (SampledSound + samples: SampledSound coffeeCupClink + samplingRate: 11025) copy] + ifFalse: [ + (AbstractSound + soundNamed: name + ifAbsent: [ + (instrumentSelector at: i) contentsClipped: 'default'. + FMSound default]) copy])]. + (soundsBeingEdited includes: (scorePlayer instrumentForTrack: i)) ifFalse: + ["Do not update any instrument that is currently being edited" + scorePlayer instrumentForTrack: i put: (myInstruments at: name)]. + + "update loaded/unloaded status in instrumentSelector if necessary" + isUnloaded := (myInstruments at: name) isKindOf: UnloadedSound. + (displaysAsUnloaded and: [isUnloaded not]) + ifTrue: [(instrumentSelector at: i) contentsClipped: name]. + (displaysAsUnloaded not and: [isUnloaded]) + ifTrue: [(instrumentSelector at: i) contentsClipped: name, unloadPostfix]]. + ! Item was added: + ----- Method: ScorePlayerMorph>>volumeControl (in category 'layout') ----- + volumeControl + + | volumeSlider r | + volumeSlider := SimpleSliderMorph new + color: color; + sliderColor: Color gray; + extent: 80@2; + target: scorePlayer; + actionSelector: #overallVolume:; + adjustToValue: scorePlayer overallVolume. + r := self makeRow + hResizing: #shrinkWrap; + vResizing: #rigid; + height: 24. + r addMorphBack: (StringMorph contents: 'soft ' translated). + r addMorphBack: volumeSlider. + r addMorphBack: (StringMorph contents: ' loud' translated). + ^ r + ! Item was added: + ----- Method: ScorePlayerMorph>>wantsRoundedCorners (in category 'rounding') ----- + wantsRoundedCorners + ^ Preferences roundedWindowCorners or: [super wantsRoundedCorners]! Item was added: + ImageMorph subclass: #Sonogram + instanceVariableNames: 'lastX scrollDelta columnForm minVal maxVal pixValMap' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Sound-Synthesis'! + + !Sonogram commentStamp: '<historical>' prior: 0! + Sonograms are imageMorphs that will repeatedly plot arrays of values as black on white columns moving to the right in time and scrolling left as necessary.! Item was added: + ----- Method: Sonogram>>extent: (in category 'geometry') ----- + extent: newExtent + super image: (Form extent: newExtent depth: Display depth). + lastX := -1. + columnForm := Form extent: (32//image depth)@(image height) depth: image depth. + pixValMap := ((1 to: 256) collect: + [:i | columnForm pixelValueFor: (Color gray: (256-i)/255.0)]) + as: Bitmap. + ! Item was added: + ----- Method: Sonogram>>extent:minVal:maxVal:scrollDelta: (in category 'all') ----- + extent: extent minVal: min maxVal: max scrollDelta: d + minVal := min. + maxVal := max. + scrollDelta := d. + self extent: extent. + + " try following with scrolldelta = 1, 20, 200 + | s data | + s := Sonogram new extent: 200@50 + minVal: 0.0 maxVal: 1.0 scrollDelta: 20. + World addMorph: s. + data := (1 to: 133) collect: [:i | 0.0]. + 1 to: 300 do: + [:i | data at: (i\\133)+1 put: 1.0. + s plotColumn: data. + data at: (i\\133)+1 put: 0.0. + World doOneCycleNow]. + s delete + "! Item was added: + ----- Method: Sonogram>>plotColumn: (in category 'all') ----- + plotColumn: dataArray + | chm1 i normVal r | + columnForm unhibernate. + chm1 := columnForm height - 1. + 0 to: chm1 + do: + [:y | + i := y * (dataArray size - 1) // chm1 + 1. + normVal := ((dataArray at: i) - minVal) / (maxVal - minVal). + normVal := normVal max: 0.0. + normVal := normVal min: 1.0. + columnForm bits at: chm1 - y + 1 + put: (pixValMap at: (normVal * 255.0) truncated + 1)]. + (lastX := lastX + 1) > (image width - 1) ifTrue: [self scroll]. + image + copy: (r := lastX @ 0 extent: 1 @ image height) + from: (32 // image depth - 1) @ 0 + in: columnForm + rule: Form over. + "self changed." + self invalidRect: (r translateBy: self position)! Item was added: + ----- Method: Sonogram>>scroll (in category 'all') ----- + scroll + image copy: (scrollDelta@0 extent: (image width-scrollDelta)@image height) + from: image to: 0@0 rule: Form over. + lastX := lastX - scrollDelta. + self changed!

1 0

The Trunk: MorphicExtras-fbs.113.mcz
by commits＠source.squeak.org 04 Jul '13

04 Jul '13

Frank Shearar uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-fbs.113.mcz ==================== Summary ==================== Name: MorphicExtras-fbs.113 Author: fbs Time: 4 July 2013, 8:13:40.115 pm UUID: 46d02786-4625-fc44-9936-54fe4525811d Ancestors: MorphicExtras-fbs.112 Sound -/-> MorphicExtras. =============== Diff against MorphicExtras-fbs.112 =============== Item was changed: SystemOrganization addCategory: #'MorphicExtras-AdditionalMorphs'! SystemOrganization addCategory: #'MorphicExtras-AdditionalSupport'! SystemOrganization addCategory: #'MorphicExtras-AdditionalWidgets'! SystemOrganization addCategory: #'MorphicExtras-Books'! SystemOrganization addCategory: #'MorphicExtras-Demo'! SystemOrganization addCategory: #'MorphicExtras-EToy-Download'! SystemOrganization addCategory: #'MorphicExtras-Flaps'! SystemOrganization addCategory: #'MorphicExtras-GeeMail'! SystemOrganization addCategory: #'MorphicExtras-Leds'! SystemOrganization addCategory: #'MorphicExtras-Navigators'! SystemOrganization addCategory: #'MorphicExtras-Obsolete'! SystemOrganization addCategory: #'MorphicExtras-Palettes'! SystemOrganization addCategory: #'MorphicExtras-PartsBin'! SystemOrganization addCategory: #'MorphicExtras-Postscript Canvases'! SystemOrganization addCategory: #'MorphicExtras-Postscript Filters'! SystemOrganization addCategory: #'MorphicExtras-SoundInterface'! SystemOrganization addCategory: #'MorphicExtras-SqueakPage'! SystemOrganization addCategory: #'MorphicExtras-Support'! SystemOrganization addCategory: #'MorphicExtras-Text Support'! SystemOrganization addCategory: #'MorphicExtras-Undo'! SystemOrganization addCategory: #'MorphicExtras-Widgets'! + SystemOrganization addCategory: #'MorphicExtras-Sound'! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: AbstractSound>>viewSamples (in category '*MorphicExtras-Sound') ----- + viewSamples + "Open a WaveEditor on my samples." + + WaveEditor openOn: self samples. + ! Item was added: + ----- Method: BookPageThumbnailMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'piano rolls') ----- + encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick + "Flip to this page with no extra sound" + BookMorph turnOffSoundWhile: [self doPageFlip]! Item was added: + ----- 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 added: + ----- 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@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@18; color: Color gray. + recordMeter := Morph new extent: 1@16; color: Color yellow. + recordMeter position: meterBox topLeft + (1@1). + meterBox addMorph: recordMeter. + + r := AlignmentMorph newRow vResizing: #shrinkWrap. + r addMorphBack: meterBox. + self addMorphBack: r. + ! Item was added: + ----- Method: EventRecorderMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'sound-piano rolls') ----- + encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick + + self play.! Item was added: + ----- 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 added: + ----- Method: EventRecorderMorph>>myDurationInMS (in category 'sound-piano rolls') ----- + myDurationInMS + + ^tape isEmptyOrNil ifTrue: [ + 10 + ] ifFalse: [ + tape last timeStamp - tape first timeStamp + ] + ! Item was added: + ----- Method: GraphMorph>>addCustomMenuItems:hand: (in category 'sound') ----- + addCustomMenuItems: aCustomMenu hand: aHandMorph + + super addCustomMenuItems: aCustomMenu hand: aHandMorph. + aCustomMenu add: 'open wave editor' translated action: #openWaveEditor. + aCustomMenu add: 'read file' translated action: #readDataFromFile. + ! Item was added: + ----- 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 added: + ----- Method: GraphMorph>>readDataFromFile (in category 'sound') ----- + readDataFromFile + + | fileName | + fileName := UIManager default + request: 'File name?' translated + initialAnswer: ''. + fileName isEmpty ifTrue: [^ self]. + (StandardFileStream isAFileNamed: fileName) ifFalse: [ + ^ self inform: 'Sorry, I cannot find that file' translated]. + self data: (SampledSound fromAIFFfileNamed: fileName) samples. + + ! Item was added: + PianoKeyboardMorph subclass: #KeyboardMorphForInput + instanceVariableNames: 'pianoRoll duration durationModifier articulation buildingChord insertMode prevSelection startOfNextNote' + classVariableNames: '' + poolDictionaries: '' + category: 'MorphicExtras-Sound'! + + !KeyboardMorphForInput commentStamp: 'nice 3/24/2010 07:37' prior: 0! + This class adds state and controls to the basic PianoKeyboardMorph so that notes of reliable duration can be keyed into a score without the need for a real keyboard. + + To try this out, execute... + + | n score | n := 3. + score := (MIDIScore new tracks: ((1 to: n) collect: [:i | Array new]); + trackInfo: ((1 to: n) collect: [:i | 'Instrument' , i printString]); + tempoMap: nil; ticksPerQuarterNote: 96). + ScorePlayerMorph openOn: score title: 'empty score' + + Then open a pianoRoll and, from that, open a keyboard. The rule is that the keyboard will append after the current selection. If the current selection is muted or nil, then input will go to the end of the first non-muted track.! Item was added: + ----- 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@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@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@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@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@0 extent: 0@borderWidth)) + ! Item was added: + ----- 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 added: + ----- Method: KeyboardMorphForInput>>backspaceNote (in category 'note controls') ----- + backspaceNote + + self deleteNotes! Item was added: + ----- Method: KeyboardMorphForInput>>buildChord: (in category 'note controls') ----- + buildChord: onOff! Item was added: + ----- Method: KeyboardMorphForInput>>deleteNotes (in category 'note controls') ----- + deleteNotes + + pianoRoll deleteSelection! Item was added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- 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 added: + ----- Method: KeyboardMorphForInput>>mouseUpPitch:event:noteMorph: (in category 'simple keyboard') ----- + mouseUpPitch: pitch event: event noteMorph: noteMorph + noteMorph color: ((#(0 1 3 5 6 8 10) includes: pitch\\12) + ifTrue: [whiteKeyColor] + ifFalse: [blackKeyColor]). + ! Item was added: + ----- Method: KeyboardMorphForInput>>noteDuration (in category 'note controls') ----- + noteDuration + + articulation == #staccato ifTrue: [^ (self fullDuration * 0.65) asInteger]. + articulation == #normal ifTrue: [^ (self fullDuration * 0.8) asInteger]. + articulation == #legato ifTrue: [^ (self fullDuration * 0.95) asInteger]. + ! Item was added: + ----- Method: KeyboardMorphForInput>>pianoRoll: (in category 'initialization') ----- + pianoRoll: prMorph + + pianoRoll := prMorph! Item was added: + ----- 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 added: + ----- Method: KeyboardMorphForInput>>velocity (in category 'note controls') ----- + velocity + + ^ 80 "Later put a slider on the keyboard control"! Item was added: + ----- 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 added: + RectangleMorph subclass: #PianoRollScoreMorph + instanceVariableNames: 'scorePlayer score colorForTrack lowestNote leftEdgeTime timeScale indexInTrack lastUpdateTick lastMutedState cursor selection timeSignature beatsPerMeasure notePerBeat showMeasureLines showBeatLines soundsPlaying soundsPlayingMorph movieClipPlayer' + classVariableNames: 'NotePasteBuffer' + poolDictionaries: '' + category: 'MorphicExtras-Sound'! + + !PianoRollScoreMorph commentStamp: '<historical>' prior: 0! + A PianoRollScoreMorph displays a score such as a MIDIScore, and will scroll through it tracking the progress of a ScorePlayerMorph (from which it is usually spawned). + + timeScale is in pixels per score tick. + + Currently the ambient track (for synchronizing thumbnails, eg) is treated specially here and in the score. This should be cleaned up by adding a trackType or something like it in the score.! Item was added: + ----- Method: PianoRollScoreMorph>>acceptDroppingMorph:event: (in category 'layout') ----- + acceptDroppingMorph: aMorph event: evt + "In addition to placing this morph in the pianoRoll, add a corresponding + event to the score so that it will always appear when played, in addition + to possibly triggering other actions" + + aMorph justDroppedIntoPianoRoll: self event: evt. + super acceptDroppingMorph: aMorph event: evt. + + ! Item was added: + ----- Method: PianoRollScoreMorph>>addCustomMenuItems:hand: (in category 'menu') ----- + addCustomMenuItems: aMenu hand: aHandMorph + + super addCustomMenuItems: aMenu hand: aHandMorph. + aMenu add: 'expand time' translated action: #expandTime. + aMenu add: 'contract time' translated action: #contractTime. + aMenu addLine. + aMenu add: 'add movie clip player' translated action: #addMovieClipPlayer. + (self valueOfProperty: #dragNDropEnabled) == true + ifTrue: [aMenu add: 'close drag and drop' translated action: #disableDragNDrop] + ifFalse: [aMenu add: 'open drag and drop' translated action: #enableDragNDrop]. + ! Item was added: + ----- Method: PianoRollScoreMorph>>addKeyboard (in category 'menu') ----- + addKeyboard + + (KeyboardMorphForInput new pianoRoll: self) openInWorld! Item was added: + ----- Method: PianoRollScoreMorph>>addNotes (in category 'drawing') ----- + addNotes + "Recompute the set of morphs that should be visible at the current scroll position." + + | visibleMorphs rightEdge topEdge rightEdgeTime | + visibleMorphs := OrderedCollection new: 500. + rightEdge := self right - borderWidth. + rightEdgeTime := self timeForX: rightEdge. + topEdge := self top + borderWidth + 1. + + "Add ambient morphs first (they will be front-most)" + score eventMorphsWithTimeDo: + [:m :t | m addMorphsTo: visibleMorphs pianoRoll: self eventTime: t + betweenTime: leftEdgeTime and: rightEdgeTime]. + + "Then add note morphs" + score tracks withIndexDo: + [:track :trackIndex | | done n i nRight nTop nLeft trackColor | + trackColor := colorForTrack at: trackIndex. + i := indexInTrack at: trackIndex. + done := scorePlayer mutedForTrack: trackIndex. + [done | (i > track size)] whileFalse: [ + n := track at: i. + (n isNoteEvent and: [n midiKey >= lowestNote]) ifTrue: [ + n time > rightEdgeTime + ifTrue: [done := true] + ifFalse: [ + nLeft := self xForTime: n time. + nTop := (self yForMidiKey: n midiKey) - 1. + nTop > topEdge ifTrue: [ + nRight := nLeft + (n duration * timeScale) truncated - 1. + visibleMorphs add: + ((PianoRollNoteMorph + newBounds: (nLeft@nTop corner: nRight@(nTop + 3)) + color: trackColor) + trackIndex: trackIndex indexInTrack: i)]]]. + i := i + 1]. + (selection notNil + and: [trackIndex = selection first + and: [i >= selection second and: [(indexInTrack at: trackIndex) <= selection third]]]) + ifTrue: [visibleMorphs do: + [:vm | (vm isKindOf: PianoRollNoteMorph) ifTrue: [vm selectFrom: selection]]]]. + + "Add the cursor morph in front of all notes; height and position are set later." + cursor ifNil: [cursor := Morph newBounds: (self topLeft extent: 1@1) color: Color red]. + visibleMorphs addFirst: cursor. + + self changed. + self removeAllMorphs. + self addAllMorphs: visibleMorphs. + ! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>beatLinesOnOff (in category 'menu') ----- + beatLinesOnOff + + showBeatLines := showBeatLines not. + self changed! Item was added: + ----- Method: PianoRollScoreMorph>>beatsPerMeasure: (in category 'accessing') ----- + beatsPerMeasure: n + + ^ self timeSignature: n over: notePerBeat! Item was added: + ----- Method: PianoRollScoreMorph>>contractTime (in category 'geometry') ----- + contractTime + + timeScale := timeScale / 1.5. + self rebuildFromScore. + ! Item was added: + ----- Method: PianoRollScoreMorph>>copySelection (in category 'editing') ----- + copySelection + selection isNil ifTrue: [^self]. + NotePasteBuffer := (score tracks at: selection first) + copyFrom: selection second + to: selection third! Item was added: + ----- Method: PianoRollScoreMorph>>cutSelection (in category 'editing') ----- + cutSelection + selection isNil ifTrue: [^self]. + self copySelection. + self deleteSelection! Item was added: + ----- Method: PianoRollScoreMorph>>defaultBorderWidth (in category 'initialization') ----- + defaultBorderWidth + "answer the default border width for the receiver" + ^ 1! Item was added: + ----- Method: PianoRollScoreMorph>>defaultColor (in category 'initialization') ----- + defaultColor + "answer the default color/fill style for the receiver" + ^ Color white! Item was added: + ----- Method: PianoRollScoreMorph>>deleteSelection (in category 'editing') ----- + deleteSelection + | selMorphs priorEvent x | + (selection isNil or: [selection second = 0]) ifTrue: [^self]. + score cutSelection: selection. + selection second > 1 + ifTrue: + [selection at: 2 put: selection second - 1. + selection at: 3 put: selection second. + priorEvent := (score tracks at: selection first) at: selection second. + (x := self xForTime: priorEvent time) < (self left + 30) + ifTrue: [self autoScrollForX: x - ((30 + self width) // 4)]] + ifFalse: [selection := nil]. + scorePlayer updateDuration. + self rebuildFromScore. + selMorphs := self + submorphsSatisfying: [:m | (m isKindOf: PianoRollNoteMorph) and: [m selected]]. + selMorphs isEmpty ifFalse: [(selMorphs last noteOfDuration: 0.3) play]! Item was added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>drawOn: (in category 'drawing') ----- + drawOn: aCanvas + + super drawOn: aCanvas. + self drawStaffOn: aCanvas. + ! Item was added: + ----- 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@y corner: r@(y + 1)) + color: blackKeyColor]]. + ! Item was added: + ----- Method: PianoRollScoreMorph>>expandTime (in category 'geometry') ----- + expandTime + + timeScale := timeScale * 1.5. + self rebuildFromScore. + ! Item was added: + ----- Method: PianoRollScoreMorph>>extent: (in category 'geometry') ----- + extent: aPoint + "Force rebuild when re-sized." + + super extent: aPoint. + score ifNotNil: [self updateLowestNote]. + self rebuildFromScore. + ! Item was added: + ----- Method: PianoRollScoreMorph>>fullBounds (in category 'layout') ----- + fullBounds + "Overridden to clip submorph hit detection to my bounds." + + fullBounds ifNil: [fullBounds := bounds]. + ^ bounds + ! Item was added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>handlesMouseDown: (in category 'event handling') ----- + handlesMouseDown: evt + + ^ true! Item was added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>insertSelection (in category 'editing') ----- + insertSelection + self selection isNil ifTrue: [^self]. + score insertEvents: NotePasteBuffer at: self selection. + scorePlayer updateDuration. + self rebuildFromScore! Item was added: + ----- Method: PianoRollScoreMorph>>insertTransposed (in category 'editing') ----- + insertTransposed + | delta transposedNotes | + (delta := UIManager default + chooseFrom: ((12 to: -12 by: -1) collect: [:i | i printString]) + values: ((12 to: -12 by: -1) collect: [:i | i printString]) + title: 'offset...') ifNil: [^self]. + transposedNotes := NotePasteBuffer + collect: [:note | note copy midiKey: note midiKey + delta]. + selection isNil ifTrue: [^self]. + score insertEvents: transposedNotes at: self selection. + scorePlayer updateDuration. + self rebuildFromScore! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>layoutChanged (in category 'layout') ----- + layoutChanged + "Override this to avoid propagating 'layoutChanged' when just adding/removing note objects." + + fullBounds = bounds ifTrue: [^ self]. + super layoutChanged. + ! Item was added: + ----- Method: PianoRollScoreMorph>>measureLinesOnOff (in category 'menu') ----- + measureLinesOnOff + + showMeasureLines := showMeasureLines not. + self changed! Item was added: + ----- Method: PianoRollScoreMorph>>midiKeyForY: (in category 'geometry') ----- + midiKeyForY: y + + ^ lowestNote - ((y - (bounds bottom - borderWidth - 4)) // 3) + ! Item was added: + ----- Method: PianoRollScoreMorph>>mouseDown: (in category 'event handling') ----- + mouseDown: evt + + | noteMorphs chordRect | + (self notesInRect: ((evt cursorPoint extent: 1@0) expandBy: 2@30)) isEmpty + ifTrue: ["If not near a note, then put up score edit menu" + ^ self invokeScoreMenu: evt]. + + "Clicked near (but not on) a note, so play all notes at the cursor time" + noteMorphs := self notesInRect: ((evt cursorPoint extent: 1@0) expandBy: 0@self height). + chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: 1. + soundsPlayingMorph := Morph newBounds: chordRect color: Color green. + self addMorphBack: soundsPlayingMorph. + + soundsPlaying := IdentityDictionary new. + noteMorphs do: + [:m | | sound | sound := m soundOfDuration: 999.0. + soundsPlaying at: m put: sound. + SoundPlayer resumePlaying: sound quickStart: false]. + + ! Item was added: + ----- Method: PianoRollScoreMorph>>mouseMove: (in category 'event handling') ----- + mouseMove: evt + + | noteMorphs chordRect | + soundsPlaying ifNil: [^ self]. + self autoScrollForX: evt cursorPoint x. + + "Play all notes at the cursor time" + noteMorphs := self notesInRect: ((evt cursorPoint extent: 1@0) expandBy: 0@self height). + chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: 1. + soundsPlayingMorph delete. + soundsPlayingMorph := Morph newBounds: chordRect color: Color green. + self addMorphBack: soundsPlayingMorph. + + noteMorphs do: + [:m | | sound | "Add any new sounds" + (soundsPlaying includesKey: m) + ifFalse: [sound := m soundOfDuration: 999.0. + soundsPlaying at: m put: sound. + SoundPlayer resumePlaying: sound quickStart: false]]. + soundsPlaying keys do: + [:m | "Remove any sounds no longer in selection." + (noteMorphs includes: m) + ifFalse: [(soundsPlaying at: m) stopGracefully. + soundsPlaying removeKey: m]]. + + ! Item was added: + ----- 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 added: + ----- 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@desiredCursorHeight]. + ! Item was added: + ----- Method: PianoRollScoreMorph>>movieClipPlayer (in category 'accessing') ----- + movieClipPlayer + + ^ movieClipPlayer! Item was added: + ----- Method: PianoRollScoreMorph>>movieClipPlayer: (in category 'accessing') ----- + movieClipPlayer: moviePlayer + + movieClipPlayer := moviePlayer + ! Item was added: + ----- Method: PianoRollScoreMorph>>notePerBeat: (in category 'accessing') ----- + notePerBeat: n + + ^ self timeSignature: beatsPerMeasure over: n! Item was added: + ----- Method: PianoRollScoreMorph>>notesInRect: (in category 'scrolling') ----- + notesInRect: timeSlice + + ^ self submorphsSatisfying: + [:m | (timeSlice intersects: m bounds) + and: [m isKindOf: PianoRollNoteMorph]]! Item was added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>rebuildFromScore (in category 'drawing') ----- + rebuildFromScore + "Rebuild my submorphs from the score. This method should be invoked after changing the time scale, the color or visibility of a track, the extent of this morph, etc." + + score ifNil: [^ self]. + self addNotes. + ! Item was added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>score (in category 'accessing') ----- + score + + ^ score! Item was added: + ----- Method: PianoRollScoreMorph>>scorePlayer (in category 'accessing') ----- + scorePlayer + + ^ scorePlayer! Item was added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>selection: (in category 'accessing') ----- + selection: anArray + + selection := anArray! Item was added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>stepTime (in category 'testing') ----- + stepTime + + ^ 0 + ! Item was added: + ----- Method: PianoRollScoreMorph>>tickTimeAtCursor (in category 'geometry') ----- + tickTimeAtCursor + cursor ifNil: [^ 0]. + ^ self timeForX: cursor left! Item was added: + ----- Method: PianoRollScoreMorph>>timeForX: (in category 'geometry') ----- + timeForX: aNumber + + ^ ((aNumber - bounds left - borderWidth) asFloat / timeScale + leftEdgeTime) asInteger! Item was added: + ----- Method: PianoRollScoreMorph>>timeScale (in category 'accessing') ----- + timeScale + + ^ timeScale "in pixels per tick"! Item was added: + ----- 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 added: + ----- Method: PianoRollScoreMorph>>updateLowestNote (in category 'initialization') ----- + updateLowestNote + "find the actual lowest note in the score" + + + lowestNote := 128 - (self innerBounds height // 3). + score tracks do: [:track | | n | + 1 to: track size do: [:i | + n := track at: i. + (n isNoteEvent and: [n midiKey < lowestNote]) + ifTrue: [lowestNote := n midiKey - 4]]]. + ! Item was added: + ----- Method: PianoRollScoreMorph>>xForTime: (in category 'geometry') ----- + xForTime: aNumber + + ^ ((aNumber - leftEdgeTime) asFloat * timeScale) asInteger + bounds left + borderWidth + ! Item was added: + ----- Method: PianoRollScoreMorph>>yForMidiKey: (in category 'geometry') ----- + yForMidiKey: midiKey + + ^ (bounds bottom - borderWidth - 4) - (3 * (midiKey - lowestNote)) + ! Item was added: + ----- 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 added: + ----- Method: ProjectNavigationMorph>>getSoundVolume (in category '*MorphicExtras-Sound') ----- + getSoundVolume + + ^SoundPlayer soundVolume average! Item was added: + ----- Method: ProjectNavigationMorph>>setSoundVolume: (in category '*MorphicExtras-Sound') ----- + setSoundVolume: x + + SoundPlayer setVolumeLeft: x volumeRight: x. + ! Item was added: + ----- 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 added: + ----- 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 added: + ----- Method: ProjectNavigationMorph>>soundUpEvt:morph: (in category '*MorphicExtras-Sound') ----- + soundUpEvt: a morph: b + + soundSlider ifNotNil: [soundSlider delete]. + soundSlider := nil. + Beeper beep ! Item was added: + ----- Method: ProjectNavigationMorph>>speakerIcon (in category '*MorphicExtras-Sound') ----- + speakerIcon + + + ^ImageMorph new + image: ( + (Form + extent: 19@18 + depth: 8 + fromArray: #( 0 0 1493172224 0 0 0 0 1493172224 0 0 0 138 1493172224 0 0 0 35509 2315255808 0 0 0 9090522 2315255808 0 0 0 2327173887 2315255819 0 0 138 3051028442 2315255819 0 0 1505080590 4294957786 2315255808 184549376 0 3053453311 4292532917 1493172224 184549376 0 1505080714 3048584629 1493172224 184549376 0 9079434 3048584629 1493172224 184549376 0 138 2327164341 1493172235 0 0 0 2324346293 1493172235 0 0 0 9079477 1493172224 0 0 0 35466 1493172224 0 0 0 138 0 0 0 0 0 0 0 0 0 0 0 0 0) + offset: 0@0) + ); + setBalloonText: 'Quiet'; + on: #mouseUp send: #yourself to: 1 + ! Item was added: + ----- 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 added: + ----- 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}. + + ! Item was added: + ----- Method: ZASMCameraMarkMorph>>pauseFrom: (in category 'piano rolls') ----- + pauseFrom: scorePlayer + + self cameraController pauseProgrammedMoves.! Item was added: + ----- Method: ZASMCameraMarkMorph>>resumeFrom: (in category 'piano rolls') ----- + resumeFrom: scorePlayer + + self cameraController resumeProgrammedMoves!

1 0

The Trunk: ST80Tests-fbs.1.mcz
by commits＠source.squeak.org 04 Jul '13

04 Jul '13

Frank Shearar uploaded a new version of ST80Tests to project The Trunk: http://source.squeak.org/trunk/ST80Tests-fbs.1.mcz ==================== Summary ==================== Name: ST80Tests-fbs.1 Author: fbs Time: 4 July 2013, 8:05:53.456 pm UUID: 717f9103-a5ab-9d4e-91b3-13a72aa859b0 Ancestors: ST-80's very own test suite. For now, just test that ST-80's package dependencies are as expected. ==================== Snapshot ==================== SystemOrganization addCategory: #ST80Tests! TestCase subclass: #ST80PackageDependencyTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ST80Tests'! ----- Method: ST80PackageDependencyTest>>testPackage:dependsExactlyOn: (in category 'as yet unclassified') ----- testPackage: pkgName dependsExactlyOn: pkgList "Ensure that the package with the given name depends only on the packages in pkgList. NOTE: If you use this for fixing dependencies, classDeps includes the classes and users from the package(s) not declared as dependents. Basically, you need to fix all the references in classDeps to make the test pass." | classDeps pi pkgDeps | classDeps := IdentityDictionary new. pi := PackageOrganizer default packageNamed: pkgName ifAbsent:[^self]. "unloaded" pi classes do:[:pkgClass| (classDeps at: (pkgClass superclass ifNil:[ProtoObject]) ifAbsentPut:[OrderedCollection new]) add: pkgClass name, ' superclass'. ]. pi methods do:[:mref| | cm | cm := mref compiledMethod. 1 to: cm numLiterals do:[:i| | lit | ((lit := cm literalAt: i) isVariableBinding and:[lit value isBehavior]) ifTrue:[(classDeps at: lit value ifAbsentPut:[OrderedCollection new]) add: cm methodClass asString, '>>', cm selector]]]. pkgDeps := Dictionary new. classDeps keys do:[:aClass| | pkg | pkg := PackageOrganizer default packageOfClass: aClass ifNone:[nil]. pkg ifNil:[ Transcript cr; show: 'WARNING: No package for ', aClass. (classDeps removeKey: aClass) do:[:each| Transcript crtab; show: each]. ] ifNotNil:[ (pkgDeps at: pkg name ifAbsentPut:[OrderedCollection new]) add: aClass. ]. ]. (pkgDeps removeKey: pkgName ifAbsent:[#()]) do:[:aClass| classDeps removeKey: aClass ifAbsent:[]]. pkgList do:[:pkg| self assert: (pkgDeps includesKey: pkg) description: pkgName, ' no longer depends on ', pkg. (pkgDeps removeKey: pkg ifAbsent: [#()]) do:[:aClass| classDeps removeKey: aClass ifAbsent:[]]. ]. classDeps keysAndValuesDo:[:class :deps| Transcript cr; show: class name, ' dependencies:'. deps do:[:each| Transcript crtab; show: each]. ]. self assert: pkgDeps isEmpty description: pkgName, ' now depends on ', pkgDeps. ! ----- Method: ST80PackageDependencyTest>>testST80 (in category 'as yet unclassified') ----- testST80 self testPackage: 'ST80' dependsExactlyOn: #( Collections Compiler Files Graphics Kernel Morphic Multilingual Network SUnit System 'ToolBuilder-Kernel' Tools ).!

1 0

← Newer
1
...
27
28
29
30
31
32
33
34
35
Older →

Jump to page: