[Pkg] The Trunk: Morphic-mt.845.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Apr 9 08:01:26 UTC 2015
Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.845.mcz
==================== Summary ====================
Name: Morphic-mt.845
Author: mt
Time: 9 April 2015, 10:00:54.492 am
UUID: a00b3fe0-199f-8a4b-956a-2368877bfbee
Ancestors: Morphic-mt.844
Speed-up when resizing scroll bars. They will not be re-initialized completely anymore.
Menu buttons work again, too.
=============== Diff against Morphic-mt.844 ===============
Item was changed:
Slider subclass: #ScrollBar
instanceVariableNames: 'menuButton upButton downButton pagingArea scrollDelta pageDelta interval menuSelector timeOfMouseDown timeOfLastScroll nextPageDirection currentScrollDelay'
+ classVariableNames: 'ArrowImagesCache BoxesImagesCache RoundedScrollBarLook ScrollBarsWithoutArrowButtons ScrollBarsWithoutMenuButton UpArrow UpArrow8Bit'
- classVariableNames: 'ArrowImagesCache BoxesImagesCache RoundedScrollBarLook ScrollBarsWithoutArrowButtons UpArrow UpArrow8Bit'
poolDictionaries: ''
category: 'Morphic-Windows'!
!ScrollBar commentStamp: '<historical>' prior: 0!
Inspired by an oiginal design of Hans-Martin Mosner, this ScrollBar is intended to exercise the handling of input events in Morphic. With sufficient flexibility in this area, all particular behavior can be concentrated in this single class with no need to specialize any other morphs to achieve button, slider and menu-button behavior.
Once we have this working, put in logic for horizontal operation as well.
CachedImages was added to reduce the number of forms created and thrown away. This will be helpful for Nebraska and others as well.!
Item was added:
+ ----- Method: ScrollBar class>>refreshAllScrollBars (in category 'class initialization') -----
+ refreshAllScrollBars
+
+ ScrollBar allSubInstances do: [:s |
+ s updateSlider].!
Item was changed:
----- Method: ScrollBar class>>scrollBarsWithoutArrowButtons: (in category 'preferences') -----
scrollBarsWithoutArrowButtons: aBoolean
+ ScrollBarsWithoutArrowButtons = aBoolean ifTrue: [^ self].
+ ScrollBarsWithoutArrowButtons := aBoolean.
+ self refreshAllScrollBars.!
- ScrollBarsWithoutArrowButtons := aBoolean.!
Item was added:
+ ----- Method: ScrollBar class>>scrollBarsWithoutMenuButton (in category 'preferences') -----
+ scrollBarsWithoutMenuButton
+
+ <preference: 'scrollBarsWithoutMenuButton'
+ category: #scrolling
+ description: 'If true, morphic scrollbars will not include a menu button.'
+ type: #Boolean>
+ ^ ScrollBarsWithoutMenuButton ifNil: [false]!
Item was added:
+ ----- Method: ScrollBar class>>scrollBarsWithoutMenuButton: (in category 'preferences') -----
+ scrollBarsWithoutMenuButton: aBoolean
+
+ ScrollBarsWithoutMenuButton = aBoolean ifTrue: [^ self].
+ ScrollBarsWithoutMenuButton := aBoolean.
+ self refreshAllScrollBars.!
Item was added:
+ ----- Method: ScrollBar>>boundsForDownButton (in category 'initialize') -----
+ boundsForDownButton
+
+ ^ self innerBounds bottomRight - self buttonExtent
+ extent: self buttonExtent!
Item was added:
+ ----- Method: ScrollBar>>boundsForMenuButton (in category 'initialize') -----
+ boundsForMenuButton
+
+ ^ self innerBounds topLeft extent: self buttonExtent!
Item was added:
+ ----- Method: ScrollBar>>boundsForUpButton (in category 'initialize') -----
+ boundsForUpButton
+
+ ^ (menuButton visible
+ ifFalse: [self innerBounds topLeft]
+ ifTrue: [bounds isWide
+ ifTrue: [menuButton bounds topRight - (1 at 0)]
+ ifFalse: [menuButton bounds bottomLeft - (0 at 1)]])
+ extent: self buttonExtent!
Item was changed:
----- Method: ScrollBar>>hasButtons (in category 'testing') -----
hasButtons
+ ^ (menuButton visible or: [upButton visible]) or: [downButton visible]!
- ^ (menuButton notNil or: [upButton owner notNil]) or: [downButton owner notNil]!
Item was changed:
----- Method: ScrollBar>>initializeDownButton (in category 'initialize') -----
initializeDownButton
"initialize the receiver's downButton"
downButton := RectangleMorph
+ newBounds: self boundsForDownButton
- newBounds: (self innerBounds bottomRight - self buttonExtent
- extent: self buttonExtent)
color: self thumbColor.
downButton
on: #mouseDown
send: #scrollDownInit
to: self.
downButton
on: #mouseUp
send: #finishedScrolling
to: self.
self updateDownButtonImage.
self class roundedScrollBarLook
ifTrue:
[downButton color: Color veryLightGray.
downButton borderStyle: (BorderStyle complexRaised width: 3)]
ifFalse: [downButton setBorderWidth: 1 borderColor: Color lightGray].
+
+ self addMorph: downButton.
+ downButton visible: self class scrollBarsWithoutArrowButtons not.!
-
- self class scrollBarsWithoutArrowButtons
- ifFalse: [self addMorph: downButton].!
Item was changed:
----- Method: ScrollBar>>initializeMenuButton (in category 'initialize') -----
initializeMenuButton
"initialize the receiver's menuButton"
"Preferences disable: #scrollBarsWithoutMenuButton"
"Preferences enable: #scrollBarsWithoutMenuButton"
- (Preferences valueOfFlag: #scrollBarsWithoutMenuButton)
- ifTrue: [menuButton := nil .^ self].
- self bounds isWide
- ifTrue: [menuButton := nil .^ self].
menuButton := RectangleMorph
+ newBounds: self boundsForMenuButton
- newBounds: (self innerBounds topLeft extent: self buttonExtent)
color: self thumbColor.
menuButton
on: #mouseEnter
send: #menuButtonMouseEnter:
to: self.
menuButton
on: #mouseDown
send: #menuButtonMouseDown:
to: self.
menuButton
on: #mouseLeave
send: #menuButtonMouseLeave:
to: self.
"menuButton
addMorphCentered: (RectangleMorph
newBounds: (0 @ 0 extent: 4 @ 2)
color: Color black)."
self updateMenuButtonImage.
self class roundedScrollBarLook
ifTrue: [menuButton color: Color veryLightGray.
menuButton
borderStyle: (BorderStyle complexRaised width: 3)]
ifFalse: [menuButton setBorderWidth: 1 borderColor: Color lightGray].
+
+ self addMorph: menuButton.
+ menuButton visible: (self class scrollBarsWithoutMenuButton or: [self bounds isWide]) not.!
- self addMorph: menuButton!
Item was changed:
----- Method: ScrollBar>>initializePagingArea (in category 'initialize') -----
initializePagingArea
"Appearance"
pagingArea := RectangleMorph
newBounds: self totalSliderArea
color: (self class roundedScrollBarLook
ifTrue: [Color gray: 0.9]
ifFalse: [Color r: 0.6 g: 0.6 b: 0.8]).
+ Preferences gradientScrollBars
+ ifTrue: [pagingArea setBorderWidth: 1 borderColor: (Color lightGray alpha: 0.5)]
+ ifFalse: [pagingArea borderWidth: 0].
- pagingArea setBorderWidth: 1 borderColor: (Color lightGray alpha: 0.5).
self addMorphBack: pagingArea.
"Interactions"
pagingArea
on: #mouseDown
send: #scrollPageInit:
to: self.
pagingArea
on: #mouseUp
send: #finishedScrolling
to: self.
!
Item was changed:
----- Method: ScrollBar>>initializeUpButton (in category 'initialize') -----
initializeUpButton
"initialize the receiver's upButton"
+ upButton := RectangleMorph newBounds: self boundsForUpButton.
- upButton := RectangleMorph
- newBounds: ((menuButton
- ifNil: [self innerBounds topLeft]
- ifNotNil: [bounds isWide
- ifTrue: [menuButton bounds topRight - (1 at 0)]
- ifFalse: [menuButton bounds bottomLeft - (0 at 1)]])
- extent: self buttonExtent).
upButton color: self thumbColor.
upButton
on: #mouseDown
send: #scrollUpInit
to: self.
upButton
on: #mouseUp
send: #finishedScrolling
to: self.
self updateUpButtonImage.
self class roundedScrollBarLook
ifTrue: [upButton color: Color veryLightGray.
upButton
borderStyle: (BorderStyle complexRaised width: 3)]
ifFalse: [upButton setBorderWidth: 1 borderColor: Color lightGray].
+
+ self addMorph: upButton.
+ upButton visible: self class scrollBarsWithoutArrowButtons not.!
-
- self class scrollBarsWithoutArrowButtons
- ifFalse: [self addMorph: upButton].!
Item was added:
+ ----- Method: ScrollBar>>menuSelector (in category 'access') -----
+ menuSelector
+ ^ menuSelector!
Item was added:
+ ----- Method: ScrollBar>>menuSelector: (in category 'access') -----
+ menuSelector: aSymbol
+ menuSelector := aSymbol.!
Item was changed:
----- Method: ScrollBar>>minExtent (in category 'geometry') -----
minExtent
"The minimum extent is that of 2 or 3 buttons in a row or column,
the 'up' and 'down' button and optionally the 'menu' button."
| btns cnt |
btns := 2.
+ menuButton visible ifTrue: [
- menuButton ifNotNil: [
btns := btns + 1].
cnt := 1 at btns. "assume vertical layout"
self bounds isWide
ifTrue: [cnt := cnt transposed].
^ upButton minExtent * cnt!
Item was changed:
----- Method: ScrollBar>>sliderColor: (in category 'access') -----
sliderColor: aColor
"Change the color of the scrollbar to go with aColor."
| buttonColor |
super sliderColor: aColor.
self updateSliderColor: aColor.
buttonColor := self thumbColor.
+ menuButton color: buttonColor.
- menuButton
- ifNotNil: [menuButton color: buttonColor].
upButton color: buttonColor.
downButton color: buttonColor.
self class updateScrollBarButtonsAspect: {menuButton. upButton. downButton} color: buttonColor.
self updateMenuButtonImage.
self updateUpButtonImage.
self updateDownButtonImage.!
Item was changed:
----- Method: ScrollBar>>totalSliderArea (in category 'geometry') -----
totalSliderArea
| upperReferenceBounds lowerReferenceBounds |
+ upperReferenceBounds := (upButton visible ifFalse: [menuButton visible ifTrue: [menuButton] ifFalse: [nil]] ifTrue: [upButton])
- upperReferenceBounds := (upButton owner ifNil: [menuButton] ifNotNil: [upButton])
ifNil: [self topLeft corner: (bounds isWide ifTrue: [self bottomLeft + (1 at 0)] ifFalse: [self topRight + (0 at 1)])]
ifNotNil: [:button | button bounds].
+ lowerReferenceBounds := downButton visible
+ ifFalse: [(bounds isWide ifTrue: [self topRight - (1 at 0)] ifFalse: [self bottomLeft - (0 at 1)]) corner: self bottomRight]
+ ifTrue: [downButton bounds].
- lowerReferenceBounds := downButton owner
- ifNil: [(bounds isWide ifTrue: [self topRight - (1 at 0)] ifFalse: [self bottomLeft - (0 at 1)]) corner: self bottomRight]
- ifNotNil: [downButton bounds].
^ bounds isWide
ifTrue: [upperReferenceBounds topRight - (1 at 0) corner: lowerReferenceBounds bottomLeft + (1 at 0)]
ifFalse:[upperReferenceBounds bottomLeft - (0 at 1) corner: lowerReferenceBounds topRight + (0 at 1)].
!
Item was changed:
----- Method: ScrollBar>>updateMenuButtonImage (in category 'initialize') -----
updateMenuButtonImage
"update the receiver's menuButton. put a new image inside"
- menuButton isNil ifTrue:[^ self].
menuButton removeAllMorphs.
+ menuButton addMorphCentered: (ImageMorph new image: self menuImage).!
- menuButton
- addMorphCentered: (ImageMorph new image: self menuImage)!
Item was added:
+ ----- Method: ScrollBar>>updateSlider (in category 'initialize') -----
+ updateSlider
+
+ menuButton
+ visible: (self bounds isWide or: [self class scrollBarsWithoutMenuButton]) not;
+ bounds: self boundsForMenuButton.
+ upButton
+ visible: self class scrollBarsWithoutArrowButtons not;
+ bounds: self boundsForUpButton.
+ downButton
+ visible: self class scrollBarsWithoutArrowButtons not;
+ bounds: self boundsForDownButton.
+
+ super updateSlider.
+
+ pagingArea bounds: self totalSliderArea.
+
+ self expandSlider.
+ !
Item was changed:
----- Method: ScrollPane>>initializeScrollBars (in category 'initialization') -----
initializeScrollBars
"initialize the receiver's scrollBar"
(scrollBar := ScrollBar on: self getValue: nil setValue: #vScrollBarValue:)
+ menuSelector: #vScrollBarMenuButtonPressed:;
borderWidth: 1;
borderColor: Color black.
(hScrollBar := ScrollBar on: self getValue: nil setValue: #hScrollBarValue:)
+ menuSelector: #hScrollBarMenuButtonPressed:;
borderWidth: 1;
borderColor: Color black.
""
scroller := TransformMorph new color: Color transparent.
scroller offset: 0 @ 0.
self addMorph: scroller.
""
scrollBar initializeEmbedded: retractableScrollBar not.
hScrollBar initializeEmbedded: retractableScrollBar not.
retractableScrollBar ifFalse:
[self
addMorph: scrollBar;
addMorph: hScrollBar].
Preferences alwaysShowVScrollbar ifTrue:
[ self alwaysShowVScrollBar: true ].
Preferences alwaysHideHScrollbar
ifTrue:[self hideHScrollBarIndefinitely: true ]
ifFalse:
[Preferences alwaysShowHScrollbar ifTrue:
[ self alwaysShowHScrollBar: true ]].
!
Item was changed:
----- Method: Slider>>extent: (in category 'geometry') -----
extent: newExtent
newExtent = bounds extent ifTrue: [^ self].
bounds isWide
ifTrue: [super extent: (newExtent x max: self sliderThickness * 2) @ newExtent y]
ifFalse: [super extent: newExtent x @ (newExtent y max: self sliderThickness * 2)].
+ self updateSlider.!
- self removeAllMorphs; initializeSlider!
Item was added:
+ ----- Method: Slider>>updateSlider (in category 'initialization') -----
+ updateSlider
+ "Updates layout properties of the slider."
+
+ slider bounds: self totalSliderArea.
+ sliderShadow bounds: slider bounds.
+
+ self computeSlider.
+ !
Item was changed:
(PackageInfo named: 'Morphic') postscript: '(Preferences dictionaryOfPreferences at: #alternativeWindowBoxesLook) defaultValue: false.
"Force SystemProgressMorph to be reset"
SystemProgressMorph initialize; reset.
"Initialize the key bindings and menus"
Editor initialize.
"Retain scrollBar look now that the pref actually does something"
Preferences enable: #gradientScrollBars.
"apply the new icons"
MenuIcons initializeIcons.
TheWorldMainDockingBar updateInstances.
"Cleanup old-style preferences here. Remove before new release."
Preferences removePreference: #gradientMenu. "Now in MenuMorph."
Preferences removePreference: #roundedMenuCorners. "Now in MenuMorph."
"Fix clipping bug of open windows. New ones are not affected."
TransformMorph allInstances do: [:ea | ea clipSubmorphs: true].
"Update existing scrollbars."
+ ScrollBar allSubInstances do: [:sb |
+ sb removeAllMorphs; initializeSlider].
ScrollPane allSubInstances do: [:sc |
+ sc vScrollBar
+ setValueSelector: #vScrollBarValue:;
+ menuSelector: #vScrollBarMenuButtonPressed:.
+ sc hScrollBar
+ setValueSelector: #hScrollBarValue:;
+ menuSelector: #hScrollBarMenuButtonPressed:.
+ sc vSetScrollDelta; hSetScrollDelta].
+
+ "Now in ScrollBar."
+ Preferences removePreference: #scrollBarsWithoutMenuButton. '!
- sc vScrollBar setValueSelector: #vScrollBarValue:.
- sc hScrollBar setValueSelector: #hScrollBarValue:.
- sc vSetScrollDelta; hSetScrollDelta].'!
More information about the Packages
mailing list