Squeak-dev April 2018

squeak-dev@lists.squeakfoundation.org

47 participants
159 discussions

The Trunk: Collections-pre.789.mcz
by commits＠source.squeak.org 30 Apr '18

30 Apr '18

Patrick Rein uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-pre.789.mcz ==================== Summary ==================== Name: Collections-pre.789 Author: pre Time: 30 April 2018, 1:25:47.613117 pm UUID: addaf36c-be0c-444f-bc50-074f2e57533e Ancestors: Collections-pre.788 Implements the rusty and dead mimeEncode method for QuotedPrintableMimeConverter. Refactors some of the RFC2047 code. =============== Diff against Collections-pre.788 =============== Item was changed: MimeConverter subclass: #QuotedPrintableMimeConverter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Streams'! + !QuotedPrintableMimeConverter commentStamp: 'pre 4/30/2018 12:13' prior: 0! + I do "quoted printable" MIME decoding as specified in RFC 2045 "MIME Part One: Format of Internet Message Bodies". - !QuotedPrintableMimeConverter commentStamp: '<historical>' prior: 0! - I do quoted printable MIME decoding as specified in RFC 2045 "MIME Part One: Format of Internet Message Bodies". Short version of RFC2045, Sect. 6.7: (1) Any octet, except a CR or LF that is part of a CRLF line break of the canonical (standard) form of the data being encoded, may be represented by an "=" followed by a two digit hexadecimal representation of the octet's value. [...] (2) Octets with decimal values of 33 through 60 inclusive, and 62 through 126, inclusive, MAY be represented as the US-ASCII characters which correspond to those octets [...]. (3) Octets with values of 9 and 32 MAY be represented as US-ASCII TAB (HT) and SPACE characters, respectively, but MUST NOT be so represented at the end of an encoded line. [...] (4) A line break in a text body, represented as a CRLF sequence in the text canonical form, must be represented by a (RFC 822) line break, which is also a CRLF sequence, in the Quoted-Printable encoding. [...] (5) The Quoted-Printable encoding REQUIRES that encoded lines be no more than 76 characters long. If longer lines are to be encoded with the Quoted-Printable encoding, "soft" line breaks must be used. An equal sign as the last character on a encoded line indicates such a non-significant ("soft") line break in the encoded text. + --bf 11/27/1998 16:50 + (2) simply states that 33 to 126 can be represented by US-ASCII except of the equal-sign itself + + --pre! - --bf 11/27/1998 16:50! Item was added: + ----- Method: QuotedPrintableMimeConverter>>conversionNeededFor: (in category 'conversion') ----- + conversionNeededFor: aCharacter + + ^ ((aCharacter asciiValue between: 32 and: 127) not and: [aCharacter asciiValue ~= 9]) + or: [self reservedCharacters includes: aCharacter]! Item was added: + ----- Method: QuotedPrintableMimeConverter>>encodeChar:to: (in category 'as yet unclassified') ----- + encodeChar: aChar to: aStream + + aStream nextPut: $=; + nextPut: (Character digitValue: aChar asciiValue // 16); + nextPut: (Character digitValue: aChar asciiValue \\ 16) + ! Item was changed: ----- Method: QuotedPrintableMimeConverter>>mimeDecode (in category 'conversion') ----- mimeDecode "Do conversion reading from mimeStream writing to dataStream" + | line lineStream c1 v1 c2 v2 | - | line s c1 v1 c2 v2 | [(line := mimeStream nextLine) isNil] whileFalse: [ line := line withoutTrailingBlanks. + line + ifEmpty: [dataStream cr] + ifNotEmpty: [ + lineStream := ReadStream on: line. + [dataStream nextPutAll: (lineStream upTo: $=). + lineStream atEnd] whileFalse: [ + c1 := lineStream next. v1 := c1 digitValue. + ((v1 between: 0 and: 15) and: [lineStream atEnd not]) - line size = 0 - ifTrue: [dataStream cr] - ifFalse: [ - s := ReadStream on: line. - [dataStream nextPutAll: (s upTo: $=). - s atEnd] whileFalse: [ - c1 := s next. v1 := c1 digitValue. - ((v1 between: 0 and: 15) and: [s atEnd not]) ifFalse: [dataStream nextPut: $=; nextPut: c1] + ifTrue: [c2 := lineStream next. v2 := c2 digitValue. - ifTrue: [c2 := s next. v2 := c2 digitValue. (v2 between: 0 and: 15) ifFalse: [dataStream nextPut: $=; nextPut: c1; nextPut: c2] ifTrue: [dataStream nextPut: (Character value: v1 * 16 + v2)]]]. + (line last ~= $= and: [mimeStream atEnd not]) ifTrue: [dataStream cr]]]. - line last = $= ifFalse: [dataStream cr]]]. ^ dataStream! Item was added: + ----- Method: QuotedPrintableMimeConverter>>mimeEncode (in category 'conversion') ----- + mimeEncode + "Do conversion reading from dataStream writing to mimeStream. Break long lines and escape non-7bit chars." + + | currentCharacter line lineStream linePosition | + currentCharacter := nil. + [(line := dataStream nextLine) isNil] whileFalse: [ + lineStream := ReadStream on: line. + linePosition := 0. + + [lineStream atEnd] whileFalse: [ + (self conversionNeededFor: (currentCharacter := lineStream next)) + ifFalse: [mimeStream nextPut: currentCharacter] + ifTrue: [self encodeChar: currentCharacter to: mimeStream]. + linePosition := linePosition + 1. + linePosition = 73 ifTrue: [mimeStream nextPut: $=; crlf. linePosition := 0]]. + dataStream atEnd ifFalse: [mimeStream crlf]]. + ^ mimeStream! Item was added: + ----- Method: QuotedPrintableMimeConverter>>reservedCharacters (in category 'as yet unclassified') ----- + reservedCharacters + + ^ '=' ! Item was changed: QuotedPrintableMimeConverter subclass: #RFC2047MimeConverter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Streams'! + !RFC2047MimeConverter commentStamp: 'pre 4/30/2018 12:13' prior: 0! + I do q format MIME decoding as specified in RFC 2047 ""MIME Part Three: Message Header Extensions for Non-ASCII Text". See String>>decodeMimeHeader! - !RFC2047MimeConverter commentStamp: '<historical>' prior: 0! - I do quoted printable MIME decoding as specified in RFC 2047 ""MIME Part Three: Message Header Extensions for Non-ASCII Text". See String>>decodeMimeHeader! Item was changed: ----- Method: RFC2047MimeConverter>>encodeChar:to: (in category 'private-encoding') ----- encodeChar: aChar to: aStream aChar = Character space ifTrue: [^ aStream nextPut: $_]. + ^ super encodeChar: aChar to: aStream! - ((aChar asciiValue between: 32 and: 127) and: [('?=_' includes: aChar) not]) - ifTrue: [^ aStream nextPut: aChar]. - aStream nextPut: $=; - nextPut: (Character digitValue: aChar asciiValue // 16); - nextPut: (Character digitValue: aChar asciiValue \\ 16) - ! Item was added: + ----- Method: RFC2047MimeConverter>>reservedCharacters (in category 'private-encoding') ----- + reservedCharacters + + ^ '?=_' !

1 0

The Trunk: CollectionsTests-pre.288.mcz
by commits＠source.squeak.org 30 Apr '18

30 Apr '18

Patrick Rein uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-pre.288.mcz ==================== Summary ==================== Name: CollectionsTests-pre.288 Author: pre Time: 30 April 2018, 1:24:08.916117 pm UUID: fef6fd38-d4b4-2946-82c5-91228cf600d4 Ancestors: CollectionsTests-eem.287 Adds a test for the updated quoted printable converter =============== Diff against CollectionsTests-eem.287 =============== Item was added: + TestCase subclass: #QuotedPrintableMimeConverterTest + instanceVariableNames: 'message' + classVariableNames: '' + poolDictionaries: '' + category: 'CollectionsTests-Streams'! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>setUp (in category 'as yet unclassified') ----- + setUp + message := 'Hü Thörä!!' readStream. + ! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>testDecode (in category 'as yet unclassified') ----- + testDecode + + | encodedString decodedString | + encodedString := '=E0'. + decodedString := QuotedPrintableMimeConverter mimeDecode: encodedString as: WideString. + self assert: 'à' equals: decodedString. + + encodedString := 'H=FC Th=F6r=E4!!'. + decodedString := QuotedPrintableMimeConverter mimeDecode: encodedString as: WideString. + self assert: 'Hü Thörä!!' equals: decodedString. + + ! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>testDecodeCrLfToCr (in category 'as yet unclassified') ----- + testDecodeCrLfToCr + + | encodedString decodedString targetString | + encodedString := ((WriteStream on: '') + << 'a'; crlf; << 'b') contents. + decodedString := QuotedPrintableMimeConverter mimeDecode: encodedString as: WideString. + targetString := encodedString := ((WriteStream on: '') + << 'a'; cr; << 'b') contents. + self assert: targetString equals: decodedString.! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>testDecodeMultiline (in category 'as yet unclassified') ----- + testDecodeMultiline + + | encodedString decodedString | + encodedString := 'A multiline = + encoded text which isn''t'. + decodedString := QuotedPrintableMimeConverter mimeDecode: encodedString as: WideString. + self assert: 'A multiline encoded text which isn''t' equals: decodedString. + ! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>testEncodeEqualSign (in category 'as yet unclassified') ----- + testEncodeEqualSign + + | encodedString | + encodedString := QuotedPrintableMimeConverter mimeEncode: 'e=mc2'. + self assert: 'e=3Dmc2' equals: encodedString. + ! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>testEncodeMultilineString (in category 'as yet unclassified') ----- + testEncodeMultilineString + + | encodedString sourceString targetString | + sourceString := 'a multi- + line string'. + encodedString := QuotedPrintableMimeConverter mimeEncode: sourceString. + + targetString := 'a multi-' , String crlf , 'line string'. + self assert: targetString equals: encodedString.! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>testEncodeSimpleString (in category 'as yet unclassified') ----- + testEncodeSimpleString + + | encodedString | + encodedString := QuotedPrintableMimeConverter mimeEncode: message. + self assert: 'H=FC Th=F6r=E4!!' equals: encodedString. + ! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>testEncodeWhitespace (in category 'as yet unclassified') ----- + testEncodeWhitespace + + | encodedString sourceString targetString | + sourceString := 'a string with all the whitespace'. + encodedString := QuotedPrintableMimeConverter mimeEncode: sourceString. + + targetString := 'a string with all the whitespace'. + self assert: targetString equals: encodedString.! Item was added: + ----- Method: QuotedPrintableMimeConverterTest>>testEncodingBreaksUpLongLInes (in category 'as yet unclassified') ----- + testEncodingBreaksUpLongLInes + + | encodedString | + encodedString := QuotedPrintableMimeConverter mimeEncode: 'This is a very long message which has more than 76 characters due to this additional part of the sentence.'. + self assert: 'This is a very long message which has more than 76 characters due to this=', String crlf , ' additional part of the sentence.' equals: encodedString. + !

1 0

The Trunk: Collections-pre.788.mcz
by commits＠source.squeak.org 30 Apr '18

30 Apr '18

Patrick Rein uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-pre.788.mcz ==================== Summary ==================== Name: Collections-pre.788 Author: pre Time: 30 April 2018, 11:26:48.275837 am UUID: 1c0f801e-7fa9-3f40-b692-8c673163b377 Ancestors: Collections-bf.787 Adds a Bit7 MIME converter which is kind of essential but was missing from the previous MIME converter addition commit. =============== Diff against Collections-bf.787 =============== Item was added: + MimeConverter subclass: #Bit7MimeConverter + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Collections-Streams'! Item was added: + ----- Method: Bit7MimeConverter>>mimeDecode (in category 'as yet unclassified') ----- + mimeDecode + + dataStream nextPutAll: mimeStream upToEnd. + ^ dataStream! Item was added: + ----- Method: Bit7MimeConverter>>mimeEncode (in category 'as yet unclassified') ----- + mimeEncode + + | character | + [dataStream atEnd] whileFalse: [ + character := dataStream next. + self assert: character asciiValue < 128. + mimeStream nextPut: character]. + + ^ mimeStream!

1 0

ByteArray>>at:put:
by Bert Freudenberg 30 Apr '18

30 Apr '18

#[195 164] collect: [:c | c hex] => #[16 16] I think this should have raised an error. Tim? - Bert -

7 13

The Trunk: Morphic-ul.1422.mcz
by commits＠source.squeak.org 30 Apr '18

30 Apr '18

Levente Uzonyi uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ul.1422.mcz ==================== Summary ==================== Name: Morphic-ul.1422 Author: ul Time: 30 April 2018, 1:54:21.620338 am UUID: a07d49d4-9104-468e-b610-86f684c1ad0d Ancestors: Morphic-kfr.1421 - reverted Morphic-tpr.1312's change of SimpleBorder >> #initialize =============== Diff against Morphic-kfr.1421 =============== Item was changed: ----- Method: SimpleBorder>>initialize (in category 'initialize-release') ----- initialize width := 0. + baseColor := color := Color transparent! - - color := Color transparent!

1 0

Re: [squeak-dev] Survey: what do you do with Squeak, what do you *want* to do?
by Mathieu van Echtelt 29 Apr '18

29 Apr '18

Hi all, First note: My Squeak contribution is very limited (/can be rounded to zero), so I'm actually not allowed to criticize:) Q-What do you use Squeak for? Used it since it became available in 1996. At that time, afaik, it was the only open source Smalltalk distribution and it was great, especially while enjoying Smalltalk books as "Inside Smalltalk" and the "Smalltalk-80 series", Design Patterns (Gamma e.d.) and Smalltalk's best practice patterns (Kent Beck). Used it professionally around 1998-2000, when we tried to build & commercialize some multimedia "sharing/editing" tool for children. Long story short: this failed. Not because of technical reasons, we were just young and naive. Currently, I'm only using it sporadically for small hobby projects and e.g. to learn from graphics/music/network libraries. Q-If you don't use Squeak, why not? Lack of source code management / package configuration mgmt / modularity / stability / speed (at least that was the state in 2000). Q-If you used Squeak in the past and don't now, what pulled you away? Again, lack of source code management / package configuration mgmt / stability / modularity / speed. We (ag5.com) are currently working with around 10 developers. Working with a group of developers wasn't well supported in Squeak. So we moved to VisualWorks around 2001. At that time we also moved our company's product focus to corporate planning systems. So Squeak's multi-media features became less valuable for us. (And eventually, we also changed our company's name from Cosmocows to AG5). Q-What does Squeak lack that you think might make you use it for 'regular' development? Not sure what is the exact current state and how squeak progressed in the areas I mentioned above. But, over the years, there seem to have been several interesting initiatives like Newspeak (e.g. modularity with inner class concept) or related research projects from HPI Potsdam. But I've no practical experience with these initiatives, only from reading papers and/or a bit of playing. Q-What things are too hard or annoying to do? Again: source code management / package configuration mgmt / modularity / stability / speed. Some initiatives in this area seem to have failed, e.g. Squeak had several Namespace implementation initiatives, none made it into real production, afaik. Integrating with Source code management systems like Git, while keeping the power of the Smalltalk image concept, seems to be hard too. But others initiatives seem to have success, e.g. the opensmalltalk-vm. Even a success in 2 ways: the improved collaboration infrastructure (git/travis) and, of course, the VM performance itself. In some benchmarks, it should even outperform VW, but VW's virtual machine performance is, for us, fast enough (/not the performance bottleneck). MIT's Scratch has also been a success for Squeak in this area: an infrastructure where 1000s of children can share their projects; view & load & try & review projects from some open repository and it all seems to work. (ps. without that I knew, even my daughter started to use it during some school event in Berlin this year. And when she came home, she showed me her work online: a pink horse jumping over hay bales. Amazing.) Something like this is not possible for general Smalltalk programmers, whatever st distribution, and certainly not between the different st distributions. Testing framework SUnit is probably the most successful Smalltalk code in history. (successful in the sense of having succeeders/followers). Still using it almost daily, and it helps to stabilize and share our code. (when I want to understand code from others, I often start reading their test cases). With Monticello and Metacello I've no real practical experience, no opinion. Played with it a few years back, but at that time it was still immature. Nowadays it seems to be used a lot, so probably as good as VW's store for source code mgmt. Q-What would you like to be able to use Squeak for? To develop and run the server part of our web-based "Business" products. Our 2 products: an online ERP system for Dutch Fire-departments and a Skills management system for Manufactures, are continuously developed & integrated & deployed and run by a multidisciplinary team of developers, designers, operators and business analysts. However, I don't see how a switch to Squeak could (financially) pay off. And maybe even more important, most of my (younger) colleagues are enthusiastic python/javascript/swift programmers, they are not hooked on Smalltalk as I do. ==== Not really answering one of the questions above, but some general thoughts about our tools landscape and if/where Squeak could fit in: VisualWorks is still more practical for us than Squeak. It offers a pretty stable & fast core, their 64bit VM is running stable in production for us for several years now (we host 200+ images), and their source code management system "Store" is more or less working for us (we tuned it to our needs). We do not use much of Cincom's "add-on libraries" e.g. we don't use their ORM/Glorp nor any of their web server/frameworks nor tools the UI painter. We do not need their customer support often, but when we need them, they always are very helpful and able to fix bugs. Currently, half of our developers are programming in other languages than Smalltalk, especially for the client-side of our product. Web-client stuff with Javascript/HTML/CSS, native apps with Java & Swift. For all kind of system administration automation, we use Python (including Amazon's AWS scripting). We also work with freelance interaction & visual designers; they are familiar with HTML/CSS/Js and it is much more efficient when developers and designers have some common tooling. In the past, we used a "Model-Driven Design" (MDD) approach. Which meant, in Smalltalk, we "described a high-level domain model", and from this model, all other system parts/layers were automatically generated (including parts in other programming languages). A few years back we moved away from this strategy to develop directly in those other languages, to get higher product quality, especially in the "User eXperience" part. At the cost of Smalltalk and of programming productivity. For me personally, Squeak is "good enough", it's fun and a source of inspiration. But for a company with several developers working on a product with "web- and app clients", Squeak needs better source code management (/git), package configuration mgmt and modularity, so it can better embed into the multi-language workflow of our team of developers, designers. But this "management overhead" would probably make it less attractive for personal hobby use. A dilemma the community should solve:) To repeat my first note: My Squeak contribution is very limited (/can be rounded to zero), so I'm actually not allowed to criticize. Here a complete overview of my limited contributions: - Every year I vote in the board elections. That is another thing I very much like about Squeak: the community is democratic, and the yearly elected board seems to be a team of smart and friendly people. - and I like to attend the yearly Squeak e.V. Treffen (/meeting) at HPI in Potsdam Germany, to give a short presentation of our Smalltalk usage and especially to see others present their interesting Smalltalk related (research) projects. - writing this email. greetings and keep up the good work! Mathieu van Echtelt On Tue, Apr 24, 2018 at 9:11 PM, tim Rowledge <tim(a)rowledge.org> wrote: > Well, we had about 30 replies on this so far and I'd love to read more. Who else can tell us fun stuff? > > tim > -- > tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim > From C:\*.* to shining C:\*.* > > > -- AG5 Timorplein 37 1094 CC Amsterdam T 020 4630942 F 020 4630946 On Tue, Apr 24, 2018 at 9:11 PM, tim Rowledge <tim(a)rowledge.org> wrote: > Well, we had about 30 replies on this so far and I'd love to read more. Who else can tell us fun stuff? > > tim > -- > tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim > From C:\*.* to shining C:\*.* > > > -- AG5 software GmbH www.ag5.com tel: 0049 (0)30 81828464 mobile: 0049 (0)178-2016515 ---------------------------------------------------------------------------------- This message may contain information that is not intended for you. If you are not the addressee or if this message was sent to you by mistake, you are requested to inform the sender and delete the message. Any unauthorised use or dissemination of this message in whole or in part is strictly prohibited.

3 2

two questions about ListChooser>>#accept
by Chris Muller 29 Apr '18

29 Apr '18

1) Should it be making use of "UIManager default" instead of Morphic-specific dialog? 2) When I added a method category, I mis-typed it and simply wanted to cancel, but I was forced to add one or the other and the remove it. This being on ListChooser, however, means this is useful for more than just categories, so this dialog needs a cancelability, does it not?

2 4

The Inbox: MorphicExtras-kfr.232.mcz
by commits＠source.squeak.org 29 Apr '18

29 Apr '18

A new version of MorphicExtras was added to project The Inbox: http://source.squeak.org/inbox/MorphicExtras-kfr.232.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.232 Author: kfr Time: 29 April 2018, 10:10:14.012436 am UUID: 4639d186-22ab-8d48-a447-5c6a897ce664 Ancestors: MorphicExtras-kfr.231 Changed category for KeyboardMorphForInput and PianoRollNoteMorph =============== Diff against MorphicExtras-kfr.231 =============== 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 changed: Morph subclass: #PianoRollNoteMorph instanceVariableNames: 'trackIndex indexInTrack hitLoc editMode selected notePlaying' classVariableNames: 'SoundPlaying' poolDictionaries: '' + category: 'MorphicExtras-SoundInterface'! - category: 'MorphicExtras-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.!

1 0

The Inbox: MorphicExtras-kfr.231.mcz
by commits＠source.squeak.org 29 Apr '18

29 Apr '18

A new version of MorphicExtras was added to project The Inbox: http://source.squeak.org/inbox/MorphicExtras-kfr.231.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.231 Author: kfr Time: 29 April 2018, 10:07:20.104436 am UUID: 97df1342-47df-b749-8994-60166ecacb6f Ancestors: MorphicExtras-kfr.230 PianoRollNoteMorph and ScorePlayerMorph added from Morphic =============== Diff against MorphicExtras-kfr.230 =============== Item was added: + Morph subclass: #PianoRollNoteMorph + instanceVariableNames: 'trackIndex indexInTrack hitLoc editMode selected notePlaying' + classVariableNames: 'SoundPlaying' + poolDictionaries: '' + category: 'MorphicExtras-Sound'! + + !PianoRollNoteMorph commentStamp: '<historical>' prior: 0! + A PianoRollNoteMorph is drawn as a simple mroph, but it carries the necessary state to locate its source sound event via its owner (a PianorRollScoreMorph) and the score therein. Simple editing of pitch and time placement is provided here.! Item was added: + ----- Method: PianoRollNoteMorph>>deselect (in category 'selecting') ----- + deselect + + selected ifFalse: [^ self]. + self changed. + selected := false. + ! Item was added: + ----- Method: PianoRollNoteMorph>>drawOn: (in category 'drawing') ----- + drawOn: aCanvas + + selected + ifTrue: [aCanvas frameAndFillRectangle: self fullBounds fillColor: color borderWidth: 1 borderColor: Color black] + ifFalse: [aCanvas fillRectangle: self bounds color: color]. + ! Item was added: + ----- Method: PianoRollNoteMorph>>editPitch: (in category 'editing') ----- + editPitch: evt + + | mk note | + mk := owner midiKeyForY: evt cursorPoint y. + note := (owner score tracks at: trackIndex) at: indexInTrack. + note midiKey = mk ifTrue: [^ self]. + note midiKey: mk. + self playSound: (self soundOfDuration: 999.0). + self position: self position x @ ((owner yForMidiKey: mk) - 1) + ! Item was added: + ----- Method: PianoRollNoteMorph>>fullBounds (in category 'layout') ----- + fullBounds + + selected + ifTrue: [^ bounds expandBy: 1] + ifFalse: [^ bounds]! Item was added: + ----- Method: PianoRollNoteMorph>>gridToNextQuarter (in category 'editing') ----- + gridToNextQuarter + + owner score gridTrack: trackIndex toQuarter: 1 at: indexInTrack. + owner rebuildFromScore! Item was added: + ----- Method: PianoRollNoteMorph>>gridToPrevQuarter (in category 'editing') ----- + gridToPrevQuarter + + owner score gridTrack: trackIndex toQuarter: -1 at: indexInTrack. + owner rebuildFromScore! Item was added: + ----- Method: PianoRollNoteMorph>>handlesMouseDown: (in category 'event handling') ----- + handlesMouseDown: evt + + ^ owner scorePlayer isPlaying not! Item was added: + ----- Method: PianoRollNoteMorph>>indexInTrack (in category 'accessing') ----- + indexInTrack + + ^ indexInTrack! Item was added: + ----- Method: PianoRollNoteMorph>>invokeNoteMenu: (in category 'menu') ----- + invokeNoteMenu: evt + "Invoke the note's edit menu." + + | menu | + menu := MenuMorph new defaultTarget: self. + menu addList: + #(('grid to next quarter' gridToNextQuarter) + ('grid to prev quarter' gridToPrevQuarter)). + + menu popUpEvent: evt in: self world. + ! Item was added: + ----- Method: PianoRollNoteMorph>>mouseDown: (in category 'event handling') ----- + mouseDown: evt + + hitLoc := evt cursorPoint. + editMode := nil. + owner submorphsDo: + [:m | (m isKindOf: PianoRollNoteMorph) ifTrue: [m deselect]]. + selected := true. + self changed. + owner selection: (Array with: trackIndex with: indexInTrack with: indexInTrack). + self playSound! Item was added: + ----- Method: PianoRollNoteMorph>>mouseMove: (in category 'event handling') ----- + mouseMove: evt + | delta offsetEvt | + editMode isNil + ifTrue: + ["First movement determines edit mode" + + ((delta := evt cursorPoint - hitLoc) dist: 0 @ 0) <= 2 + ifTrue: [^self "No significant movement yet."]. + delta x abs > delta y abs + ifTrue: + [delta x > 0 + ifTrue: + ["Horizontal drag" + + editMode := #selectNotes] + ifFalse: + [self playSound: nil. + offsetEvt := evt copy 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 Inbox: Morphic-kfr.1423.mcz
by commits＠source.squeak.org 29 Apr '18

29 Apr '18

A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-kfr.1423.mcz ==================== Summary ==================== Name: Morphic-kfr.1423 Author: kfr Time: 29 April 2018, 10:04:25.453436 am UUID: 5eb66f58-fb09-9749-b7ff-3ab8eeefa743 Ancestors: Morphic-kfr.1422 Move PianoRollNoteMorph and ScorePlayerMorph to MorphicExtras =============== Diff against Morphic-kfr.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

← Newer
1
2
3
4
5
6
7
...
16
Older →

Jump to page: