[squeak-dev] The Trunk: MorphicExtras-mt.235.mczcommits at source.squeak.org commits at source.squeak.orgSun May 6 13:10:21 UTC 2018
Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-mt.235.mcz ==================== Summary ==================== Name: MorphicExtras-mt.235 Author: mt Time: 6 May 2018, 3:10:08.770836 pm UUID: 7bbc63fd-940b-b045-bd7f-762404cede6d Ancestors: MorphicExtras-kfr.234 Supplement to refactoring in Morphic-mt.1427. =============== Diff against MorphicExtras-kfr.234 =============== Item was changed: ----- Method: BasicButton>>label: (in category 'as yet unclassified') ----- label: aString | oldLabel m | (oldLabel := self findA: StringMorph) ifNotNil: [oldLabel delete]. m := StringMorph contents: aString font: TextStyle defaultFont. + self extent: m extent + (self borderWidth + 6). - self extent: m extent + (borderWidth + 6). m position: self center - (m extent // 2). self addMorph: m. m lock! Item was changed: ----- Method: BookMorph>>bookmarkForThisPage (in category 'menu') ----- bookmarkForThisPage "If this book exists on a server, make the reference via a URL" | bb url um | (url := self url) ifNil: [ bb := SimpleButtonMorph new target: self. bb actionSelector: #goToPageMorph:fromBookmark:. bb label: 'Bookmark' translated. bb arguments: (Array with: currentPage with: bb). self primaryHand attachMorph: bb. ^ bb]. currentPage url ifNil: [currentPage saveOnURLbasic]. um := URLMorph newForURL: currentPage url. um setURL: currentPage url page: currentPage sqkPage. (SqueakPage stemUrl: url) = (SqueakPage stemUrl: currentPage url) ifTrue: [um book: true] ifFalse: [um book: url]. "remember which book" um isBookmark: true; label: 'Bookmark' translated. + um borderStyle: (BorderStyle raised width: 1). - um borderWidth: 1; borderColor: #raised. um color: (Color r: 0.4 g: 0.8 b: 0.6). self primaryHand attachMorph: um. ^ um! Item was changed: ----- Method: BorderedMorph>>fullPrintOn: (in category '*MorphicExtras-printing') ----- fullPrintOn: aStream aStream nextPutAll: '('. super fullPrintOn: aStream. + aStream nextPutAll: ') setBorderWidth: '; print: self borderWidth; + nextPutAll: ' borderColor: ' , (self colorString: self borderColor)! - aStream nextPutAll: ') setBorderWidth: '; print: borderWidth; - nextPutAll: ' borderColor: ' , (self colorString: borderColor)! Item was changed: ----- Method: EmbeddedWorldBorderMorph>>genericBoxArea: (in category 'boxes') ----- genericBoxArea: countDownFromTop + ^self innerBounds right @ (self top + (countDownFromTop * 2 * self borderWidth)) + extent: self borderWidth asPoint - ^self innerBounds right @ (self top + (countDownFromTop * 2 * borderWidth)) - extent: borderWidth @ borderWidth ! Item was changed: ----- Method: EmbeddedWorldBorderMorph>>myWorldChanged (in category 'as yet unclassified') ----- myWorldChanged | trans | trans := self myTransformation. self changed. self layoutChanged. trans ifNotNil:[ trans extentFromParent: self innerBounds extent. + bounds := self bounds topLeft extent: trans extent + (self borderWidth * 2). - bounds := bounds topLeft extent: trans extent + (borderWidth * 2). ]. self changed. ! Item was changed: ----- Method: EnvelopeLineMorph>>vertices:borderWidth:borderColor: (in category 'initialization') ----- vertices: verts borderWidth: bw borderColor: bc super initialize. vertices := verts. + self borderWidth: bw. + self borderColor: bc. + - borderWidth := bw. - borderColor := bc. closed := false. arrows := #none. self computeBounds! Item was changed: ----- Method: EventRecorderMorph>>defaultBorderColor (in category 'initialization') ----- defaultBorderColor + ^ Color transparent! - "answer the default border color/fill style for the receiver" - ^ #raised! Item was added: + ----- Method: EventRecorderMorph>>defaultBorderStyle (in category 'initialization') ----- + defaultBorderStyle + ^ BorderStyle raised! Item was changed: ----- Method: FlapTab>>assumeString:font:orientation:color: (in category 'textual tabs') ----- assumeString: aString font: aFont orientation: orientationSymbol color: aColor | aTextMorph workString tabStyle | labelString := aString asString. workString := orientationSymbol == #vertical ifTrue: [String streamContents: [:s | labelString do: [:c | s nextPut: c] separatedBy: [s nextPut: Character cr]]] ifFalse: [labelString]. tabStyle := (TextStyle new) leading: 0; newFontArray: (Array with: aFont). aTextMorph := (TextMorph new setTextStyle: tabStyle) contents: (workString asText addAttribute: (TextKern kern: 3)). self removeAllMorphs. + self borderStyle: (BorderStyle raised width: 2). - self - borderWidth: 2; - borderColor: #raised. aColor ifNotNil: [self color: aColor]. self addMorph: aTextMorph centered. aTextMorph lock " FlapTab allSubInstancesDo: [:ft | ft reformatTextualTab] "! Item was changed: ----- Method: Flaps class>>paintFlapButton (in category 'miscellaneous') ----- paintFlapButton "Answer a button to serve as the paint flap" | pb oldArgs brush myButton m | pb := PaintBoxMorph new submorphNamed: #paint:. pb ifNil: [(brush := Form extent: 16 at 16 depth: 16) fillColor: Color red] ifNotNil: [oldArgs := pb arguments. brush := oldArgs third. brush := brush copy: (2 at 0 extent: 42 at 38). brush := brush scaledToSize: brush extent // 2]. myButton := BorderedMorph new. + myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderStyle: (BorderStyle raised width: 2). - myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderWidth: 2; borderColor: #raised. myButton addMorph: (m := brush asMorph lock). myButton extent: m extent + (myButton borderWidth + 6). m position: myButton center - (m extent // 2). ^ myButton ! Item was changed: ----- Method: GradientFillMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self borderWidth: 0. - borderWidth := 0. fillColor2 := Color black. gradientDirection := #vertical! Item was changed: ----- Method: GraphMorph>>centerCursor (in category 'commands') ----- centerCursor "Scroll so that the cursor is as close as possible to the center of my window." | w | + w := self width - (2 * self borderWidth). - w := self width - (2 * borderWidth). self startIndex: ((cursor - (w // 2)) max: 1). ! Item was changed: ----- Method: GraphMorph>>drawDataOn: (in category 'private') ----- drawDataOn: aCanvas | yScale baseLine x start end value left top bottom right | super drawOn: aCanvas. data isEmpty ifTrue: [^ self]. maxVal = minVal ifTrue: [ yScale := 1. ] ifFalse: [ + yScale := (self bounds height - (2 * self borderWidth)) asFloat / (maxVal - minVal)]. + baseLine := self bounds bottom - self borderWidth + (minVal * yScale) truncated. - yScale := (bounds height - (2 * borderWidth)) asFloat / (maxVal - minVal)]. - baseLine := bounds bottom - borderWidth + (minVal * yScale) truncated. left := top := 0. right := 10. bottom := 0. + x := self bounds left + self borderWidth. - x := bounds left + borderWidth. start := (startIndex asInteger max: 1) min: data size. + end := (start + self bounds width) min: data size. - end := (start + bounds width) min: data size. start to: end do: [:i | left := x truncated. right := x + 1. + right > (self bounds right - self borderWidth) ifTrue: [^ self]. - right > (bounds right - borderWidth) ifTrue: [^ self]. value := (data at: i) asFloat. value >= 0.0 ifTrue: [ top := baseLine - (yScale * value) truncated. bottom := baseLine. ] ifFalse: [ top := baseLine. bottom := baseLine - (yScale * value) truncated]. aCanvas fillRectangle: (left at top corner: right at bottom) color: dataColor. x := x + 1]. ! Item was changed: ----- Method: GraphMorph>>keepIndexInView: (in category 'private') ----- keepIndexInView: index | w newStart | + w := self bounds width - (2 * self borderWidth). - w := bounds width - (2 * borderWidth). index < startIndex ifTrue: [ newStart := index - w + 1. ^ self startIndex: (newStart max: 1)]. index > (startIndex + w) ifTrue: [ ^ self startIndex: (index min: data size)]. ! Item was changed: ----- Method: GraphMorph>>mouseMove: (in category 'event handling') ----- mouseMove: evt | x w | + x := evt cursorPoint x - (self bounds left + self borderWidth). + w := self width - (2 * self borderWidth). - x := evt cursorPoint x - (bounds left + borderWidth). - w := self width - (2 * borderWidth). self changed. x < 0 ifTrue: [ cursor := startIndex + (3 * x). cursor := (cursor max: 1) min: data size. ^ self startIndex: cursor]. x > w ifTrue: [ cursor := startIndex + w + (3 * (x - w)). cursor := (cursor max: 1) min: data size. ^ self startIndex: cursor - w]. cursor := ((startIndex + x) max: 1) min: data size. ! Item was changed: ----- Method: KeyboardMorphForInput>>addRecordingControls (in category 'initialization') ----- addRecordingControls | button switch playRow durRow articRow modRow | "Add chord, rest and delete buttons" playRow := AlignmentMorph newRow. playRow color: color; borderWidth: 0; layoutInset: 0. playRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. playRow addMorphBack: (switch label: 'chord' translated; actionSelector: #buildChord:). button := SimpleButtonMorph new target: self; + borderStyle: (BorderStyle raised width: 2); color: color. - borderColor: #raised; borderWidth: 2; color: color. playRow addMorphBack: (button label: ' rest ' translated; actionSelector: #emitRest). button := SimpleButtonMorph new target: self; + borderStyle: (BorderStyle raised width: 2); color: color. - borderColor: #raised; borderWidth: 2; color: color. playRow addMorphBack: (button label: 'del' translated; actionSelector: #deleteNotes). self addMorph: playRow. playRow align: playRow fullBounds topCenter with: self fullBounds bottomCenter. "Add note duration buttons" durRow := AlignmentMorph newRow. durRow color: color; borderWidth: 0; layoutInset: 0. durRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'whole' translated; actionSelector: #duration:onOff:; arguments: #(1)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'half' translated; actionSelector: #duration:onOff:; arguments: #(2)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'quarter' translated; actionSelector: #duration:onOff:; arguments: #(4)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'eighth' translated; actionSelector: #duration:onOff:; arguments: #(8)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. durRow addMorphBack: (switch label: 'sixteenth' translated; actionSelector: #duration:onOff:; arguments: #(16)). self addMorph: durRow. durRow align: durRow fullBounds topCenter with: playRow fullBounds bottomCenter. "Add note duration modifier buttons" modRow := AlignmentMorph newRow. modRow color: color; borderWidth: 0; layoutInset: 0. modRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. modRow addMorphBack: (switch label: 'dotted' translated; actionSelector: #durMod:onOff:; arguments: #(dotted)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. modRow addMorphBack: (switch label: 'normal' translated; actionSelector: #durMod:onOff:; arguments: #(normal)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. modRow addMorphBack: (switch label: 'triplets' translated; actionSelector: #durMod:onOff:; arguments: #(triplets)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. modRow addMorphBack: (switch label: 'quints' translated; actionSelector: #durMod:onOff:; arguments: #(quints)). self addMorph: modRow. modRow align: modRow fullBounds topCenter with: durRow fullBounds bottomCenter. "Add articulation buttons" articRow := AlignmentMorph newRow. articRow color: color; borderWidth: 0; layoutInset: 0. articRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5. switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. articRow addMorphBack: (switch label: 'legato' translated; actionSelector: #articulation:onOff:; arguments: #(legato)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. articRow addMorphBack: (switch label: 'normal' translated; actionSelector: #articulation:onOff:; arguments: #(normal)). switch := SimpleSwitchMorph new target: self; borderWidth: 2; offColor: color; onColor: (Color r: 1.0 g: 0.6 b: 0.6); setSwitchState: false. articRow addMorphBack: (switch label: 'staccato' translated; actionSelector: #articulation:onOff:; arguments: #(staccato)). self addMorph: articRow. articRow align: articRow fullBounds topCenter with: modRow fullBounds bottomCenter. + self bounds: (self fullBounds expandBy: (0 at 0 extent: 0 @ self borderWidth)) - self bounds: (self fullBounds expandBy: (0 at 0 extent: 0 at borderWidth)) ! Item was changed: ----- Method: MagnifierMorph>>defaultExtent (in category 'geometry') ----- defaultExtent + ^(srcExtent * magnification) truncated + (2 * self borderWidth)! - ^(srcExtent * magnification) truncated + (2 * borderWidth)! Item was changed: ----- Method: MagnifierMorph>>extent: (in category 'geometry') ----- extent: aPoint "Round to multiples of magnification" + srcExtent := (aPoint - (2 * self borderWidth)) // magnification. - srcExtent := (aPoint - (2 * borderWidth)) // magnification. ^super extent: self defaultExtent! Item was changed: ----- Method: PianoKeyboardMorph>>buildKeyboard (in category 'simple keyboard') ----- buildKeyboard | wtWid bkWid keyRect octavePt nWhite nBlack | self removeAllMorphs. wtWid := 8. bkWid := 5. self extent: 10 @ 10. 1 to: nOctaves + 1 do: [:i | i <= nOctaves ifTrue: [nWhite := 7. nBlack := 5] ifFalse: [nWhite := 1. nBlack := 0 "High C"]. octavePt := self innerBounds topLeft + ((7 * wtWid * (i - 1) - 1) @ -1). 1 to: nWhite do: [:j | keyRect := octavePt + (j - 1 * wtWid @ 0) extent: (wtWid + 1) @ 36. self addMorph: ((RectangleMorph newBounds: keyRect color: whiteKeyColor) borderWidth: 1; on: #mouseDown send: #mouseDownPitch:event:noteMorph: to: self withValue: i - 1 * 12 + (#(1 3 5 6 8 10 12) at: j))]. 1 to: nBlack do: [:j | keyRect := octavePt + ((#(6 15 29 38 47) at: j) @ 1) extent: bkWid @ 21. self addMorph: ((Morph newBounds: keyRect color: blackKeyColor) on: #mouseDown send: #mouseDownPitch:event:noteMorph: to: self withValue: i - 1 * 12 + (#(2 4 7 9 11) at: j))]]. self submorphsDo: [:m | m on: #mouseMove send: #mouseMovePitch:event:noteMorph: to: self; on: #mouseUp send: #mouseUpPitch:event:noteMorph: to: self; on: #mouseEnterDragging send: #mouseDownPitch:event:noteMorph: to: self; on: #mouseLeaveDragging send: #mouseUpPitch:event:noteMorph: to: self]. + self extent: (self fullBounds extent + self borderWidth - 1)! - self extent: (self fullBounds extent + borderWidth - 1)! 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. - rightEdge := self right - borderWidth. rightEdgeTime := self timeForX: rightEdge. + topEdge := self top + self borderWidth + 1. - topEdge := self top + borderWidth + 1. "Add ambient morphs first (they will be front-most)" score eventMorphsWithTimeDo: [:m :t | m addMorphsTo: visibleMorphs pianoRoll: self eventTime: t betweenTime: leftEdgeTime and: rightEdgeTime]. "Then add note morphs" score tracks withIndexDo: [:track :trackIndex | | done n i nRight nTop nLeft trackColor | trackColor := colorForTrack at: trackIndex. i := indexInTrack at: trackIndex. done := scorePlayer mutedForTrack: trackIndex. [done | (i > track size)] whileFalse: [ n := track at: i. (n isNoteEvent and: [n midiKey >= lowestNote]) ifTrue: [ n time > rightEdgeTime ifTrue: [done := true] ifFalse: [ nLeft := self xForTime: n time. nTop := (self yForMidiKey: n midiKey) - 1. nTop > topEdge ifTrue: [ nRight := nLeft + (n duration * timeScale) truncated - 1. visibleMorphs add: ((PianoRollNoteMorph newBounds: (nLeft 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 at 1) color: Color red]. visibleMorphs addFirst: cursor. self changed. self removeAllMorphs. 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) - to: ((self timeForX: self right - borderWidth) truncateTo: ticksPerMeas) by: ticksPerMeas do: [:tickTime | x := self xForTime: tickTime. aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height) color: measureLineColor]]. showMeasureLines ifTrue: [measureLineColor := Color gray: 0.7. ticksPerMeas := beatsPerMeasure*score ticksPerQuarterNote*4//notePerBeat. inner := self innerBounds. (leftEdgeTime + ticksPerMeas truncateTo: ticksPerMeas) + to: ((self timeForX: self right - self borderWidth) truncateTo: ticksPerMeas) - to: ((self timeForX: self right - borderWidth) truncateTo: ticksPerMeas) by: ticksPerMeas do: [:tickTime | x := self xForTime: tickTime. aCanvas fillRectangle: (x @ inner top extent: 1 @ inner height) color: (tickTime = 0 ifTrue: [Color black] ifFalse: [measureLineColor])]]. ! Item was changed: ----- Method: PianoRollScoreMorph>>drawStaffOn: (in category 'drawing') ----- drawStaffOn: aCanvas | blackKeyColor l r topEdge y | self drawMeasureLinesOn: aCanvas. blackKeyColor := Color gray: 0.5. + l := self left + self borderWidth. + r := self right - self borderWidth. + topEdge := self top + self borderWidth + 3. - l := self left + borderWidth. - r := self right - borderWidth. - topEdge := self top + borderWidth + 3. lowestNote to: 127 do: [:k | y := self yForMidiKey: k. y <= topEdge ifTrue: [^ self]. "over the top!!" (self isBlackKey: k) ifTrue: [ aCanvas fillRectangle: (l at y corner: r@(y + 1)) color: blackKeyColor]]. ! Item was changed: ----- Method: PianoRollScoreMorph>>midiKeyForY: (in category 'geometry') ----- midiKeyForY: y + ^ lowestNote - ((y - (bounds bottom - self borderWidth - 4)) // 3) - ^ lowestNote - ((y - (bounds bottom - borderWidth - 4)) // 3) ! Item was changed: ----- Method: PianoRollScoreMorph>>moveCursorToTime: (in category 'scrolling') ----- moveCursorToTime: scoreTime | cursorOffset desiredCursorHeight | scorePlayer isPlaying ifTrue: [cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger. (cursorOffset < 0 or: [cursorOffset > (self width-20)]) ifTrue: [self goToTime: scoreTime - (20/timeScale). cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]] ifFalse: [self goToTime: (scoreTime - (self width//2 / timeScale) max: (self width//10 / timeScale) negated). cursorOffset := ((scoreTime - leftEdgeTime) asFloat * timeScale) asInteger]. + cursor position: (self left + self borderWidth + cursorOffset)@(self top + self borderWidth). - cursor position: (self left + borderWidth + cursorOffset)@(self top + borderWidth). desiredCursorHeight := self height. cursor height ~= desiredCursorHeight ifTrue: [cursor extent: 1 at desiredCursorHeight]. ! Item was changed: ----- Method: PianoRollScoreMorph>>timeForX: (in category 'geometry') ----- timeForX: aNumber + ^ ((aNumber - self left - self borderWidth) asFloat / timeScale + leftEdgeTime) asInteger! - ^ ((aNumber - bounds left - borderWidth) asFloat / timeScale + leftEdgeTime) asInteger! Item was changed: ----- Method: PianoRollScoreMorph>>xForTime: (in category 'geometry') ----- xForTime: aNumber + ^ ((aNumber - leftEdgeTime) asFloat * timeScale) asInteger + self left + self borderWidth - ^ ((aNumber - leftEdgeTime) asFloat * timeScale) asInteger + bounds left + borderWidth ! Item was changed: ----- Method: PianoRollScoreMorph>>yForMidiKey: (in category 'geometry') ----- yForMidiKey: midiKey + ^ (self bottom - self borderWidth - 4) - (3 * (midiKey - lowestNote)) - ^ (bounds bottom - borderWidth - 4) - (3 * (midiKey - lowestNote)) ! Item was changed: ----- Method: ProjectNavigationMorph>>buttonLanguage (in category 'the buttons') ----- buttonLanguage "Answer a button for finding/loading projects" ^ SimpleButtonDelayedMenuMorph new target: self; + borderStyle: BorderStyle raised; - borderColor: #raised; color: self colorForButtons; label: Project current naturalLanguage font: self fontForButtons; setBalloonText: 'Click here to choose your language.' translated; actionSelector: #chooseLanguage! Item was changed: ----- Method: ProjectNavigationMorph>>buttonSound (in category '*MorphicExtras-Sound') ----- buttonSound | myButton m | myButton := RectangleMorph new - borderWidth: 1; cornerStyle: #rounded; + borderStyle: (BorderStyle raised width: 1); - borderColor: #raised; color: self colorForButtons; setBalloonText: 'Change sound volume' translated; on: #mouseDown send: #soundDownEvt:morph: to: self; on: #mouseStillDown send: #soundStillDownEvt:morph: to: self; on: #mouseUp send: #soundUpEvt:morph: to: self; yourself. myButton addMorph: (m := self speakerIcon lock). myButton extent: m extent + (myButton borderWidth + 6). m position: myButton center - (m extent // 2). ^myButton ! Item was changed: ----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') ----- makeButton: aString balloonText: anotherString for: aSymbol ^ SimpleButtonDelayedMenuMorph new target: self; + borderStyle: BorderStyle raised; - borderColor: #raised; color: self colorForButtons; label: aString font: self fontForButtons; setBalloonText: anotherString; actionSelector: aSymbol! Item was changed: ----- Method: ProjectNavigationMorph>>makeUpdatingButtonWithBalloonText:actionSelector:wordingSelector: (in category 'as yet unclassified') ----- makeUpdatingButtonWithBalloonText: balloonString actionSelector: actionSymbol wordingSelector: wordingSymbol "Answer a button whose target is the receiver (i.e. a ProjectNavigationMorph), who gets its wording by sending the wordingSelector to me. The given string" | aButton | aButton := UpdatingSimpleButtonMorph new. aButton target: self; + borderStyle: BorderStyle raised; - borderColor: #raised; color: self colorForButtons; label: '-' font: self fontForButtons; setBalloonText: balloonString translated; actionSelector: actionSymbol; wordingSelector: wordingSymbol. aButton step. ^ aButton ! Item was changed: ----- Method: ProjectNavigationMorph>>soundDownEvt:morph: (in category '*MorphicExtras-Sound') ----- soundDownEvt: a morph: b soundSlider ifNotNil: [soundSlider delete]. (soundSlider := RectangleMorph new) setProperty: #morphicLayerNumber toValue: 1; extent: b width @ (b width * 3); color: self colorForButtons; + borderStyle: BorderStyle raised; - borderColor: #raised; bottomLeft: b boundsInWorld origin. soundSlider addMorph: ( RectangleMorph new color: self colorForButtons; borderColor: #raised; extent: b width @ 8; center: soundSlider center x @ (soundSlider bottom - (soundSlider height * self getSoundVolume) asInteger) ). soundSlider openInWorld.! Item was changed: ----- Method: RecordingControlsMorph>>initialize (in category 'initialization') ----- initialize | r full | super initialize. self hResizing: #shrinkWrap; vResizing: #shrinkWrap. + self borderWidth: 2. - 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 at 10. "make minimum size" ! Item was changed: ----- Method: ReferenceMorph>>preserveDetails (in category 'menu') ----- preserveDetails "The receiver is being switched to use a different format. Preserve the existing details (e.g. wording if textual, grapheme if graphical) so that if the user reverts back to the current format, the details will be right" self isCurrentlyTextual ifTrue: [self setProperty: #priorWording toValue: self existingWording. + self setProperty: #priorColor toValue: self color. + self setProperty: #priorBorderWidth toValue: self borderWidth] - self setProperty: #priorColor toValue: color. - self setProperty: #priorBorderWidth toValue: borderWidth] ifFalse: + [self setProperty: #priorGraphic toValue: self firstSubmorph form]! - [self setProperty: #priorGraphic toValue: submorphs first form]! 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 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 at 1; - borderWidth: 1; layoutInset: 0; + borderStyle: (BorderStyle raised width: 1); - 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 changed: ----- 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 at 5. r addMorphBack: ( SimpleButtonMorph new target: [ scorePlayer resumePlaying. r delete ]; + borderStyle: (BorderStyle raised width: 2); - borderColor: #raised; - borderWidth: 2; color: Color green; label: 'Continue' translated; actionSelector: #value ). r setBalloonText: 'Continue playing a paused presentation' translated. ^r ! Item was changed: ----- Method: SimpleSwitchMorph>>initializeWithLabel: (in category 'initialization') ----- initializeWithLabel: labelString super initializeWithLabel: labelString. self borderWidth: 3. self extent: self extent + 2. onColor := Color r: 1.0 g: 0.6 b: 0.6. offColor := Color lightGray. + + self turnOff.! - color := offColor - ! Item was changed: ----- Method: SimpleSwitchMorph>>turnOff (in category 'switching') ----- turnOff + self borderRaised. - self borderColor: #raised. self color: offColor! Item was changed: ----- Method: SimpleSwitchMorph>>turnOn (in category 'switching') ----- turnOn + self borderInset. - self borderColor: #inset. self color: onColor! Item was changed: ----- Method: SoundLoopMorph>>buildSound (in category 'playing') ----- buildSound "Build a compound sound for the next iteration of the loop." | mixer soundMorphs | mixer := MixedSound new. + mixer add: (RestSound dur: (self width - (2 * self borderWidth)) / 128.0). - mixer add: (RestSound dur: (self width - (2 * borderWidth)) / 128.0). soundMorphs := self submorphs select: [:m | m respondsTo: #sound]. soundMorphs do: [:m | | startTime pan | + startTime := (m position x - (self left + self borderWidth)) / 128.0. + pan := (m position y - (self top + self borderWidth)) asFloat / (self height - (2 * self borderWidth) - m height). - startTime := (m position x - (self left + borderWidth)) / 128.0. - pan := (m position y - (self top + borderWidth)) asFloat / (self height - (2 * borderWidth) - m height). mixer add: ((RestSound dur: startTime), m sound copy) pan: pan]. ^ mixer ! Item was changed: ----- Method: TabSorterMorph>>initialize (in category 'initialization') ----- initialize "Initialize the receiver." super initialize. self removeAllMorphs. self extent: 300 at 100. pageHolder := PasteUpMorph new. pageHolder vResizeToFit: true; autoLineLayout: true. + pageHolder extent: self extent - self borderWidth. - pageHolder extent: self extent - borderWidth. pageHolder padding: 8. pageHolder cursor: 0. pageHolder wantsMouseOverHalos: false. self addControls. self addMorphBack: pageHolder! Item was changed: ----- Method: ThreadNavigationMorph>>makeButton:balloonText:for: (in category 'initialization') ----- makeButton: aString balloonText: anotherString for: aSymbol ^ SimpleButtonDelayedMenuMorph new target: self; + borderStyle: BorderStyle raised; - borderColor: #raised; color: self colorForButtons; label: aString translated font: self fontForButtons; setBalloonText: anotherString translated; actionSelector: aSymbol! Item was changed: ----- Method: TwoWayScrollPane>>createScrollBarNamed: (in category 'initialization') ----- createScrollBarNamed: aString "creates a scroll bar named as aString" | result | result := ScrollBar new model: self slotName: aString. + result borderStyle: (BorderStyle inset width: 2). - result borderWidth: 2; - borderColor: #inset. ^ result! Item was changed: ----- Method: TwoWayScrollPane>>defaultBorderColor (in category 'initialization') ----- defaultBorderColor + ^ Color transparent! - "answer the default border color/fill style for the receiver" - ^ #inset! Item was added: + ----- Method: TwoWayScrollPane>>defaultBorderStyle (in category 'initialization') ----- + defaultBorderStyle + ^ BorderStyle inset! Item was changed: ----- Method: TwoWayScrollPane>>fitContents (in category 'geometry') ----- fitContents "Adjust my size to fit my contents reasonably snugly" self extent: scroller submorphBounds extent + (yScrollBar width @ xScrollBar height) + + (self borderWidth*2) - + (borderWidth*2) ! Item was changed: ----- Method: URLMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas "Draw thumbnail for my page, if it is available. Otherwise, just draw a rectangle." + | thumbnail oldExt | + self color == Color transparent - | thumbnail oldExt | - color == Color transparent ifTrue: ["show thumbnail" thumbnail := self thumbnailOrNil. thumbnail + ifNil: [aCanvas frameRectangle: self bounds width: self borderWidth + color: self borderColor. + aCanvas fillRectangle: (self bounds insetBy: self borderWidth) color: self color] + ifNotNil: [oldExt := self bounds extent. + bounds := self bounds origin extent: thumbnail extent + (2 at 2). + aCanvas frameRectangle: self bounds width: self borderWidth color: self borderColor. + aCanvas paintImage: thumbnail at: self bounds origin + self borderWidth. - ifNil: [aCanvas frameRectangle: bounds width: borderWidth - color: borderColor. - aCanvas fillRectangle: (bounds insetBy: borderWidth) color: color] - ifNotNil: [oldExt := bounds extent. - bounds := bounds origin extent: thumbnail extent + (2 at 2). - aCanvas frameRectangle: bounds width: borderWidth color: borderColor. - aCanvas paintImage: thumbnail at: bounds origin + borderWidth. oldExt = thumbnail extent ifFalse: [self layoutChanged]]] ifFalse: ["show labeled button" ^ super drawOn: aCanvas] !
More information about the Squeak-dev mailing list |