[squeak-dev] The Trunk: MorphicExtras-ct.327.mczcommits at source.squeak.org commits at source.squeak.orgThu Aug 25 12:00:19 UTC 2022
Christoph Thiede uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ct.327.mcz ==================== Summary ==================== Name: MorphicExtras-ct.327 Author: ct Time: 25 August 2022, 2:00:16.466239 pm UUID: 44fc8304-1918-e145-88bb-9bc2ec35343b Ancestors: MorphicExtras-ct.323, MorphicExtras-ct.325, MorphicExtras-ct.326 Adds and improves high-dpi support for several morphs and examples: * BannerMorph (revised font, added comment on flex shell) * CurveMorph extraExampleTextFlow (removed scaling, added comment of flex morph) * Event Recorder * Objects Tool/Parts Bin (and improved #applyUserInterfaceTheme for theme/scale changes) * Piano Roll (also minor refactoring on PianoRollNoteMorph: renamed overloaded #fullBounds -> #boundsForSelection, added proper implementation of #outerBounds to fix invalidation issues, reused #[de]select)) * PolygonMorph extra examples * Recording Controls (revised from MorphicExtras-ct.325 (also fixed slider, improved color of record level slider, and removed obsolete construction selectors) * Score player (revised from MorphicExtras-ct.323) =============== Diff against MorphicExtras-ct.326 =============== Item was changed: ----- Method: BannerMorph>>createContents (in category 'initialize-release') ----- createContents | text | text := self contents asText addAttribute: TextEmphasis bold; - addAttribute: (TextFontReference toFont: - (StrikeFont familyName: #ComicPlain size: 39)); asMorph. + text fontName: 'Bitmap DejaVu Sans' pointSize: 31. text readOnly: true; flag: #ct. "We're no *that* life, yet :(" ^ ScreeningMorph new addMorph: (self createBackground + extent: (text fullBounds; extent); - extent: text extent; yourself); addMorph: text; showScreened; cellPositioning: #center; yourself! Item was changed: ----- Method: BannerMorph>>initialize (in category 'initialize-release') ----- initialize super initialize. + + "Note: No high-dpi support because the header font is not available in a sufficiently large font size, and it cannot be embedded in a flex shell as it uses #fillsOwner:. Instead, the entire receiver can be embedded in a flex shell." self extent: 300 @ 200. self changeProportionalLayout; addMorph: (Morph new color: Color transparent; changeTableLayout; listCentering: #center; wrapCentering: #center; addMorph: self createContents; yourself) fullFrame: LayoutFrame fullFrame; addMorph: self createHeader.! Item was changed: ----- Method: CurveMorph class>>extraExampleTextFlow (in category '*MorphicExtras-examples') ----- extraExampleTextFlow + "CurveMorph extraExampleTextFlow openInHand + + Note: No high-dpi support because text flow only matches a certain scaling factor." - "CurveMorph extraExampleTextFlow openInHand" | curve text | curve := CurveMorph + vertices: {135 @ 270. 75 @ 200. 50 @ 150. 100 @ 100. 125 @ 150. 175 @ 100. 200 @ 150. 175 @ 200 . 115 @ 340} - vertices: {135 @ 270. 75 @ 200. 50 @ 150. 100 @ 100. 125 @ 150. 175 @ 100. 200 @ 150. 175 @ 200 . 115 @ 340} * RealEstateAgent scaleFactor color: Color cyan + borderWidth: 25 - borderWidth: 25 * RealEstateAgent scaleFactor borderColor: Color salmon. curve makeOpen; beSmoothCurve. + text := (('Texts can also follow ........................................ an open curve. ' asText - text := ('Texts can also follow ........................................ an open curve. ' asText , ('So morphic!!' asText addAttribute: TextEmphasis italic; addAttribute: (TextColor color: Color blue); yourself)) + asMorph) + fontName: 'Bitmap DejaVu Sans' pointSize: 14.5; + yourself. - addAttribute: (TextFontChange fontNumber: (3.4 * RealEstateAgent scaleFactor) rounded); - asMorph. text textColor: Color yellow. curve addMorph: text. text followCurve. ^ curve! Item was changed: ----- Method: EventRecorderMorph>>addVoiceControls (in category 'sound') ----- addVoiceControls | levelSlider r meterBox | voiceRecorder := SoundRecorder new desiredSampleRate: 11025.0; "<==try real hard to get the low rate" codec: (GSMCodec new). "<--this should compress better than ADPCM.. is it too slow?" "codec: (ADPCMCodec new initializeForBitsPerSample: 4 samplesPerFrame: 0)." levelSlider := SimpleSliderMorph new color: color; + extent: 100 px @ 2 px; - extent: 100 at 2; target: voiceRecorder; actionSelector: #recordLevel:; adjustToValue: voiceRecorder recordLevel. r := AlignmentMorph newRow color: color; layoutInset: 0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #rigid; + height: 24 px. - height: 24. r addMorphBack: (StringMorph contents: '0 '). r addMorphBack: levelSlider. r addMorphBack: (StringMorph contents: ' 10'). self addMorphBack: r. + meterBox := Morph new extent: 102 px @ 18 px; color: Color gray. + recordMeter := Morph new extent: 1 px @ 16 px; color: Color yellow. + recordMeter position: meterBox topLeft + (1 px @ 1 px). - meterBox := Morph new extent: 102 at 18; color: Color gray. - recordMeter := Morph new extent: 1 at 16; color: Color yellow. - recordMeter position: meterBox topLeft + (1 at 1). meterBox addMorph: recordMeter. r := AlignmentMorph newRow vResizing: #shrinkWrap. r addMorphBack: meterBox. + self addMorphBack: r.! - self addMorphBack: r. - ! Item was changed: ----- Method: EventRecorderMorph>>defaultBorderWidth (in category 'initialization') ----- defaultBorderWidth "answer the default border width for the receiver" + ^ 2 px! - ^ 2! Item was changed: ----- Method: EventRecorderMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" saved := true. self listDirection: #topToBottom; wrapCentering: #center; cellPositioning: #topCenter; hResizing: #shrinkWrap; vResizing: #shrinkWrap; + layoutInset: 2 px; + minCellSize: 4 px; - layoutInset: 2; - minCellSize: 4; addButtons! Item was changed: ----- Method: EventRecorderMorph>>makeARowForButtons (in category 'initialization') ----- makeARowForButtons ^AlignmentMorph newRow vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter; + minCellSize: 4 px; - minCellSize: 4; color: Color blue! Item was changed: ----- Method: EventRecorderMorph>>makeStatusLight (in category 'initialization') ----- makeStatusLight + ^ self makeStatusLightIn: 11 px @ 11 px! - ^statusLight := EllipseMorph new - extent: 11 @ 11; - color: Color green; - borderWidth: 0! Item was changed: ----- Method: Morph>>dismissButton (in category '*MorphicExtras-menus') ----- dismissButton "Answer a button whose action would be to dismiss the receiver, and whose action is to send #delete to the receiver" | aButton | aButton := SimpleButtonMorph new. aButton target: self topRendererOrSelf; color: Color lightRed; borderColor: Color lightRed muchDarker; + borderWidth: 1 px; - borderWidth: 1; label: 'X' font: Preferences standardButtonFont; actionSelector: #delete; setBalloonText: 'dismiss' translated. ^ aButton! Item was changed: ----- Method: ObjectsTool>>applyUserInterfaceTheme (in category 'updating') ----- applyUserInterfaceTheme super applyUserInterfaceTheme. + self setDefaultParameters. + + self tweakAppearanceAfterModeShift. + Project current addDeferredUIMessage: [ + self flag: #ct. "There is no guarantee that my submorphs will be updated before myself." + self layoutChanged].! - self setDefaultParameters.! Item was changed: ----- Method: ObjectsTool>>highlightOnlySubmorph:in: (in category 'tabs') ----- highlightOnlySubmorph: aMorph in: anotherMorph "Distinguish only aMorph with border highlighting (2-pixel wide red); make all my other submorphs have one-pixel-black highlighting. This is a rather special-purpose and hard-coded highlighting regime, of course. Later, if someone cared to do it, we could parameterize the widths and colors via properties, or some such." anotherMorph submorphs do: [:m | | color | color := m == aMorph ifTrue: [self buttonActiveColor] ifFalse: [self buttonColor]. m + borderWidth: 1 px; - borderWidth: 1; borderColor: color. + m firstSubmorph color: color]! - m firstSubmorph color: color] - ! Item was changed: ----- Method: ObjectsTool>>initializeForFlap (in category 'initialization') ----- initializeForFlap "Initialize the receiver to operate in a flap at the top of the screen." " Flaps newObjectsFlap openInWorld " | buttonPane aBin aColor heights tabsPane | self basicInitialize. self layoutInset: 0; layoutPolicy: ProportionalLayout new; hResizing: #shrinkWrap; vResizing: #rigid; + borderWidth: 2 px; borderColor: Color darkGray; - borderWidth: 2; borderColor: Color darkGray; extent: (self minimumWidth @ self minimumHeight). "mode buttons" buttonPane := self paneForTabs: self modeTabs. buttonPane vResizing: #shrinkWrap; setNameTo: 'ButtonPane'; color: (aColor := buttonPane color) darker; + layoutInset: 6 px; - layoutInset: 6; wrapDirection: nil; width: self width; layoutChanged; fullBounds. "Place holder for a tabs or text pane" tabsPane := Morph new setNameTo: 'TabPane'; hResizing: #spaceFill; yourself. + heights := { buttonPane height. 40 px }. - heights := { buttonPane height. 40 }. buttonPane vResizing: #spaceFill. self addMorph: buttonPane fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0) offsets: (0 @ 0 corner: 0 @ heights first)). self addMorph: tabsPane fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0) offsets: (0 @ heights first corner: 0 @ (heights first + heights second))). aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #()) listDirection: #leftToRight; wrapDirection: #topToBottom; color: aColor lighter lighter; setNameTo: 'Parts'; dropEnabled: false; vResizing: #spaceFill; yourself. self addMorph: aBin fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1) offsets: (0 @ (heights first + heights second) corner: 0 @ 0)). aBin color: (Color orange muchLighter); setNameTo: 'Objects' translated. self color: (Color orange muchLighter); + setNameTo: 'Objects' translated.! - setNameTo: 'Objects' translated. - ! Item was changed: ----- Method: ObjectsTool>>initializeToStandAlone (in category 'initialization') ----- initializeToStandAlone "Initialize the receiver so that it can live as a stand-alone morph" | buttonPane aBin aColor tabsPane | self basicInitialize. self layoutInset: 0; useRoundedCorners; hResizing: #rigid; vResizing: #shrinkWrap; extent: RealEstateAgent standardSize; listDirection: #topToBottom; wrapDirection: #none. "mode buttons" buttonPane := self paneForTabs: self modeTabs. buttonPane color: self baseBackgroundColor. buttonPane vResizing: #shrinkWrap; setNameTo: 'ButtonPane'; addMorphFront: self dismissButton; addMorphBack: self helpButton; color: (aColor := buttonPane color) darker; + layoutInset: 5 px; - layoutInset: 5; width: self width; layoutChanged; fullBounds. "Place holder for a tabs or text pane" tabsPane := Morph new. tabsPane color: self baseBackgroundColor; setNameTo: 'TabPane'; hResizing: #spaceFill; vResizing: #shrinkWrap. aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #()) changeTableLayout; listDirection: #leftToRight; wrapDirection: #topToBottom; vResizing: #shrinkWrap; color: aColor lighter lighter; borderColor: aColor lighter lighter; setNameTo: 'Parts'; dropEnabled: false; yourself. self addMorphBack: buttonPane. self addMorphBack: tabsPane. self addMorphBack: aBin. + self fullBounds; layoutChanged. "ct: Required for appropriate scale-to-width in high-dpi mode." + self + borderWidth: 1 px; - borderWidth: 1; borderColor: self baseBorderColor; color: self baseBackgroundColor; setNameTo: 'Objects' translated; showCategories.! Item was changed: ----- Method: ObjectsTool>>minHeight (in category 'layout') ----- minHeight + ^(self minimumBottom - self top) max: 280 px! - ^(self minimumBottom - self top) max: 280! Item was changed: ----- Method: ObjectsTool>>minWidth (in category 'layout') ----- minWidth "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall." + ^ 400 px! - ^ 400! Item was changed: ----- Method: ObjectsTool>>minimumBottom (in category 'layout') ----- minimumBottom | iconsBottom partsBin | partsBin := self partsBin ifNil: [ ^self bottom ]. iconsBottom := partsBin submorphs isEmpty + ifTrue: [ partsBin top + 60 px ] - ifTrue: [ partsBin top + 60 ] ifFalse: [ partsBin submorphBounds bottom + partsBin layoutInset ]. ^iconsBottom + self layoutInset + self borderWidth! Item was changed: ----- Method: ObjectsTool>>newSearchPane (in category 'search') ----- newSearchPane "Answer a type-in pane for searches" | aTextMorph | aTextMorph := TextMorph new setProperty: #defaultContents toValue: ('' asText allBold addAttribute: (TextFontChange font3)); setTextStyle: (TextStyle fontArray: { Preferences standardEToysFont }); setDefaultContentsIfNil; on: #keyStroke send: #searchPaneCharacter: to: self; setNameTo: 'SearchPane'; setBalloonText: 'Type here and all entries that match will be shown.' translated; vResizing: #shrinkWrap; hResizing: #spaceFill; + margins: 4 px @ 6 px; - margins: 4 at 6; backgroundColor: Color white. ^ aTextMorph! Item was changed: ----- Method: ObjectsTool>>paneForTabs: (in category 'tabs') ----- paneForTabs: tabList "Answer a pane bearing tabs for the given list" | aPane | tabList do: [:t | t color: Color transparent. + t borderWidth: 1 px; - t borderWidth: 1; borderColor: Color black]. aPane := Morph new changeTableLayout; color: self baseBackgroundColor; listDirection: #leftToRight; wrapDirection: #topToBottom; vResizing: #spaceFill; hResizing: #spaceFill; + cellGap: 6 px; + layoutInset: 4 px; - cellGap: 6; - layoutInset: 4; listCentering: #center; addAllMorphs: tabList; yourself. aPane width: self layoutBounds width. ^ aPane! Item was changed: ----- Method: ObjectsTool>>setDefaultParameters (in category 'initialization') ----- setDefaultParameters + + | paneColor | + self extent: self minimumWidth @ self minimumHeight. + {self buttonPane. self tabsPane} do: [:pane | + pane ifNotNil: [ + pane color: (paneColor := self baseBackgroundColor). + + pane allMorphs + select: [:morph | morph isButton] + thenDo: [:morph | morph label: morph label font: TextStyle defaultFont]]]. + self partsBin color: paneColor lighter lighter; borderColor: paneColor lighter lighter. + self borderColor: self baseBorderColor; + color: self baseBackgroundColor. + + self flag: #todo. "Make all fonts and icons larger"! - color: self baseBackgroundColor! Item was changed: PasteUpMorph subclass: #PartsBin + instanceVariableNames: 'knownScaleFactor' - instanceVariableNames: '' classVariableNames: 'Thumbnails' poolDictionaries: '' category: 'MorphicExtras-PartsBin'! Item was added: + ----- Method: PartsBin class>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + self clearThumbnailCache. "scale factor might have changed"! Item was added: + ----- Method: PartsBin class>>themeProperties (in category 'updating') ----- + themeProperties + "Ensure that #applyUserInterfaceTheme is sent." + + ^ super themeProperties + , {{#placeholder. '<placeholder>'. 'Just a placeholder to ensure that this class is sent #applyUserInterfaceTheme updates.'}}! Item was added: + ----- Method: PartsBin>>applyUserInterfaceTheme (in category 'updating') ----- + applyUserInterfaceTheme + + | scaleFactor | + super applyUserInterfaceTheme. + + scaleFactor := RealEstateAgent scaleFactor. + scaleFactor = knownScaleFactor ifFalse: [ + | relativeScale | + self flag: #ct. "Simple heuristic to keep the state of all buttons intact. Result might be blurry, but at least is scaled properly." + + relativeScale := scaleFactor / knownScaleFactor. + self submorphs do: [:morph | + morph color: self color. + + morph labelMorph ifNotNil: [:sketch | + sketch extent: sketch extent * relativeScale]. + + morph extent: morph extent * relativeScale. + morph labelMorph ifNotNil: [:sketch | + sketch center: morph center]]. + knownScaleFactor := scaleFactor].! Item was added: + ----- Method: PartsBin>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + knownScaleFactor := RealEstateAgent scaleFactor.! Item was changed: ----- Method: PartsBin>>listDirection:quadList:buttonClass: (in category 'initialization') ----- listDirection: aListDirection quadList: quadList buttonClass: buttonClass "Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form: (<receiver> <selector> <label> <balloonHelp>) Used by external package Connectors." self layoutPolicy: TableLayout new. self listDirection: aListDirection. self wrapCentering: #topLeft. + self layoutInset: 2 px. - self layoutInset: 2. self cellPositioning: #bottomCenter. aListDirection == #leftToRight ifTrue: [self vResizing: #rigid. self hResizing: #spaceFill. self wrapDirection: #topToBottom] ifFalse: [self hResizing: #rigid. self vResizing: #spaceFill. self wrapDirection: #leftToRight]. quadList do: [:tuple | | aButton aClass | aClass := Smalltalk at: tuple first. aButton := buttonClass new initializeWithThumbnail: (self class thumbnailForQuad: tuple color: self color) withLabel: tuple third andColor: self color andSend: tuple second to: aClass. (tuple size > 3 and: [tuple fourth isEmptyOrNil not]) ifTrue: [aButton setBalloonText: tuple fourth]. self addMorphBack: aButton]! Item was changed: Morph subclass: #PianoRollNoteMorph instanceVariableNames: 'trackIndex indexInTrack hitLoc editMode selected notePlaying' classVariableNames: 'SoundPlaying' poolDictionaries: '' category: 'MorphicExtras-SoundInterface'! + !PianoRollNoteMorph commentStamp: 'ct 8/25/2022 12:12' prior: 0! + A PianoRollNoteMorph is drawn as a simple morph, but it carries the necessary state to locate its source sound event via its owner (a PianoRollScoreMorph) and the score therein. Simple editing of pitch and time placement is provided here.! - !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>>boundsForSelection (in category 'selecting') ----- + boundsForSelection + + ^ self bounds outsetBy: (self selected ifFalse: [0 px] ifTrue: [1 px])! Item was changed: ----- Method: PianoRollNoteMorph>>deselect (in category 'selecting') ----- deselect + selected = false ifTrue: [^ self]. - selected ifFalse: [^ self]. self changed. + selected := false.! - selected := false. - ! Item was changed: ----- Method: PianoRollNoteMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas selected + ifTrue: [aCanvas frameAndFillRectangle: self boundsForSelection fillColor: color borderWidth: 1 px borderColor: Color black] + ifFalse: [aCanvas fillRectangle: self bounds color: color].! - ifTrue: [aCanvas frameAndFillRectangle: self fullBounds fillColor: color borderWidth: 1 borderColor: Color black] - ifFalse: [aCanvas fillRectangle: self bounds color: color]. - ! Item was changed: ----- 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 px). - 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 changed: ----- Method: PianoRollNoteMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt hitLoc := evt cursorPoint. editMode := nil. owner submorphsDo: [:m | (m isKindOf: PianoRollNoteMorph) ifTrue: [m deselect]]. + self select. - selected := true. - self changed. owner changed. owner selection: (Array with: trackIndex with: indexInTrack with: indexInTrack). self playSound! Item was changed: ----- 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 px - ((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 translateBy: 20 px @ 0. - offsetEvt := evt copy translateBy:(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>>outerBounds (in category 'selecting') ----- + outerBounds + + ^ self bounds outsetBy: 1 px! Item was changed: ----- Method: PianoRollNoteMorph>>select (in category 'selecting') ----- select + selected = true ifTrue: [^ self]. + selected := true.! - selected ifTrue: [^ self]. - selected := true. - self changed! Item was changed: ----- Method: PianoRollNoteMorph>>trackIndex:indexInTrack: (in category 'initialization') ----- trackIndex: ti indexInTrack: i trackIndex := ti. indexInTrack := i. + self deselect.! - selected := false! Item was changed: ----- Method: PianoRollScoreMorph>>addNotes (in category 'drawing') ----- addNotes "Recompute the set of morphs that should be visible at the current scroll position." | visibleMorphs rightEdge topEdge rightEdgeTime | visibleMorphs := OrderedCollection new: 500. rightEdge := self right - self borderWidth. rightEdgeTime := self timeForX: rightEdge. + topEdge := self top + self borderWidth + (1 px clampLow: 1). - topEdge := self top + self borderWidth + 1. "Add ambient morphs first (they will be front-most)" score eventMorphsWithTimeDo: [:m :t | m addMorphsTo: visibleMorphs pianoRoll: self eventTime: t betweenTime: leftEdgeTime and: rightEdgeTime]. "Then add note morphs" score tracks withIndexDo: [:track :trackIndex | | done n i nRight nTop nLeft trackColor | trackColor := colorForTrack at: trackIndex. i := indexInTrack at: trackIndex. done := scorePlayer mutedForTrack: trackIndex. [done | (i > track size)] whileFalse: [ n := track at: i. (n isNoteEvent and: [n midiKey >= lowestNote]) ifTrue: [ n time > rightEdgeTime ifTrue: [done := true] ifFalse: [ nLeft := self xForTime: n time. + nTop := (self yForMidiKey: n midiKey) - 1 px. - nTop := (self yForMidiKey: n midiKey) - 1. nTop > topEdge ifTrue: [ + nRight := nLeft + (n duration * timeScale * RealEstateAgent scaleFactor) truncated - 1 px. - nRight := nLeft + (n duration * timeScale) truncated - 1. visibleMorphs add: ((PianoRollNoteMorph + newBounds: (nLeft @ nTop corner: nRight @ (nTop + 3 px)) - newBounds: (nLeft at nTop corner: nRight@(nTop + 3)) color: trackColor) trackIndex: trackIndex indexInTrack: i)]]]. i := i + 1]. (selection notNil and: [trackIndex = selection first and: [i >= selection second and: [(indexInTrack at: trackIndex) <= selection third]]]) ifTrue: [visibleMorphs do: [:vm | (vm isKindOf: PianoRollNoteMorph) ifTrue: [vm selectFrom: selection]]]]. "Add the cursor morph in front of all notes; height and position are set later." + cursor ifNil: [cursor := Morph newBounds: (self topLeft extent: 1 px @ 1 px) color: Color red]. - cursor ifNil: [cursor := Morph newBounds: (self topLeft extent: 1 at 1) color: Color red]. visibleMorphs addFirst: cursor. self changed. self removeAllMorphs. + self addAllMorphs: visibleMorphs.! - self addAllMorphs: visibleMorphs. - ! Item was changed: ----- Method: PianoRollScoreMorph>>drawMeasureLinesOn: (in category 'drawing') ----- drawMeasureLinesOn: aCanvas | ticksPerMeas x measureLineColor inner | showBeatLines ifNil: [showBeatLines := false]. showMeasureLines ifNil: [showMeasureLines := true]. notePerBeat ifNil: [self timeSignature: 4 over: 4]. showBeatLines ifTrue: [measureLineColor := Color gray: 0.8. ticksPerMeas := score ticksPerQuarterNote. inner := self innerBounds. (leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas) to: ((self timeForX: self right - self borderWidth) truncateTo: ticksPerMeas) by: ticksPerMeas do: [:tickTime | x := self xForTime: tickTime. + aCanvas fillRectangle: (x @ inner top extent: 1 px @ inner height) - aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height) color: measureLineColor]]. + - showMeasureLines ifTrue: [measureLineColor := Color gray: 0.7. ticksPerMeas := beatsPerMeasure*score ticksPerQuarterNote*4//notePerBeat. inner := self innerBounds. (leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas) to: ((self timeForX: self right - self borderWidth) truncateTo: ticksPerMeas) by: ticksPerMeas do: [:tickTime | x := self xForTime: tickTime. + aCanvas fillRectangle: (x @ inner top extent: 1 px @ inner height) + color: (tickTime = 0 ifTrue: [Color black] ifFalse: [measureLineColor])]].! - aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height) - color: (tickTime = 0 ifTrue: [Color black] ifFalse: [measureLineColor])]]. - ! Item was changed: ----- Method: PianoRollScoreMorph>>drawStaffOn: (in category 'drawing') ----- drawStaffOn: aCanvas | blackKeyColor l r topEdge y | self drawMeasureLinesOn: aCanvas. blackKeyColor := Color gray: 0.5. l := self left + self borderWidth. r := self right - self borderWidth. + topEdge := self top + self borderWidth + 3 px. - topEdge := self top + self borderWidth + 3. lowestNote to: self highestNote do: [:k | y := self yForMidiKey: k. y <= topEdge ifTrue: [^ self]. "over the top!!" (self isBlackKey: k) ifTrue: [ aCanvas + fillRectangle: (l @ y corner: r @ (y + 1 px)) + color: blackKeyColor]].! - fillRectangle: (l at y corner: r@(y + 1)) - color: blackKeyColor]]. - ! Item was changed: ----- Method: PianoRollScoreMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" + self extent: 400 px @ 300 px. - self extent: 400 @ 300. showMeasureLines := true. showBeatLines := false. self timeSignature: 4 over: 4. + self clipSubmorphs: true.! - self clipSubmorphs: true! Item was changed: ----- Method: PianoRollScoreMorph>>layoutChanged (in category 'layout') ----- layoutChanged "Override this to avoid propagating 'layoutChanged' when just adding/removing note objects." + ""fullBounds = bounds ifTrue: [^ self]."" - fullBounds = bounds ifTrue: [^ self]. super layoutChanged. ! Item was changed: ----- Method: PianoRollScoreMorph>>midiKeyForY: (in category 'geometry') ----- midiKeyForY: y + ^ (lowestNote - ((y - (bounds bottom - self borderWidth - 4 px)) // 3)) - ^ (lowestNote - ((y - (bounds bottom - self borderWidth - 4)) // 3)) clampLow: 0 high: self highestNote! Item was changed: ----- Method: PianoRollScoreMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt | noteMorphs chordRect | + (self notesInRect: ((evt cursorPoint extent: (1 px clampLow: 1) @ 0) expandBy: 2 px @ 30 px)) isEmpty - (self notesInRect: ((evt cursorPoint extent: 1 at 0) expandBy: 2 at 30)) isEmpty ifTrue: ["If not near a note, then put up score edit menu" ^ self invokeScoreMenu: evt]. "Clicked near (but not on) a note, so play all notes at the cursor time" + noteMorphs := self notesInRect: ((evt cursorPoint extent: (1 px clampLow: 1) @ 0) expandBy: 0 @ self height). + chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: (1 px clampLow: 1). - noteMorphs := self notesInRect: ((evt cursorPoint extent: 1 at 0) expandBy: 0 at self height). - chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: 1. soundsPlayingMorph := Morph newBounds: chordRect color: Color green. self addMorphBack: soundsPlayingMorph. soundsPlaying := IdentityDictionary new. noteMorphs do: [:m | | sound | sound := m soundOfDuration: 999.0. soundsPlaying at: m put: sound. + SoundPlayer resumePlaying: sound quickStart: false].! - SoundPlayer resumePlaying: sound quickStart: false]. - - ! Item was changed: ----- Method: PianoRollScoreMorph>>mouseMove: (in category 'event handling') ----- mouseMove: evt | noteMorphs chordRect | soundsPlaying ifNil: [^ self]. self autoScrollForX: evt cursorPoint x. "Play all notes at the cursor time" + noteMorphs := self notesInRect: ((evt cursorPoint extent: (1 px clampLow: 1) @ 0) expandBy: 0 @ self height). + chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: (1 px clampLow: 1). - noteMorphs := self notesInRect: ((evt cursorPoint extent: 1 at 0) expandBy: 0 at self height). - chordRect := (self innerBounds withLeft: evt cursorPoint x) withWidth: 1. soundsPlayingMorph delete. soundsPlayingMorph := Morph newBounds: chordRect color: Color green. self addMorphBack: soundsPlayingMorph. noteMorphs do: [:m | | sound | "Add any new sounds" (soundsPlaying includesKey: m) ifFalse: [sound := m soundOfDuration: 999.0. soundsPlaying at: m put: sound. SoundPlayer resumePlaying: sound quickStart: false]]. soundsPlaying keys do: [:m | "Remove any sounds no longer in selection." (noteMorphs includes: m) ifFalse: [(soundsPlaying at: m) stopGracefully. + soundsPlaying removeKey: m]].! - soundsPlaying removeKey: m]]. - - ! Item was changed: ----- Method: PianoRollScoreMorph>>moveCursorToTime: (in category 'scrolling') ----- moveCursorToTime: scoreTime | cursorOffset desiredCursorHeight | scorePlayer isPlaying ifTrue: + [cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale * RealEstateAgent scaleFactor) asInteger. - [cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger. (cursorOffset < 0 + or: [cursorOffset > (self width - 20 px)]) - or: [cursorOffset > (self width-20)]) ifTrue: + [self goToTime: scoreTime - (20 px / timeScale). - [self goToTime: scoreTime - (20/timeScale). cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]] ifFalse: [self goToTime: (scoreTime - (self width//2 / timeScale) max: (self width//10 / timeScale) negated). cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]. cursor position: (self left + self borderWidth + cursorOffset)@(self top + self borderWidth). desiredCursorHeight := self height. + cursor height ~= desiredCursorHeight ifTrue: [cursor extent: (1 px clampLow: 1) @ desiredCursorHeight].! - cursor height ~= desiredCursorHeight ifTrue: [cursor extent: 1 at desiredCursorHeight]. - ! Item was changed: ----- Method: PianoRollScoreMorph>>timeForX: (in category 'geometry') ----- timeForX: aNumber + ^ ((aNumber - self left - self borderWidth) asFloat / timeScale / RealEstateAgent scaleFactor + leftEdgeTime) asInteger! - ^ ((aNumber - self left - self borderWidth) asFloat / timeScale + leftEdgeTime) asInteger! Item was changed: ----- Method: PianoRollScoreMorph>>xForTime: (in category 'geometry') ----- xForTime: aNumber + ^ ((aNumber - leftEdgeTime) asFloat * timeScale * RealEstateAgent scaleFactor) asInteger + self left + self borderWidth - ^ ((aNumber - leftEdgeTime) asFloat * timeScale) asInteger + self left + self borderWidth ! Item was changed: ----- Method: PianoRollScoreMorph>>yForMidiKey: (in category 'geometry') ----- yForMidiKey: midiKey + ^ (self bottom - self borderWidth - 4 px) - (3 * (midiKey - lowestNote)) - ^ (self bottom - self borderWidth - 4) - (3 * (midiKey - lowestNote)) ! Item was changed: ----- Method: PolygonMorph class>>extraExampleTextFlow (in category '*MorphicExtras-examples') ----- extraExampleTextFlow "PolygonMorph extraExampleTextFlow openInHand" | polygon text obstacle | polygon := self new. polygon setVertices: self extraCircularVertices; + extent: 360 px @ 380 px; - extent: 309 asPoint; beSmoothCurve; color: Color lightGray; addHandles. text := (TextMorph string: 'TextMorphs can be chained together, causing their contents to flow between containers as either the contents or the containers change. If a TextMorph is embedded in another Morph, you can ask it to have fill the shape of that Morph. Moreover, you can ask it to avoid occlusions, in which case it will do its best to avoid collisions with siblings being in front of it. If a TextMorph is embedded in a CurveMorph, you can ask it to have the text follow the curve, as illustrated here.' asTextMorph fontName: #BitstreamVeraSans + size: 14 px) - size: 14) textColor: Color white; fillsOwner: true; yourself. obstacle := StarMorph new + center: polygon center - (50 px @ 25 px); + extent: 81 px asPoint; - center: polygon center - (50 @ 25); - extent: 81 asPoint; color: Color orchid; yourself. polygon addMorph: text; addMorph: obstacle. text centered. text container avoidsOcclusions: true. ^ polygon! Item was changed: ----- Method: PolygonMorph class>>extraExampleTrapeze (in category '*MorphicExtras-examples') ----- extraExampleTrapeze "PolygonMorph extraExampleTrapeze openInHand" | polygon text | polygon := self new. polygon + setVertices: {0 @ 120 px. 275 px @ 120 px. 200 px @ 0. 75 px @ 0}; + addHandles; - setVertices: {0 @ 100. 275 @ 100. 200 @ 0. 75 @ 0}; - addHandles ; balloonText: 'Click and drag the handles to change my shape'. text := '<b>Polygons</b> can be closed or open, filled or empty as well as lined or convex and can have directed arrows, bevelled borders and last but not least adapted handles.' asTextFromHtml asMorph + beAllFont: (TextStyle default fontOfSize: 14 px); - beAllFont: (TextStyle default fontOfSize: 14); fillsOwner: true; yourself. polygon addMorph: text. text centered. ^ polygon! Item was changed: ----- Method: PolygonMorph class>>extraExampleTrapezePlus (in category '*MorphicExtras-examples') ----- extraExampleTrapezePlus "PolygonMorph extraExampleTrapezePlus openInHand" "Some additional decoration" ^ self extraExampleTrapeze fillStyle: ((GradientFillStyle ramp: { 0.0 -> Color orange. 0.7 -> Color magenta twiceLighter. 1.0 -> Color red muchLighter }) + origin: 0 @ 0; direction: 275 px @ 100 px; - origin: 0 @ 0; direction: 275 @ 100; yourself); + borderWidth: 2 px; - borderWidth: 2; borderColor: Color blue; + dashedBorder: {35 px. 20 px. Color yellow}; - dashedBorder: {35. 20. Color yellow}; yourself! Item was changed: ----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') ----- addButtonRows | r fullWidth | r := AlignmentMorph newRow vResizing: #shrinkWrap. + - - r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph). + r addMorphBack: (Morph new extent: 4 px @ 1 px; color: Color transparent). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile). + r addMorphBack: (Morph new extent: 4 px @ 1 px; color: Color transparent). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). r addMorphBack: (self buttonName: 'Trim' translated action: #trim). + r addMorphBack: (Morph new extent: 4 px @ 1 px; color: Color transparent). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). r addMorphBack: (self buttonName: 'Show' translated action: #showEditor). self addMorphBack: r. r layoutChanged. fullWidth := r fullBounds width. + - r := AlignmentMorph newRow vResizing: #shrinkWrap. r addMorphBack: (self buttonName: 'Record' translated action: #record). + r addMorphBack: (Morph new extent: 4 px @ 1 px; color: Color transparent). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). r addMorphBack: (self buttonName: 'Stop' translated action: #stop). + r addMorphBack: (Morph new extent: 4 px @ 1 px; color: Color transparent). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). r addMorphBack: (self buttonName: 'Play' translated action: #playback). + r addMorphBack: (Morph new extent: 4 px @ 1 px; color: Color transparent). - r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent). r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec). r addMorphBack: self makeStatusLight. self addMorphBack: r. Smalltalk at: #OggSpeexCodec ifPresent: [:c | self changeCodec: c name: 'Speex']. r layoutChanged. fullWidth := fullWidth max: r fullBounds width. + ^ fullWidth @ r fullBounds height! - ^ fullWidth@(r fullBounds height). - ! Item was removed: - ----- Method: RecordingControlsMorph>>addRecordLevelSlider (in category 'other') ----- - addRecordLevelSlider - - | levelSlider r | - levelSlider := SimpleSliderMorph new - color: color; - extent: 100 at 2; - target: recorder; - actionSelector: #recordLevel:; - adjustToValue: recorder recordLevel. - r := AlignmentMorph newRow - color: color; - layoutInset: 0; - wrapCentering: #center; cellPositioning: #leftCenter; - hResizing: #shrinkWrap; - vResizing: #rigid; - height: 24. - r addMorphBack: (StringMorph contents: '0 '). - r addMorphBack: levelSlider. - r addMorphBack: (StringMorph contents: ' 10'). - self addMorphBack: r. - ! Item was changed: ----- Method: RecordingControlsMorph>>addRecordLevelSliderIn: (in category 'other') ----- addRecordLevelSliderIn: aPoint | levelSlider r | + (levelSlider := SimpleSliderMorph new) - levelSlider := SimpleSliderMorph new color: color darker; + sliderColor: Color gray; + extent: (aPoint x * 0.75) asInteger @ (aPoint y * 0.6) asInteger; + minimumExtent: levelSlider extent; - extent: (aPoint x * 0.75) asInteger@(aPoint y*0.6) asInteger; target: recorder; actionSelector: #recordLevel:; + orientation: #horizontal; adjustToValue: recorder recordLevel. r := AlignmentMorph newRow color: color; layoutInset: 0; wrapCentering: #center; cellPositioning: #leftCenter; hResizing: #shrinkWrap; vResizing: #rigid; + height: aPoint y + 2 px. + r addMorphBack: (StringMorph contents: '0 ' font: TextStyle defaultFont). - height: aPoint y + 2. - r addMorphBack: (StringMorph contents: '0 ' font: Preferences standardButtonFont). r addMorphBack: levelSlider. + r addMorphBack: (StringMorph contents: ' 10' font: TextStyle defaultFont). + self addMorphBack: r.! - r addMorphBack: (StringMorph contents: ' 10' font: Preferences standardButtonFont). - self addMorphBack: r. - ! Item was changed: ----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') ----- buttonName: aString action: aSymbol ^ SimpleButtonMorph new target: self; + label: aString; - label: aString font: Preferences standardButtonFont; actionSelector: aSymbol ! Item was changed: ----- Method: RecordingControlsMorph>>initialize (in category 'initialization') ----- initialize | r full | super initialize. self hResizing: #shrinkWrap; vResizing: #shrinkWrap. + self borderWidth: 2 px. - self borderWidth: 2. self listDirection: #topToBottom. recorder := SoundRecorder new. full := self addButtonRows. self addRecordLevelSliderIn: full. r := AlignmentMorph newRow vResizing: #shrinkWrap. r addMorphBack: (self makeRecordMeterIn: full). self addMorphBack: r. + self extent: 10 @ 10. "make minimum size"! - self extent: 10 at 10. "make minimum size" - ! Item was removed: - ----- Method: RecordingControlsMorph>>makeRecordMeter (in category 'other') ----- - makeRecordMeter - - | outerBox | - outerBox := Morph new extent: 102 at 18; color: Color gray. - recordMeter := Morph new extent: 1 at 16; color: Color yellow. - recordMeter position: outerBox topLeft + (1 at 1). - outerBox addMorph: recordMeter. - ^ outerBox - ! Item was changed: ----- Method: RecordingControlsMorph>>makeRecordMeterIn: (in category 'other') ----- makeRecordMeterIn: aPoint | outerBox h | h := (aPoint y * 0.6) asInteger. + outerBox := Morph new extent: aPoint x asInteger @ h; color: Color gray. + recordMeter := Morph new extent: 1 px @ h; color: Color yellow. + recordMeter position: outerBox topLeft + (1 px @ 1 px). - outerBox := Morph new extent: (aPoint x) asInteger at h; color: Color gray. - recordMeter := Morph new extent: 1 at h; color: Color yellow. - recordMeter position: outerBox topLeft + (1 at 1). outerBox addMorph: recordMeter. + ^ outerBox! - ^ outerBox - ! Item was changed: ----- Method: ScorePlayerMorph>>defaultBorderWidth (in category 'initialization') ----- defaultBorderWidth "answer the default border width for the receiver" + ^ 2 px! - ^ 2! Item was changed: ----- 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 px; - layoutInset: 3; onScorePlayer: ScorePlayer new initialize; + extent: 20 px @ 20 px.! - extent: 20 @ 20 ! Item was changed: ----- 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 px @ 5 px; - extent: 5 at 5; addMorph: (StringMorph contents: '[pause]' translated) lock; addMouseUpActionWith: ( MessageSend receiver: self selector: #showResumeButtonInTheWorld ). evt hand attachMorph: newWidget.! 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 px @ 5 px. - r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. bb := SimpleButtonMorph new target: self; borderColor: #raised; + borderWidth: 2 px; color: color. - borderWidth: 2; color: color. r addMorphBack: (bb label: 'Menu' translated; actWhen: #buttonDown; actionSelector: #invokeMenu). bb := SimpleButtonMorph new target: self; borderColor: #raised; + borderWidth: 2 px; color: color. - borderWidth: 2; color: color. r addMorphBack: (bb label: 'Piano Roll' translated; actionSelector: #makePianoRoll). bb := SimpleButtonMorph new target: self; borderColor: #raised; + borderWidth: 2 px; color: color. - borderWidth: 2; color: color. r addMorphBack: (bb label: 'Rewind' translated; actionSelector: #rewind). bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; + borderWidth: 2 px; color: color. - borderWidth: 2; color: color. r addMorphBack: (bb label: 'Play' translated; actionSelector: #resumePlaying). bb := SimpleButtonMorph new target: scorePlayer; borderColor: #raised; + borderWidth: 2 px; color: color. - 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 px; - 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 px; - borderWidth: 2; label: 'Repeat' translated; actionSelector: #repeat:; target: scorePlayer; setSwitchState: scorePlayer repeat. r addMorphBack: repeatSwitch]. + ^ r! - ^ r - ! Item was changed: ----- 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 px @ 0) color: Color transparent); - addMorphBack: (Morph newBounds: (0 at 0 extent: 20 at 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 px @ 1 px; - extent: 10 at 1; layoutInset: 0; + borderStyle: (BorderStyle raised width: 1 px); - borderStyle: (BorderStyle raised width: 1); 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].! - scorePlayer openMIDIPort: LastMIDIPort]. - ! Item was changed: ----- 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 px @ 6 px; + minWidth: 101 px; - extent: 101 at 6; target: scorePlayer; arguments: (Array with: trackIndex); actionSelector: #volumeForTrack:put:; + orientation: #horizontal; minVal: 0.0; maxVal: 1.0; adjustToValue: (scorePlayer volumeForTrack: trackIndex). panSlider := SimpleSliderMorph new color: color; sliderColor: pianoRollColor; + extent: 101 px @ 6 px; + minWidth: 101 px; - extent: 101 at 6; target: scorePlayer; arguments: (Array with: trackIndex); actionSelector: #panForTrack:put:; + orientation: #horizontal; 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 px @ (panSlider height - 4 px); + position: panSlider center x @ (panSlider top + 2 px). - 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! - ^ c - ! Item was changed: ----- Method: ScorePlayerMorph>>rateControl (in category 'layout') ----- rateControl | rateSlider middleLine r | rateSlider := SimpleSliderMorph new color: color; sliderColor: Color gray; + extent: 180 px @ 12 px; - extent: 180 at 12; target: self; actionSelector: #setLogRate:; + orientation: #horizontal; 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 px @ (rateSlider height - 4 px); + position: rateSlider center x @ (rateSlider top + 2 px). - extent: 1@(rateSlider height - 4); - position: rateSlider center x@(rateSlider top + 2). rateSlider addMorphBack: middleLine. r := self makeRow hResizing: #spaceFill; vResizing: #rigid; + height: 24 px. - height: 24. r addMorphBack: (StringMorph contents: 'slow ' translated). r addMorphBack: rateSlider. r addMorphBack: (StringMorph contents: ' fast' translated). + ^ r! - ^ r - ! Item was changed: ----- Method: ScorePlayerMorph>>scrollControl (in category 'layout') ----- scrollControl | r | scrollSlider := SimpleSliderMorph new color: color; sliderColor: Color gray; + extent: 360 px @ 12 px; - extent: 360 at 12; target: scorePlayer; + orientation: #horizontal; actionSelector: #positionInScore:; adjustToValue: scorePlayer positionInScore. r := self makeRow hResizing: #spaceFill; vResizing: #rigid; + height: 24 px. - height: 24. r addMorphBack: (StringMorph contents: 'start ' translated). r addMorphBack: scrollSlider. r addMorphBack: (StringMorph contents: ' end' translated). + ^ r! - ^ r - ! Item was changed: ----- 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 px @ 5 px; color: color). "spacer" - r addMorphBack: (Morph new extent: 10 at 5; color: color). "spacer" r addMorphBack: (self panAndVolControlsFor: trackIndex). + ^ r! - ^ r - ! Item was changed: ----- 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 px @ 14 px; - extent: 95 at 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. - pianoRollColor := (Color wheel: scorePlayer score tracks size) at: trackIndex. r := self makeRow hResizing: #spaceFill; vResizing: #spaceFill; + extent: 70 px @ 10 px. - extent: 70 at 10. r addMorphBack: ((StringMorph contents: trackIndex printString + font: (TextStyle defaultFont asPointSize: TextStyle defaultFont pointSize * 1.57)) color: pianoRollColor). - font: (TextStyle default fontOfSize: 24)) color: pianoRollColor). trackIndex < 10 + ifTrue: [r addMorphBack: (Morph new color: color; extent: 19 px @ 8 px)] "spacer" + ifFalse: [r addMorphBack: (Morph new color: color; extent: 8 px @ 8 px)]. "spacer" - ifTrue: [r addMorphBack: (Morph new color: color; extent: 19 at 8)] "spacer" - ifFalse: [r addMorphBack: (Morph new color: color; extent: 8 at 8)]. "spacer" r addMorphBack: (StringMorph new + extent: 80 px @ 14 px; - extent: 80 at 14; contentsClipped: (scorePlayer infoForTrack: trackIndex)). + r addMorphBack: (Morph new color: color; extent: 8 px @ 8 px). "spacer" - r addMorphBack: (Morph new color: color; extent: 8 at 8). "spacer" r addMorphBack: instSelector. r addMorphBack: (AlignmentMorph newRow color: color). "spacer" r addMorphBack: muteButton. + ^ r! - ^ r - ! Item was changed: ----- Method: ScorePlayerMorph>>volumeControl (in category 'layout') ----- volumeControl | volumeSlider r | volumeSlider := SimpleSliderMorph new color: color; sliderColor: Color gray; + extent: 80 px @ 12 px; - extent: 80 at 12; target: scorePlayer; + orientation: #horizontal; actionSelector: #overallVolume:; adjustToValue: scorePlayer overallVolume. r := self makeRow hResizing: #spaceFill; vResizing: #rigid; + height: 24 px. - height: 24. r addMorphBack: (StringMorph contents: 'soft ' translated). r addMorphBack: volumeSlider. r addMorphBack: (StringMorph contents: ' loud' translated). + ^ r! - ^ r - ! Item was changed: ----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') ----- setStandardDefaultMetrics "Provide the current choices for min.max width/height for thumbnails" + self maxWidth: 60 px minHeight: 32 px. + self setProperty: #minimumWidth toValue: 16 px.! - self maxWidth: 60 minHeight: 32. - self setProperty: #minimumWidth toValue: 16!
More information about the Squeak-dev mailing list |