Packages May 2018

packages@lists.squeakfoundation.org

1 participants
110 discussions

The Trunk: Collections-eem.793.mcz
by commits＠source.squeak.org 03 May '18

03 May '18

Eliot Miranda uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-eem.793.mcz ==================== Summary ==================== Name: Collections-eem.793 Author: eem Time: 3 May 2018, 10:36:26.780414 am UUID: 9e90b3ee-26a8-44d7-850c-e7b0c54fe0a6 Ancestors: Collections-eem.792 revert =============== Diff against Collections-eem.792 =============== Item was changed: ----- Method: String>>isAsciiString (in category 'testing') ----- isAsciiString + + ^self allSatisfy: [ :each | each asciiValue <= 127 ]! - "Answer if the receiver contains only ascii characters. - Inline ^self allSatisfy: [ :each | each asciiValue <= 127 ] for speed." - 1 to: self basicSize do: [:i| (self basicAt: i) > 127 ifTrue: [^false]]. - ^true!

1 0

The Trunk: Collections-eem.792.mcz
by commits＠source.squeak.org 03 May '18

03 May '18

Eliot Miranda uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-eem.792.mcz ==================== Summary ==================== Name: Collections-eem.792 Author: eem Time: 3 May 2018, 12:55:52.175146 am UUID: 7d8995ed-835e-44b0-bf4c-0b0780f5c96f Ancestors: Collections-pre.791 Four times faster implementation of isAsciiString. =============== Diff against Collections-pre.791 =============== Item was changed: ----- Method: String>>isAsciiString (in category 'testing') ----- isAsciiString + "Answer if the receiver contains only ascii characters. + Inline ^self allSatisfy: [ :each | each asciiValue <= 127 ] for speed." + 1 to: self basicSize do: [:i| (self basicAt: i) > 127 ifTrue: [^false]]. + ^true! - - ^self allSatisfy: [ :each | each asciiValue <= 127 ]!

1 0

The Trunk: Network-eem.224.mcz
by commits＠source.squeak.org 03 May '18

03 May '18

Eliot Miranda uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-eem.224.mcz ==================== Summary ==================== Name: Network-eem.224 Author: eem Time: 3 May 2018, 12:54:19.600192 am UUID: d2a302ef-6dfa-405c-af25-c428b2e90431 Ancestors: Network-pre.223 Use isAsciiString instead of inlining it using isAscii, which permits performance improvement if isAsciiString is well-implemented. =============== Diff against Network-pre.223 =============== Item was changed: ----- Method: MIMEHeaderValue>>asHeaderValue (in category 'printing') ----- asHeaderValue | strm result | strm := WriteStream on: (String new: 20). strm nextPutAll: mainValue. parameters associationsDo: [:e | strm nextPut: $; ; nextPutAll: e key; nextPutAll: '='; nextPutAll: e value]. + ^ (result := strm contents) isAsciiString + ifFalse: [QEncodingMimeConverter mimeEncode: result] + ifTrue: [result] - ^ ((result := strm contents) anySatisfy: [:c | c isAscii not]) - ifTrue: [QEncodingMimeConverter mimeEncode: result] - ifFalse: [result] !

1 0

The Trunk: System-eem.1021.mcz
by commits＠source.squeak.org 02 May '18

02 May '18

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.1021.mcz ==================== Summary ==================== Name: System-eem.1021 Author: eem Time: 2 May 2018, 1:39:55.407326 pm UUID: 727d275e-a337-4208-9616-f887d8fd4576 Ancestors: System-eem.1020 Move more NativeImageSegment methods up to ImageSegment. Provide a hack accessor for testing that a segment can be loaded (forFile:outPointers:, which may get deleted once 64-bit native image segments work). =============== Diff against System-eem.1020 =============== Item was added: + ----- Method: ImageSegment class>>folder (in category 'fileIn/Out') ----- + folder + | im | + "Full path name of segments folder. Be sure to duplicate and rename the folder when you duplicate and rename an image. Is $_ legal in all file systems?" + + im := Smalltalk imageName. + ^ (im copyFrom: 1 to: im size - 6 "'.image' size"), '_segs'! Item was added: + ----- Method: ImageSegment>>errorWrongState (in category 'testing') ----- + errorWrongState + + ^ self error: 'wrong state'! Item was added: + ----- Method: ImageSegment>>forFile:outPointers: (in category 'testing') ----- + forFile: aFileName outPointers: outPointerArray + "An accessor for testing to set up a new image segment to be in a state to load from aFileName. After this send install to load." + fileName := aFileName. + state := #onFile. + outPointers := outPointerArray! Item was added: + ----- Method: ImageSegment>>install (in category 'read/write segment') ----- + install + "This operation retrieves the segment if necessary from file storage, installs it in memory, and replaces (using become:) all the root stubs with the reconstructed roots of the segment." + + | allObjectsInSegment newRoots | + state = #onFile ifTrue: [self readFromFile]. + state = #onFileWithSymbols ifTrue: + [self readFromFileWithSymbols]. + (state = #active) | (state = #imported) ifFalse: [self errorWrongState]. + allObjectsInSegment := self loadSegmentFrom: segment outPointers: outPointers. + newRoots := allObjectsInSegment first. + self checkAndReportLoadError. + (state = #imported "just came in from exported file" or: [arrayOfRoots isNil "testing..."]) + ifTrue: [arrayOfRoots := newRoots] + ifFalse: [arrayOfRoots elementsForwardIdentityTo: newRoots]. + state := #inactive. + Beeper beepPrimitive! Item was changed: ----- Method: ImageSegment>>loadSegmentFrom:outPointers: (in category 'read/write segment') ----- loadSegmentFrom: segment outPointers: outPointers "Attempt to load the segment into memory (reify the objects in segment as real objects), using outPointers to bind references to objects not in the segment. Answer a collection of all the objects in the segment." | segmentFormat | + (state == #imported or: [state == #active]) ifTrue: + [segmentFormat := self segmentFormatFrom: segment first. - state == #imported ifTrue: - [segmentFormat := segment first bitAnd: 16rFFFFFF. segmentFormat = 6502 ifTrue: [LegacyImageSegment adoptInstance: self. ^self loadSegmentFrom: segment outPointers: outPointers]. segmentFormat = Smalltalk imageFormatVersion ifTrue: [NativeImageSegment adoptInstance: self. ^self loadSegmentFrom: segment outPointers: outPointers]. self error: 'no handling for format ', segmentFormat asString. ' in a ', Smalltalk imageFormatVersion asString, ' image.']. self subclassResponsibility! Item was added: + ----- Method: ImageSegment>>localName (in category 'read/write segment') ----- + localName + | segs ind sep | + "Return the current file name for this segment, a local name in the segments directory." + + fileName ifNil: [^ nil]. + "^ fileName" + + "The following is for backward compatibility. Remove this part after June 2000. + Check if the fileName is a full path, and make it local. Regardless of current or previous file system delimiter." + + segs := self class folder copyLast: 4. ":=segs" + ind := 1. + [ind := fileName findString: segs startingAt: ind+1 caseSensitive: false. + ind = 0 ifTrue: [^ fileName]. + sep := fileName at: ind + (segs size). + sep isAlphaNumeric ] whileTrue. "sep is letter or digit, not a separator" + + ^ fileName := fileName copyFrom: ind+(segs size)+1 "delimiter" to: fileName size! Item was added: + ----- Method: ImageSegment>>readFromFile (in category 'read/write segment') ----- + readFromFile + "Read in a simple segment. Use folder of this image, even if remembered as previous location of this image" + + | ff realName | + realName := self class folder, FileDirectory slash, self localName. + ff := FileStream readOnlyFileNamed: realName. + segment := ff nextWordsInto: (WordArrayForSegment new: ff size//4). + ff close. + state := #active! Item was added: + ----- Method: ImageSegment>>segmentFormatFrom: (in category 'private') ----- + segmentFormatFrom: a32BitWord + "The first two words of a segment array contain the image format version of the system upon which the segment was generated, along with a top byte that is either $d or $s (from the 'does' in #doesNotUnderstand:). But this may be encoded either in big-endian or little-endian format. Since endianness may or may not have been changed, determining what the segment format is takes care." + | msc lsc | + msc := Character value: ((a32BitWord bitShift: -24) bitAnd: 255). + lsc := Character value: (a32BitWord bitAnd: 255). + (('ds' includes: msc) + and: ['ds' includes: lsc]) ifTrue: + [self error: 'ambiguous segment format']. + ('ds' includes: msc) ifTrue: + [^a32BitWord bitAnd: 16rFFFFFF]. + ^((a32BitWord bitShift: -24) bitAnd: 16rFF) + + ((a32BitWord bitShift: -8) bitAnd: 16rFF00) + + ((a32BitWord bitShift: 8) bitAnd: 16rFF0000)! Item was added: + ----- Method: LegacyImageSegment>>aComment (in category 'compact classes') ----- + aComment + "Compact classes are a potential problem because a pointer to the class would not ordinarily show up in the outPointers. We add the classes of all compact classes to outPointers, both for local and export segments. + Compact classes are never allowed as roots. No compact class may be in an Environment that is written out to disk. (In local segments, the compact classes array should never have an ImageSegmentRootStub in it. For export, fileIn the class first, then load a segment with instances of it. The fileIn code can be pasted onto the front of the .extSeg file) + For local segments, a class may become compact while its instances are out on the disk. Or it may become un-compact. A compact class may change shape while some of its instances are on disk. All three cases go through (ClassDescription updateInstancesFrom:). If it can't rule out an instance being in the segment, it reads it in to fix the instances. + See Behavior.becomeCompact for the rules on Compact classes. Indexes may not be reused. This is so that an incoming export segment has its index available. (Changes may be needed in the way indexes are assigned.) + For export segments, a compact class may have a different shape. The normal class reshape mechanism will catch this. During the installation of the segment, objects will have the wrong version of their class momentarily. We will change them back before we get caught. + For export segments, the last two items in outPointers are the number 1717 and an array of the compact classes used in this segment. (The classes in the array are converted from DiskProxies by SmartRefStream.) If that class is not compact in the new image, the instances are recopied. + "! Item was removed: - ----- Method: NativeImageSegment class>>folder (in category 'fileIn/Out') ----- - folder - | im | - "Full path name of segments folder. Be sure to duplicate and rename the folder when you duplicate and rename an image. Is $_ legal in all file systems?" - - im := Smalltalk imageName. - ^ (im copyFrom: 1 to: im size - 6 "'.image' size"), '_segs'! Item was changed: ----- Method: NativeImageSegment>>aComment (in category 'compact classes') ----- aComment + "Spur does not use compact classes, so an effort has been made to excise their use from the code. The previous comment was: - "Spur does not use compact classes, so an effort has been made to excise their use from the code. Thew previous comment was: Compact classes are a potential problem because a pointer to the class would not ordinarily show up in the outPointers. We add the classes of all compact classes to outPointers, both for local and export segments. Compact classes are never allowed as roots. No compact class may be in an Environment that is written out to disk. (In local segments, the compact classes array should never have an ImageSegmentRootStub in it. For export, fileIn the class first, then load a segment with instances of it. The fileIn code can be pasted onto the front of the .extSeg file) For local segments, a class may become compact while its instances are out on the disk. Or it may become un-compact. A compact class may change shape while some of its instances are on disk. All three cases go through (ClassDescription updateInstancesFrom:). If it can't rule out an instance being in the segment, it reads it in to fix the instances. See Behavior.becomeCompact for the rules on Compact classes. Indexes may not be reused. This is so that an incoming export segment has its index available. (Changes may be needed in the way indexes are assigned.) For export segments, a compact class may have a different shape. The normal class reshape mechanism will catch this. During the installation of the segment, objects will have the wrong version of their class momentarily. We will change them back before we get caught. + For export segments, the last two items in outPointers are the number 1717 and an array of the compact classes used in this segment. (The classes in the array are converted from DiskProxies by SmartRefStream.) If that class is not compact in the new image, the instances are recopied."! - For export segments, the last two items in outPointers are the number 1717 and an array of the compact classes used in this segment. (The classes in the array are converted from DiskProxies by SmartRefStream.) If that class is not compact in the new image, the instances are recopied. - "! Item was removed: - ----- Method: NativeImageSegment>>errorWrongState (in category 'testing') ----- - errorWrongState - - ^ self error: 'wrong state'! Item was removed: - ----- Method: NativeImageSegment>>install (in category 'read/write segment') ----- - install - "This operation retrieves the segment if necessary from file storage, installs it in memory, and replaces (using become:) all the root stubs with the reconstructed roots of the segment." - - | allObjectsInSegment newRoots | - state = #onFile ifTrue: [self readFromFile]. - state = #onFileWithSymbols ifTrue: - [self readFromFileWithSymbols]. - (state = #active) | (state = #imported) ifFalse: [self errorWrongState]. - allObjectsInSegment := self loadSegmentFrom: segment outPointers: outPointers. - newRoots := allObjectsInSegment first. - self checkAndReportLoadError. - state = #imported "just came in from exported file" - ifTrue: [arrayOfRoots := newRoots] - ifFalse: [arrayOfRoots elementsForwardIdentityTo: newRoots]. - state := #inactive. - Beeper beepPrimitive! Item was removed: - ----- Method: NativeImageSegment>>localName (in category 'read/write segment') ----- - localName - | segs ind sep | - "Return the current file name for this segment, a local name in the segments directory." - - fileName ifNil: [^ nil]. - "^ fileName" - - "The following is for backward compatibility. Remove this part after June 2000. - Check if the fileName is a full path, and make it local. Regardless of current or previous file system delimiter." - - segs := self class folder copyLast: 4. ":=segs" - ind := 1. - [ind := fileName findString: segs startingAt: ind+1 caseSensitive: false. - ind = 0 ifTrue: [^ fileName]. - sep := fileName at: ind + (segs size). - sep isAlphaNumeric ] whileTrue. "sep is letter or digit, not a separator" - - ^ fileName := fileName copyFrom: ind+(segs size)+1 "delimiter" to: fileName size! Item was removed: - ----- Method: NativeImageSegment>>readFromFile (in category 'read/write segment') ----- - readFromFile - "Read in a simple segment. Use folder of this image, even if remembered as previous location of this image" - - | ff realName | - realName := self class folder, FileDirectory slash, self localName. - ff := FileStream readOnlyFileNamed: realName. - segment := ff nextWordsInto: (WordArrayForSegment new: ff size//4). - ff close. - state := #active! Item was removed: - ----- Method: NativeImageSegment>>segmentFormatFrom: (in category 'private') ----- - segmentFormatFrom: a32BitWord - "The first two words of a segment array contain the image format version of the system upon which the segment was generated, along with a top byte that is either $d or $s (from the 'does' in #doesNotUnderstand:). But this may be encoded either in big-endian or little-endian format. Since endianness may or may not have been changed, determining what the segment format is takes care." - | msc lsc | - msc := Character value: ((a32BitWord bitShift: -24) bitAnd: 255). - lsc := Character value: (a32BitWord bitAnd: 255). - (('ds' includes: msc) - and: ['ds' includes: lsc]) ifTrue: - [self error: 'ambiguous segment format']. - ('ds' includes: msc) ifTrue: - [^a32BitWord bitAnd: 16rFFFFFF]. - ^((a32BitWord bitShift: -24) bitAnd: 16rFF) - + ((a32BitWord bitShift: -8) bitAnd: 16rFF00) - + ((a32BitWord bitShift: 8) bitAnd: 16rFF0000)!

1 0

The Trunk: System-eem.1020.mcz
by commits＠source.squeak.org 02 May '18

02 May '18

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.1020.mcz ==================== Summary ==================== Name: System-eem.1020 Author: eem Time: 2 May 2018, 12:29:21.289681 pm UUID: f492f156-8401-4575-9c03-d268326a41af Ancestors: System-mt.1019 Move some reading methods up from NativeImageSegment that should be in ImageSegment. Fix determining the image format in NativeImageSegment on load. This reveals that byte reversal does /not/ work on 64-bit Spur (loking at the VM code it seems to reverse 32-bit units, which is almost certainly wrong for 64-bits, alhtough it is right for 32-bits). =============== Diff against System-mt.1019 =============== Item was added: + ----- Method: ImageSegment>>acceptSingleMethodSource: (in category 'fileIn/Out') ----- + acceptSingleMethodSource: aDictionary + + | oldClassInfo oldClassName ismeta newName actualClass selector | + oldClassInfo := (aDictionary at: #oldClassName) findTokens: ' '. "'Class' or 'Class class'" + oldClassName := oldClassInfo first asSymbol. + ismeta := oldClassInfo size > 1. + + "must use class var since we may not be the same guy who did the initial work" + + newName := RecentlyRenamedClasses ifNil: [ + oldClassName + ] ifNotNil: [ + RecentlyRenamedClasses at: oldClassName ifAbsent: [oldClassName] + ]. + actualClass := Smalltalk at: newName. + ismeta ifTrue: [actualClass := actualClass class]. + selector := actualClass newParser parseSelector: (aDictionary at: #methodText). + (actualClass compiledMethodAt: selector ifAbsent: [^self "hosed input"]) + putSource: (aDictionary at: #methodText) + fromParseNode: nil + class: actualClass + category: (aDictionary at: #category) + withStamp: (aDictionary at: #changeStamp) + inFile: 2 + priorMethod: nil. + ! Item was changed: ----- Method: ImageSegment>>comeFullyUpOnReload: (in category 'fileIn') ----- comeFullyUpOnReload: smartRefStream "fix up the objects in the segment that changed size. An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size. Replace the modern class with the old one in outPointers. Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages. Keep the new instances. Bulk forward become the old to the new. Let go of the fake objects and classes. After the install (below), arrayOfRoots is filled in. Globalize new classes. Caller may want to do some special install on certain objects in arrayOfRoots. May want to write the segment out to disk in its new form." | mapFakeClassesToReal receiverClasses rootsToUnhiberhate myProject existing forgetDoItsClass endianness | forgetDoItsClass := Set new. RecentlyRenamedClasses := nil. "in case old data hanging around" mapFakeClassesToReal := smartRefStream reshapedClassesIn: outPointers. "Dictionary of just the ones that change shape. Substitute them in outPointers." self fixCapitalizationOfSymbols. + endianness := self endianness. - endianness := (segment first bitShift: -24) asCharacter == $d ifTrue: [#big] ifFalse: [#little]. segment := self loadSegmentFrom: segment outPointers: outPointers. arrayOfRoots := segment first. mapFakeClassesToReal isEmpty ifFalse: [ self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream ]. "When a Project is stored, arrayOfRoots has all objects in the project, except those in outPointers" arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: WideString) or: [importedObject isMemberOf: WideSymbol]) ifTrue: [ importedObject mutateJISX0208StringToUnicode. importedObject class = WideSymbol ifTrue: [ "self halt." Symbol hasInterned: importedObject asString ifTrue: [:multiSymbol | multiSymbol == importedObject ifFalse: [ importedObject becomeForward: multiSymbol. ]. ]. ]. ]. (importedObject isMemberOf: TTCFontSet) ifTrue: [ existing := TTCFontSet familyName: importedObject familyName pointSize: importedObject pointSize. "supplies default" existing == importedObject ifFalse: [importedObject becomeForward: existing]. ]. ]. receiverClasses := self restoreEndianness: endianness ~~ Smalltalk endianness. "rehash sets" smartRefStream checkFatalReshape: receiverClasses. "Classes in this segment." arrayOfRoots do: [:importedObject | importedObject class class == Metaclass ifTrue: [forgetDoItsClass add: importedObject. self declare: importedObject]]. rootsToUnhiberhate := OrderedCollection new. arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: ScriptEditorMorph) or: [(importedObject isKindOf: TileMorph) or: [(importedObject isMemberOf: ScriptingTileHolder) or: [importedObject isKindOf: CompoundTileMorph]]]) ifTrue: [ rootsToUnhiberhate add: importedObject ]. (importedObject isMemberOf: Project) ifTrue: [ myProject := importedObject. importedObject ensureChangeSetNameUnique. Project addingProject: importedObject. importedObject restoreReferences. self dependentsRestore: importedObject. ScriptEditorMorph writingUniversalTiles: ((importedObject projectPreferenceAt: #universalTiles) ifNil: [false])]]. myProject ifNotNil: [ myProject world setProperty: #thingsToUnhibernate toValue: rootsToUnhiberhate asArray. ]. mapFakeClassesToReal isEmpty ifFalse: [ mapFakeClassesToReal keysAndValuesDo: [:aFake :aReal | aFake removeFromSystemUnlogged. aFake becomeForward: aReal]. SystemOrganization removeEmptyCategories]. forgetDoItsClass do: [:c | c forgetDoIts]. "^ self" ! Item was added: + ----- Method: ImageSegment>>endianness (in category 'fileIn/Out') ----- + endianness + "Return which endian kind the incoming segment came from" + + segment class isBits ifFalse: + ["Hope that primitive 98 did the right thing - anyway, we lost information about endianness, so pretend we share the image's endianness." + ^Smalltalk endianness]. + ^(segment first bitShift: -24) asCharacter == $d ifTrue: [#big] ifFalse: [#little]! Item was added: + ----- Method: ImageSegment>>restoreEndianness (in category 'fileIn/Out') ----- + restoreEndianness + ^self restoreEndianness: self endianness ~~ Smalltalk endianness! Item was added: + ----- Method: ImageSegment>>scanFrom: (in category 'fileIn/Out') ----- + scanFrom: aStream + "Move source code from a fileIn to the changes file for classes in an ImageSegment. Do not compile the methods. They already came in via the image segment. After the ImageSegment in the file, !!ImageSegment new!! captures control, and scanFrom: is called." + | val chunk | + + [aStream atEnd] whileFalse: + [aStream skipSeparators. + val := (aStream peekFor: $!!) + ifTrue: ["Move (aStream nextChunk), find the method or class + comment, and install the file location bytes" + (Compiler evaluate: aStream nextChunk logged: false) + scanFromNoCompile: aStream forSegment: self] + ifFalse: [chunk := aStream nextChunk. + aStream checkForPreamble: chunk. + Compiler evaluate: chunk logged: true]. + aStream skipStyleChunk]. + "regular fileIn will close the file" + ^ val! Item was added: + ----- Method: ImageSegment>>scanFrom:environment: (in category 'fileIn/Out') ----- + scanFrom: aStream environment: anEnvironment + ^ self scanFrom: aStream! Item was removed: - ----- Method: NativeImageSegment>>acceptSingleMethodSource: (in category 'fileIn/Out') ----- - acceptSingleMethodSource: aDictionary - - | oldClassInfo oldClassName ismeta newName actualClass selector | - oldClassInfo := (aDictionary at: #oldClassName) findTokens: ' '. "'Class' or 'Class class'" - oldClassName := oldClassInfo first asSymbol. - ismeta := oldClassInfo size > 1. - - "must use class var since we may not be the same guy who did the initial work" - - newName := RecentlyRenamedClasses ifNil: [ - oldClassName - ] ifNotNil: [ - RecentlyRenamedClasses at: oldClassName ifAbsent: [oldClassName] - ]. - actualClass := Smalltalk at: newName. - ismeta ifTrue: [actualClass := actualClass class]. - selector := actualClass newParser parseSelector: (aDictionary at: #methodText). - (actualClass compiledMethodAt: selector ifAbsent: [^self "hosed input"]) - putSource: (aDictionary at: #methodText) - fromParseNode: nil - class: actualClass - category: (aDictionary at: #category) - withStamp: (aDictionary at: #changeStamp) - inFile: 2 - priorMethod: nil. - ! Item was removed: - ----- Method: NativeImageSegment>>endianness (in category 'fileIn/Out') ----- - endianness - "Return which endian kind the incoming segment came from" - - segment class isBits ifFalse: - ["Hope that primitive 98 did the right thing - anyway, we lost information about endianness, so pretend we share the image's endianness." - ^Smalltalk endianness]. - ^(segment first bitShift: -24) asCharacter == $d ifTrue: [#big] ifFalse: [#little]! Item was changed: ----- Method: NativeImageSegment>>loadSegmentFrom:outPointers: (in category 'read/write segment primitives') ----- loadSegmentFrom: segmentWordArray outPointers: outPointerArray "Load segmentWordArray into the memory. Adapt the primitive to the new API, which is to answer the array of loaded objects, the first of which should be the array of roots. The primitive will install a binary image segment and return as its value the array of roots of the tree of objects represented. Upon successful completion, the wordArray will have been becomed into anArray of the loaded objects. So simply answer the segmentWordArray which will have becommed." | segmentFormat | + segmentFormat := self segmentFormatFrom: segmentWordArray first. - segmentFormat := segmentWordArray first bitAnd: 16rFFFFFF. segmentFormat = Smalltalk imageFormatVersion ifTrue: [^(self primitiveLoadSegmentFrom: segmentWordArray outPointers: outPointerArray) ifNil: [self error: 'segment load failed'] ifNotNil: [segmentWordArray]]. segmentFormat >= 68000 ifTrue: [Smalltalk wordSize = 4 ifTrue: [^(Spur64BitImageSegmentLoader new loadSegmentFrom: segmentWordArray outPointers: outPointerArray)]] ifFalse: [Smalltalk wordSize = 8 ifTrue: [^(Spur32BitImageSegmentLoader new loadSegmentFrom: segmentWordArray outPointers: outPointerArray)]]. self error: 'segment version unrecognized'! Item was removed: - ----- Method: NativeImageSegment>>restoreEndianness (in category 'fileIn/Out') ----- - restoreEndianness - ^self restoreEndianness: self endianness ~~ Smalltalk endianness! Item was removed: - ----- Method: NativeImageSegment>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: aStream - "Move source code from a fileIn to the changes file for classes in an ImageSegment. Do not compile the methods. They already came in via the image segment. After the ImageSegment in the file, !!ImageSegment new!! captures control, and scanFrom: is called." - | val chunk | - - [aStream atEnd] whileFalse: - [aStream skipSeparators. - val := (aStream peekFor: $!!) - ifTrue: ["Move (aStream nextChunk), find the method or class - comment, and install the file location bytes" - (Compiler evaluate: aStream nextChunk logged: false) - scanFromNoCompile: aStream forSegment: self] - ifFalse: [chunk := aStream nextChunk. - aStream checkForPreamble: chunk. - Compiler evaluate: chunk logged: true]. - aStream skipStyleChunk]. - "regular fileIn will close the file" - ^ val! Item was removed: - ----- Method: NativeImageSegment>>scanFrom:environment: (in category 'fileIn/Out') ----- - scanFrom: aStream environment: anEnvironment - ^ self scanFrom: aStream! Item was added: + ----- Method: NativeImageSegment>>segmentFormatFrom: (in category 'private') ----- + segmentFormatFrom: a32BitWord + "The first two words of a segment array contain the image format version of the system upon which the segment was generated, along with a top byte that is either $d or $s (from the 'does' in #doesNotUnderstand:). But this may be encoded either in big-endian or little-endian format. Since endianness may or may not have been changed, determining what the segment format is takes care." + | msc lsc | + msc := Character value: ((a32BitWord bitShift: -24) bitAnd: 255). + lsc := Character value: (a32BitWord bitAnd: 255). + (('ds' includes: msc) + and: ['ds' includes: lsc]) ifTrue: + [self error: 'ambiguous segment format']. + ('ds' includes: msc) ifTrue: + [^a32BitWord bitAnd: 16rFFFFFF]. + ^((a32BitWord bitShift: -24) bitAnd: 16rFF) + + ((a32BitWord bitShift: -8) bitAnd: 16rFF00) + + ((a32BitWord bitShift: 8) bitAnd: 16rFF0000)!

1 0

The Trunk: Network-pre.223.mcz
by commits＠source.squeak.org 02 May '18

02 May '18

Patrick Rein uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-pre.223.mcz ==================== Summary ==================== Name: Network-pre.223 Author: pre Time: 2 May 2018, 3:19:58.805873 pm UUID: 6308303d-2839-b54d-9e44-90d16685e6be Ancestors: Network-pre.222 Makes MIMEHeaderValue objects aware of qencoding by resolving the encoding issue at creation time. =============== Diff against Network-pre.222 =============== Item was changed: ----- Method: MIMEHeaderValue class>>forField:fromString: (in category 'instance creation') ----- forField: aFName fromString: aString "Create a MIMEHeaderValue from aString. How it is parsed depends on whether it is a MIME specific field or a generic header field." + | decodedString | + decodedString := [aString decodeMimeHeader] + on: InvalidUTF8 , NoConverterFound do: [:e | aString]. (aFName beginsWith: 'content-') + ifTrue: [^self fromMIMEHeader: decodedString] + ifFalse: [^self fromTraditionalHeader: decodedString] - ifTrue: [^self fromMIMEHeader: aString] - ifFalse: [^self fromTraditionalHeader: aString] ! Item was changed: ----- Method: MIMEHeaderValue class>>fromMIMEHeader: (in category 'instance creation') ----- fromMIMEHeader: aString + "This is the value of a MIME header field and so is parsed to extract the various parts. + This assumes a string without any special encodings (e.g. q encoding)." - "This is the value of a MIME header field and so is parsed to extract the various parts" | parts newValue parms | newValue := self new. parts := ReadStream on: (aString findTokens: ';'). newValue mainValue: parts next. parms := Dictionary new. parts do: [:e | | separatorPos parmName parmValue | separatorPos := e findAnySubStr: '=' startingAt: 1. separatorPos <= e size ifTrue: [parmName := (e copyFrom: 1 to: separatorPos - 1) withBlanksTrimmed asLowercase. parmValue := (e copyFrom: separatorPos + 1 to: e size) withBlanksTrimmed withoutQuoting. parms at: parmName put: parmValue]]. newValue parameters: parms. ^ newValue ! Item was changed: ----- Method: MIMEHeaderValue class>>fromTraditionalHeader: (in category 'instance creation') ----- fromTraditionalHeader: aString + "This is a traditional non-MIME header (like Subject:) and so should be stored whole. + This assumes a string without any special encodings (e.g. q encoding)." - "This is a traditional non-MIME header (like Subject:) and so should be stored whole" | newValue | newValue := self new. newValue mainValue: aString. newValue parameters: #(). ^newValue. ! Item was changed: ----- Method: MIMEHeaderValue>>asHeaderValue (in category 'printing') ----- asHeaderValue + | strm result | - | strm | strm := WriteStream on: (String new: 20). strm nextPutAll: mainValue. parameters associationsDo: [:e | strm nextPut: $; ; nextPutAll: e key; nextPutAll: '='; nextPutAll: e value]. + ^ ((result := strm contents) anySatisfy: [:c | c isAscii not]) + ifTrue: [QEncodingMimeConverter mimeEncode: result] + ifFalse: [result] + ! - ^ QEncodingMimeConverter mimeEncode: strm contents! Item was changed: ----- Method: MIMEHeaderValue>>mainValue (in category 'accessing') ----- mainValue + ^ mainValue! - ^ [mainValue decodeMimeHeader] - on: InvalidUTF8 , NoConverterFound do: [:e | mainValue]!

1 0

The Trunk: MorphicExtras-kfr.234.mcz
by commits＠source.squeak.org 01 May '18

01 May '18

Karl Ramberg uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-kfr.234.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.234 Author: kfr Time: 1 May 2018, 12:17:55.1564 pm UUID: daa73559-d68f-7c4d-a1a3-2a3ad97af5bc Ancestors: MorphicExtras-kfr.233 Adds menu button to EnvelopeEditorMorph. Fixes the layout of the morph a little. Changes lable of ScorePlayerMorph menu button to Menu =============== Diff against MorphicExtras-kfr.233 =============== Item was removed: - ----- Method: EnvelopeEditorMorph>>addControls (in category 'construction') ----- - addControls - | chooser | - chooser := PopUpChoiceMorph new extent: 110@14; - contentsClipped: 'Editing: ' , envelope name; - target: self; - actionSelector: #chooseFrom:envelopeItem:; - getItemsSelector: #curveChoices. - chooser arguments: (Array with: chooser). - self addMorph: chooser. - chooser align: chooser bounds topLeft with: graphArea bounds bottomLeft + (0@5). - - chooser := PopUpChoiceMorph new extent: 130@14; - contentsClipped: 'Timbre: ' , soundName; - target: self; - actionSelector: #chooseFrom:soundItem:; - getItemsSelector: #soundChoices. - chooser arguments: (Array with: chooser). - self addMorph: chooser. - chooser align: chooser bounds topRight with: graphArea bounds bottomRight + (-50@5). - ! Item was removed: - ----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: menu hand: aHandMorph - super addCustomMenuItems: menu hand: aHandMorph. - menu addLine. - envelope updateSelector = #ratio: ifTrue: - [menu add: 'choose denominator...' translated action: #chooseDenominator:]. - menu add: 'adjust scale...' translated action: #adjustScale:. - SoundPlayer isReverbOn - ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb] - ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb]. - menu addLine. - menu add: 'get sound from lib' translated action: #chooseSound:. - menu add: 'put sound in lib' translated action: #saveSound:. - menu add: 'read sound from disk...' translated action: #readFromDisk:. - menu add: 'save sound on disk...' translated action: #saveToDisk:. - menu add: 'save library on disk...' translated action: #saveLibToDisk:. - ! Item was changed: ----- Method: EnvelopeEditorMorph>>buildGraphAreaIn: (in category 'construction') ----- buildGraphAreaIn: frame | r y | graphArea := RectangleMorph + newBounds: ((frame left + 15) @ (frame top + 15) + corner: (frame right+1) @ (frame bottom - 70)) - newBounds: ((frame left + 40) @ (frame top + 40) - corner: (frame right+1) @ (frame bottom - 60)) color: Color lightGreen lighter lighter. graphArea borderWidth: 1. self addMorph: graphArea. (envelope updateSelector = #pitch: and: [envelope scale <= 2.0]) ifTrue: ["Show half-steps" r := graphArea innerBounds. 0.0 to: 1.0 by: 1.0/12.0/envelope scale do: [:val | y := self yFromValue: val. graphArea addMorph: ((RectangleMorph newBounds: (r left@y extent: r width@1) color: Color veryLightGray) borderWidth: 0)]]. (envelope updateSelector = #ratio: and: [denominator ~= 9999]) ifTrue: ["Show denominator gridding" r := graphArea innerBounds. (0.0 to: 1.0 by: 1.0/denominator/envelope scale) do: [:v | y := self yFromValue: v. graphArea addMorph: ((RectangleMorph newBounds: (r left@y extent: r width@1) color: Color veryLightGray) borderWidth: 0)]]. ! Item was changed: ----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') ----- buildScalesIn: frame | env | env := envelope. pixPerTick := graphArea width // (self maxTime//10) max: 1. "hminortick := ( 1 + ( self maxTime // 800 ) ) * 10. hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100." hScale := (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen. " hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) start: 0 stop: self maxTime minorTick: hminortick minorTickLength: 3 majorTick: hmajortick majorTickLength: 10 caption: 'milliseconds' tickPrintBlock: [:v | v printString]. " self addMorph: hScale. vScale := (Morph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen. "vScale := ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))." "env name = 'pitch' ifTrue: [env scale >= 2.0 ifTrue: [vScale start: 0 stop: env scale minorTick: env scale / 24 minorTickLength: 3 majorTick: env scale / 2.0 majorTickLength: 10 caption: 'pitch (octaves)' tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]] ifFalse: [vScale start: 0 stop: env scale minorTick: 1.0/48.0 minorTickLength: 3 majorTick: 1.0/12.0 majorTickLength: 10 caption: 'pitch (half-steps)' tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]] ifFalse: [ env name = 'random pitch:' ifTrue: [ vScale start: 0.9 stop: 1.1 minorTick: 0.2 / 50.0 minorTickLength: 3 majorTick: 0.2 / 5.0 majorTickLength: 10 caption: env name tickPrintBlock: [:v | v printString]] ifFalse: [ vScale start: 0 stop: env scale minorTick: env scale / 50.0 minorTickLength: 3 majorTick: env scale / 5.0 majorTickLength: 10 caption: env name tickPrintBlock: [:v | v printString]]. ]." vScale := TransformationMorph new asFlexOf: vScale. vScale angle: Float pi / 2.0. self addMorph: vScale. + vScale position: (frame left + 1)@(graphArea top-1) - (3@1). - vScale position: (frame left)@(graphArea top-1) - (3@1). ! Item was changed: ----- Method: EnvelopeEditorMorph>>buildView (in category 'construction') ----- buildView | frame | self color: Color lightGreen. self removeAllMorphs. frame := self innerBounds. self buildGraphAreaIn: frame. self buildScalesIn: frame. self addHandlesIn: frame. self addCurves. line addHandles. + self addMorph: self makeControls. - self addControls. self addKeyboard! Item was added: + ----- Method: EnvelopeEditorMorph>>invokeMenu (in category 'menu') ----- + invokeMenu + "Invoke a menu of additonal functions for this ScorePlayer." + | menu | + menu := MenuMorph new defaultTarget: self. + + envelope updateSelector = #ratio: ifTrue: + [menu add: 'choose denominator...' translated action: #chooseDenominator:]. + menu add: 'adjust scale...' translated action: #adjustScale:. + SoundPlayer isReverbOn + ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb] + ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb]. + menu addLine. + menu add: 'get sound from lib' translated action: #chooseSound:. + menu add: 'put sound in lib' translated action: #saveSound:. + menu add: 'read sound from disk...' translated action: #readFromDisk:. + menu add: 'save sound on disk...' translated action: #saveToDisk:. + menu add: 'save library on disk...' translated action: #saveLibToDisk:. + menu popUpInWorld: self world! Item was added: + ----- Method: EnvelopeEditorMorph>>makeControls (in category 'construction') ----- + makeControls + | chooser button row | + row := AlignmentMorph newRow color: color; borderWidth: 0. + row align: row bounds topLeft with: graphArea bounds bottomLeft + (0@5). + button := SimpleButtonMorph new target: self; borderColor: Color black; + borderWidth: 2; color: color. + row addMorphBack: (button label: 'Menu' translated; actWhen: #buttonDown; + actionSelector: #invokeMenu). + row addMorphBack: (Morph new extent:10@1; color: Color transparent). + chooser := PopUpChoiceMorph new extent: 120@14; + contentsClipped: 'Editing: ' , envelope name; + target: self; + actionSelector: #chooseFrom:envelopeItem:; + getItemsSelector: #curveChoices. + chooser arguments: (Array with: chooser). + row addMorphBack: chooser. + + chooser := PopUpChoiceMorph new extent: 130@14; + contentsClipped: 'Timbre: ' , soundName; + target: self; + actionSelector: #chooseFrom:soundItem:; + getItemsSelector: #soundChoices. + chooser arguments: (Array with: chooser). + row addMorphBack: chooser. + + ^row! Item was changed: ----- 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: 'Menu' translated; actWhen: #buttonDown; - 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 !

1 0

The Trunk: Morphic-kfr.1423.mcz
by commits＠source.squeak.org 01 May '18

01 May '18

Karl Ramberg uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-kfr.1423.mcz ==================== Summary ==================== Name: Morphic-kfr.1423 Author: kfr Time: 1 May 2018, 8:43:29.9614 am UUID: da00fcff-9be1-0b41-991f-db716635e61e Ancestors: Morphic-ul.1422 PianoRollNoteMorph and ScorePlayerMorph moved to MorphicExtras-SoundInterface =============== Diff against Morphic-ul.1422 =============== Item was removed: - 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 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 cursorPoint: 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: - 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 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>>addNewScore (in category 'menu') ----- - addNewScore - "Open a MIDI score and re-init controls..." - | score player | - - score := MIDIScore new. - score tracks: (Array with: Array new). - score trackInfo: #('Instrument'). - player := ScorePlayer onScore: score. - ^self onScorePlayer: player title: 'new'! Item was removed: - ----- Method: ScorePlayerMorph>>addTrackToScore (in category 'menu') ----- - addTrackToScore - "add a instrument track to the current score" - | score tracks trackInfo player | - score := scorePlayer score. - tracks := score tracks copyWith:#(). - score tracks: tracks. - trackInfo := score trackInfo copyWith: 'Instrument'. - score trackInfo: trackInfo. - player := ScorePlayer onScore: score. - ^self onScorePlayer: player title: 'new'! 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: 'add a new score' translated action: #addNewScore. - aMenu add: 'add a new track to score' translated action: #addTrackToScore. - 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: #spaceFill; - 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 := UIManager default chooseFileMatchingSuffixes: #('mid' 'midi') label: 'Choose a MIDI file to open' translated. - fileName isNil - ifTrue: [^ self ]. - - 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@6; - 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@6; - 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@12; - 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: #spaceFill; - 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@12; - target: scorePlayer; - actionSelector: #positionInScore:; - adjustToValue: scorePlayer positionInScore. - r := self makeRow - hResizing: #spaceFill; - 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: #spaceFill; - 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: #spaceFill; - 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: 80@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@12; - target: scorePlayer; - actionSelector: #overallVolume:; - adjustToValue: scorePlayer overallVolume. - r := self makeRow - hResizing: #spaceFill; - 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 - ^ SystemWindow roundedWindowCorners or: [super wantsRoundedCorners]!

1 0

The Trunk: MorphicExtras-kfr.233.mcz
by commits＠source.squeak.org 01 May '18

01 May '18

Karl Ramberg uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-kfr.233.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.233 Author: kfr Time: 1 May 2018, 8:41:37.9624 am UUID: cdd5b8f8-7287-7241-b814-acb070ed2b97 Ancestors: MorphicExtras-kfr.230 Move PianoRollNoteMorph, KeyboardMorphForInput, ScorePlayerMorph and PianoRollScoreMorph to MorphicExtras-SoundInterface =============== Diff against MorphicExtras-kfr.230 =============== Item was changed: PianoKeyboardMorph subclass: #KeyboardMorphForInput instanceVariableNames: 'pianoRoll duration durationModifier articulation buildingChord insertMode prevSelection startOfNextNote' classVariableNames: '' poolDictionaries: '' + category: 'MorphicExtras-SoundInterface'! - 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: + Morph subclass: #PianoRollNoteMorph + instanceVariableNames: 'trackIndex indexInTrack hitLoc editMode selected notePlaying' + classVariableNames: 'SoundPlaying' + poolDictionaries: '' + category: 'MorphicExtras-SoundInterface'! + + !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 cursorPoint: 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 changed: 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-SoundInterface'! - 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: + AlignmentMorph subclass: #ScorePlayerMorph + instanceVariableNames: 'scorePlayer trackInstNames instrumentSelector scrollSlider' + classVariableNames: 'LastMIDIPort' + poolDictionaries: '' + category: 'MorphicExtras-SoundInterface'! + + !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>>addNewScore (in category 'menu') ----- + addNewScore + "Open a MIDI score and re-init controls..." + | score player | + + score := MIDIScore new. + score tracks: (Array with: Array new). + score trackInfo: #('Instrument'). + player := ScorePlayer onScore: score. + ^self onScorePlayer: player title: 'new'! Item was added: + ----- Method: ScorePlayerMorph>>addTrackToScore (in category 'menu') ----- + addTrackToScore + "add a instrument track to the current score" + | score tracks trackInfo player | + score := scorePlayer score. + tracks := score tracks copyWith:#(). + score tracks: tracks. + trackInfo := score trackInfo copyWith: 'Instrument'. + score trackInfo: trackInfo. + player := ScorePlayer onScore: score. + ^self onScorePlayer: player title: 'new'! 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: 'add a new score' translated action: #addNewScore. + aMenu add: 'add a new track to score' translated action: #addTrackToScore. + 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: #spaceFill; + 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 := UIManager default chooseFileMatchingSuffixes: #('mid' 'midi') label: 'Choose a MIDI file to open' translated. + fileName isNil + ifTrue: [^ self ]. + + 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@6; + 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@6; + 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@12; + 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: #spaceFill; + 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@12; + target: scorePlayer; + actionSelector: #positionInScore:; + adjustToValue: scorePlayer positionInScore. + r := self makeRow + hResizing: #spaceFill; + 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: #spaceFill; + 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: #spaceFill; + 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: 80@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@12; + target: scorePlayer; + actionSelector: #overallVolume:; + adjustToValue: scorePlayer overallVolume. + r := self makeRow + hResizing: #spaceFill; + 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 + ^ SystemWindow roundedWindowCorners or: [super wantsRoundedCorners]!

1 0

The Trunk: Tools-dtl.810.mcz
by commits＠source.squeak.org 01 May '18

01 May '18

David T. Lewis uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-dtl.810.mcz ==================== Summary ==================== Name: Tools-dtl.810 Author: dtl Time: 30 April 2018, 8:12:14.871637 pm UUID: 53192ea3-8423-4ff8-b52b-0b87a44fea51 Ancestors: Tools-eem.809 Add comment to explain the intent of Object>>canonicalArgumentName =============== Diff against Tools-eem.809 =============== Item was changed: ----- Method: Object>>canonicalArgumentName (in category '*Tools-Debugger') ----- canonicalArgumentName + "Answer a name that describes the type or class of this object for creating + an argument name for an argument of similar type in a stub method." + ^ self class name!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages May 2018