[Pkg] The Trunk: Morphic-mt.889.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Apr 16 22:05:33 UTC 2015
Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.889.mcz
==================== Summary ====================
Name: Morphic-mt.889
Author: mt
Time: 17 April 2015, 12:04:52.715 am
UUID: a4a51bbe-cbc2-f346-9d1b-3daf17a37dab
Ancestors: Morphic-mt.888
Allow scroll bars to be forced to either being #horizontal or #vertical to avoid visual glitches in scroll panes when starting with very small sizes.
=============== Diff against Morphic-mt.888 ===============
Item was changed:
----- Method: AColorSelectorMorph>>defaultFillStyle (in category 'as yet unclassified') -----
defaultFillStyle
"Answer the hue gradient."
^(GradientFillStyle colors: {self color alpha: 0. self color})
origin: self topLeft;
+ direction: (self orientation == #horizontal
- direction: (self bounds isWide
ifTrue: [self width at 0]
ifFalse: [0 at self height])!
Item was changed:
----- Method: BracketSliderMorph>>initializeSlider (in category 'initialization') -----
initializeSlider
"Make the slider raised."
slider :=( BracketMorph newBounds: self totalSliderArea)
+ horizontal: self orientation == #horizontal;
- horizontal: self bounds isWide;
color: self thumbColor;
borderStyle: (BorderStyle raised baseColor: Color white; width: 1).
sliderShadow := (BracketMorph newBounds: self totalSliderArea)
+ horizontal: self orientation == #horizontal;
- horizontal: self bounds isWide;
color: self pagingArea color;
borderStyle: (BorderStyle inset baseColor: (Color white alpha: 0.6); width: 1).
slider on: #mouseMove send: #scrollAbsolute: to: self.
slider on: #mouseDown send: #mouseDownInSlider: to: self.
slider on: #mouseUp send: #mouseUpInSlider: to: self.
"(the shadow must have the pagingArea as its owner to highlight properly)"
self pagingArea addMorph: sliderShadow.
sliderShadow hide.
self addMorph: slider.
self computeSlider.
!
Item was changed:
----- Method: BracketSliderMorph>>roomToMove (in category 'geometry') -----
roomToMove
"Allow to run off the edges a bit."
+ ^self orientation == #horizontal
- ^self bounds isWide
ifTrue: [self totalSliderArea insetBy: ((self sliderThickness // 2 at 0) negated corner: (self sliderThickness // 2 + 1)@0)]
ifFalse: [self totalSliderArea insetBy: (0@(self sliderThickness // 2) negated corner: 0@(self sliderThickness // 2 - (self sliderThickness \\ 2) + 1))]!
Item was changed:
----- Method: BracketSliderMorph>>scrollPoint: (in category 'event handling') -----
scrollPoint: event
"Scroll to the event position."
| r p |
r := self roomToMove.
+ self orientation == #horizontal
- bounds isWide
ifTrue: [r width = 0 ifTrue: [^ self]]
ifFalse: [r height = 0 ifTrue: [^ self]].
p := event position - (self sliderThickness // 2) adhereTo: r.
self descending
ifFalse:
+ [self setValue: (self orientation == #horizontal
- [self setValue: (bounds isWide
ifTrue: [(p x - r left) asFloat / r width]
ifFalse: [(p y - r top) asFloat / r height])]
ifTrue:
+ [self setValue: (self orientation == #horizontal
- [self setValue: (bounds isWide
ifTrue: [(r right - p x) asFloat / r width]
ifFalse: [(r bottom - p y) asFloat / r height])]!
Item was changed:
----- Method: BracketSliderMorph>>sliderThickness (in category 'geometry') -----
sliderThickness
"Answer the thickness of the slider."
+ ^((self orientation == #horizontal
- ^((self bounds isWide
ifTrue: [self height]
ifFalse: [self width]) // 2 max: 8) // 2 * 2 + 1!
Item was changed:
----- Method: BracketSliderMorph>>updateFillStyle (in category 'initialization') -----
updateFillStyle
"Update the fill style directions."
|b fs|
fs := self fillStyle.
fs isOrientedFill ifTrue: [
b := self innerBounds.
fs origin: b topLeft.
+ fs direction: (self orientation == #horizontal
- fs direction: (b isWide
ifTrue: [b width at 0]
ifFalse: [0 at b height])]!
Item was changed:
----- Method: BracketSliderMorph>>updateSlider (in category 'initialization') -----
updateSlider
super updateSlider.
+ slider horizontal: self orientation == #horizontal.
+ sliderShadow horizontal: self orientation == #horizontal.!
- slider horizontal: self bounds isWide.
- sliderShadow horizontal: self bounds isWide.!
Item was changed:
----- Method: HColorSelectorMorph>>defaultFillStyle (in category 'as yet unclassified') -----
defaultFillStyle
"Answer the hue gradient."
^(GradientFillStyle colors: ((0.0 to: 359.9 by: 0.1) collect: [:a | Color h: a s: 1.0 v: 1.0]))
origin: self topLeft;
+ direction: (self orientation == #horizontal
- direction: (self bounds isWide
ifTrue: [self width at 0]
ifFalse: [0 at self height])!
Item was changed:
----- Method: ScrollBar>>boundsForUpButton (in category 'initialize') -----
boundsForUpButton
^ (self menuButton visible
ifFalse: [self innerBounds topLeft]
+ ifTrue: [self orientation == #horizontal
- ifTrue: [bounds isWide
ifTrue: [self menuButton bounds topRight - (1 at 0)]
ifFalse: [self menuButton bounds bottomLeft - (0 at 1)]])
extent: self buttonExtent!
Item was changed:
----- Method: ScrollBar>>buttonExtent (in category 'geometry') -----
buttonExtent
+ ^ self orientation == #horizontal
- ^ bounds isWide
ifTrue: [self innerBounds height asPoint]
ifFalse: [self innerBounds width asPoint]!
Item was changed:
----- Method: ScrollBar>>downImage (in category 'initialize') -----
downImage
"answer a form to be used in the down button"
^ self class
+ arrowOfDirection: (self orientation == #horizontal
- arrowOfDirection: (bounds isWide
ifTrue: [#right]
ifFalse: [#bottom])
size: (self buttonExtent x min: self buttonExtent y)
color: self thumbColor!
Item was changed:
----- Method: ScrollBar>>expandSlider (in category 'geometry') -----
expandSlider
"Compute the new size of the slider (use the old sliderThickness as a minimum)."
| r |
r := self totalSliderArea.
+ slider extent: (self orientation == #horizontal
- slider extent: (bounds isWide
ifTrue: [(((r width * self interval) asInteger max: self minThumbThickness) min: r width) @ slider height]
ifFalse: [slider width @ (((r height * self interval) asInteger max: self minThumbThickness) min: r height)])!
Item was changed:
----- Method: ScrollBar>>initializeMenuButton (in category 'initialize') -----
initializeMenuButton
"initialize the receiver's menuButton"
"Preferences disable: #scrollBarsWithoutMenuButton"
"Preferences enable: #scrollBarsWithoutMenuButton"
menuButton := RectangleMorph
newBounds: self boundsForMenuButton
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 orientation == #horizontal]) not.!
- menuButton visible: (self class scrollBarsWithoutMenuButton or: [self bounds isWide]) not.!
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."
| buttonCount refExtent refBorder |
refExtent := upButton minExtent.
refBorder := upButton borderWidth.
buttonCount := {
upButton visible.
downButton visible.
self menuButton visible. } count: [:ea | ea].
+ ^ self orientation == #horizontal
- ^ self bounds isWide
ifTrue: [((buttonCount * refExtent x) - (buttonCount-1 * refBorder)) @ 5]
ifFalse: [5 @ ((buttonCount * refExtent y) - (buttonCount-1 * refBorder))]!
Item was changed:
----- Method: ScrollBar>>setNextDirectionFromEvent: (in category 'scrolling') -----
setNextDirectionFromEvent: event
+ nextPageDirection := self orientation == #horizontal
+ ifTrue: [event cursorPoint x >= slider center x]
+ ifFalse: [event cursorPoint y >= slider center y].
- nextPageDirection := bounds isWide ifTrue: [
- event cursorPoint x >= slider center x
- ]
- ifFalse: [
- event cursorPoint y >= slider center y
- ]
-
!
Item was changed:
----- Method: ScrollBar>>totalSliderArea (in category 'geometry') -----
totalSliderArea
| upperReferenceBounds lowerReferenceBounds |
upperReferenceBounds := (upButton visible ifFalse: [self menuButton visible ifTrue: [self menuButton] ifFalse: [nil]] ifTrue: [upButton])
+ ifNil: [self topLeft corner: (self orientation == #horizontal ifTrue: [self bottomLeft + (1 at 0)] ifFalse: [self topRight + (0 at 1)])]
- 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: [(self orientation == #horizontal ifTrue: [self topRight - (1 at 0)] ifFalse: [self bottomLeft - (0 at 1)]) corner: self bottomRight]
- ifFalse: [(bounds isWide ifTrue: [self topRight - (1 at 0)] ifFalse: [self bottomLeft - (0 at 1)]) corner: self bottomRight]
ifTrue: [downButton bounds].
+ ^ self orientation == #horizontal
- ^ 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>>upImage (in category 'initialize') -----
upImage
"answer a form to be used in the up button"
^ self class
+ arrowOfDirection: (self orientation == #horizontal
- arrowOfDirection: (bounds isWide
ifTrue: [#left]
ifFalse: [#top])
size: (self buttonExtent x min: self buttonExtent y)
color: self thumbColor!
Item was changed:
----- Method: ScrollBar>>updateSlider (in category 'initialize') -----
updateSlider
| imagesNeedUpdate |
+ imagesNeedUpdate := upButton width ~= (self orientation == #horizontal ifTrue: [self height] ifFalse: [self width]).
- imagesNeedUpdate := upButton width ~= (self bounds isWide ifTrue: [self height] ifFalse: [self width]).
self menuButton
+ visible: (self orientation == #horizontal or: [self class scrollBarsWithoutMenuButton]) not;
- 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.
imagesNeedUpdate ifTrue: [
self menuButton visible ifTrue: [self updateMenuButtonImage].
upButton visible ifTrue: [self updateUpButtonImage].
downButton visible ifTrue: [self updateDownButtonImage]].!
Item was changed:
----- Method: ScrollBar>>updateSliderColor: (in category 'access') -----
updateSliderColor: aColor
| gradient |
Preferences gradientScrollBars ifFalse: [
slider
borderColor: (aColor adjustBrightness: -0.3);
color: aColor.
pagingArea
borderColor: (aColor muchDarker alpha: pagingArea borderStyle color alpha);
color: (aColor darker alpha: 0.35).
^ self].
slider borderStyle: (BorderStyle width: 1 color: Color lightGray).
"Fill the slider."
gradient := GradientFillStyle ramp: {
0 -> (Color gray: 0.95).
0.49 -> (Color gray: 0.9).
0.5 -> (Color gray: 0.87).
1 -> (Color gray: 0.93).
}.
gradient origin: slider topLeft.
+ gradient direction: (self orientation == #horizontal
- gradient direction: (self bounds isWide
ifTrue:[0 at slider height]
ifFalse:[slider width at 0]).
slider fillStyle: gradient.
"Fill the paging area."
gradient := GradientFillStyle ramp: {
0 -> (Color gray: 0.65).
0.6 -> (Color gray: 0.82).
1 -> (Color gray: 0.88).
}.
gradient origin: self topLeft.
+ gradient direction: (self orientation == #horizontal
- gradient direction: (self bounds isWide
ifTrue:[0 at self height]
ifFalse:[self width at 0]).
pagingArea fillStyle: gradient.!
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:;
+ orientation: #vertical.
- menuSelector: #vScrollBarMenuButtonPressed:.
(hScrollBar := ScrollBar on: self getValue: nil setValue: #hScrollBarValue:)
+ menuSelector: #hScrollBarMenuButtonPressed:;
+ orientation: #horizontal.
- menuSelector: #hScrollBarMenuButtonPressed:.
""
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:
MorphicModel subclass: #Slider
+ instanceVariableNames: 'slider value setValueSelector getValueSelector sliderShadow sliderColor descending minimumValue maximumValue quantum getMinimumValueSelector getMaximumValueSelector orientation'
- instanceVariableNames: 'slider value setValueSelector getValueSelector sliderShadow sliderColor descending minimumValue maximumValue quantum getMinimumValueSelector getMaximumValueSelector'
classVariableNames: ''
poolDictionaries: ''
category: 'Morphic-Windows'!
Item was changed:
----- Method: Slider>>computeSlider (in category 'geometry') -----
computeSlider
| r v |
r := self roomToMove.
v := self maximumValue = self minimumValue
ifTrue: [0]
ifFalse: [(value - self minimumValue) / (self maximumValue - self minimumValue)].
self descending
ifFalse:
+ [slider position: (self orientation == #horizontal
- [slider position: (bounds isWide
ifTrue: [r topLeft + ((r width * v) asInteger @ 0)]
ifFalse: [r topLeft + (0 @ (r height * v) asInteger)])]
ifTrue:
+ [slider position: (self orientation == #horizontal
- [slider position: (bounds isWide
ifTrue: [r bottomRight - ((r width * v) asInteger @ 0)]
ifFalse: [r bottomRight - ((0 @ (r height * v) asInteger))])].
slider extent: self sliderExtent!
Item was changed:
----- Method: Slider>>minExtent (in category 'geometry') -----
minExtent
+ ^ self orientation == #horizontal
- ^ self bounds isWide
ifTrue: [(self sliderThickness * 2) @ (self borderWidth + 1)]
ifFalse: [(self borderWidth + 1) @ (self sliderThickness * 2)]!
Item was added:
+ ----- Method: Slider>>orientation (in category 'accessing') -----
+ orientation
+
+ ^ orientation ifNil: [bounds isWide ifTrue: [#horizontal] ifFalse: [#vertical]]!
Item was added:
+ ----- Method: Slider>>orientation: (in category 'accessing') -----
+ orientation: aSymbol
+
+ orientation == aSymbol ifTrue: [^ self].
+ orientation := aSymbol.
+ self updateSlider.!
Item was changed:
----- Method: Slider>>scrollAbsolute: (in category 'scrolling') -----
scrollAbsolute: event
| r p |
r := self roomToMove.
+ self orientation == #horizontal
- bounds isWide
ifTrue: [r width = 0 ifTrue: [^ self]]
ifFalse: [r height = 0 ifTrue: [^ self]].
p := event targetPoint adhereTo: r.
self descending
ifFalse:
+ [self setValueFraction: (self orientation == #horizontal
- [self setValueFraction: (bounds isWide
ifTrue: [(p x - r left) asFloat / r width]
ifFalse: [(p y - r top) asFloat / r height])]
ifTrue:
+ [self setValueFraction: (self orientation == #horizontal
- [self setValueFraction: (bounds isWide
ifTrue: [(r right - p x) asFloat / r width]
ifFalse: [(r bottom - p y) asFloat / r height])]!
Item was changed:
----- Method: Slider>>sliderExtent (in category 'geometry') -----
sliderExtent
+ ^ self orientation == #horizontal
- ^ bounds isWide
ifTrue: [self sliderThickness @ self innerBounds height]
ifFalse: [self innerBounds width @ self sliderThickness]!
More information about the Packages
mailing list