[Pkg] The Trunk: Morphic-mt.800.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Apr 1 11:19:13 UTC 2015
Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.800.mcz
==================== Summary ====================
Name: Morphic-mt.800
Author: mt
Time: 1 April 2015, 1:18:34.183 pm
UUID: 348486a9-bf29-0a42-b162-ddb7adaab048
Ancestors: Morphic-mt.799
Elevated #roundedScrollBarLook into a preference (was: just hardcoded to false) and updated affected methods.
Added preference to hide even the arrow buttons of all scrollbars. This makes sense for mouse-wheel-driven usage.
=============== Diff against Morphic-mt.799 ===============
Item was changed:
Slider subclass: #ScrollBar
instanceVariableNames: 'menuButton upButton downButton pagingArea scrollDelta pageDelta interval menuSelector timeOfMouseDown timeOfLastScroll nextPageDirection currentScrollDelay'
+ classVariableNames: 'ArrowImagesCache BoxesImagesCache RoundedScrollBarLook ScrollBarsWithoutArrowButtons UpArrow UpArrow8Bit'
- classVariableNames: 'ArrowImagesCache BoxesImagesCache 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>>roundedScrollBarLook (in category 'preferences') -----
+ roundedScrollBarLook
+
+ <preference: 'roundedScrollBarLook'
+ category: #scrolling
+ description: 'If true, morphic scrollbars will look rounded.'
+ type: #Boolean>
+ ^ RoundedScrollBarLook ifNil: [false]!
Item was added:
+ ----- Method: ScrollBar class>>roundedScrollBarLook: (in category 'preferences') -----
+ roundedScrollBarLook: aBoolean
+
+ RoundedScrollBarLook := aBoolean.!
Item was added:
+ ----- Method: ScrollBar class>>scrollBarsWithoutArrowButtons (in category 'preferences') -----
+ scrollBarsWithoutArrowButtons
+
+ <preference: 'scrollBarsWithoutArrowButtons'
+ category: #scrolling
+ description: 'If true, morphic scrollbars will not include arrow buttons but only the slider.'
+ type: #Boolean>
+ ^ ScrollBarsWithoutArrowButtons ifNil: [false]!
Item was added:
+ ----- Method: ScrollBar class>>scrollBarsWithoutArrowButtons: (in category 'preferences') -----
+ scrollBarsWithoutArrowButtons: aBoolean
+
+ ScrollBarsWithoutArrowButtons := aBoolean.!
Item was changed:
----- Method: ScrollBar>>finishedScrolling (in category 'scrolling') -----
finishedScrolling
self stopStepping.
self scrollBarAction: nil.
+ self class roundedScrollBarLook ifTrue:[
- self roundedScrollbarLook ifTrue:[
upButton borderStyle: (BorderStyle complexRaised width: upButton borderWidth).
downButton borderStyle: (BorderStyle complexRaised width: downButton borderWidth).
] ifFalse:[
downButton borderStyle: BorderStyle thinGray.
upButton borderStyle: BorderStyle thinGray.
].
!
Item was added:
+ ----- Method: ScrollBar>>hasButtons (in category 'testing') -----
+ hasButtons
+
+ ^ (menuButton notNil or: [upButton owner notNil]) or: [downButton owner notNil]!
Item was changed:
----- Method: ScrollBar>>initialize (in category 'initialize') -----
initialize
+
super initialize.
+
scrollDelta := 0.02.
pageDelta := 0.2.
+
+ self color: Color transparent.
+
+ self class roundedScrollBarLook
+ ifFalse: [self borderWidth: 0]
+ ifTrue:[self borderStyle: ((BorderStyle complexFramed width: 2) "baseColor: Color gray")].!
- self roundedScrollbarLook ifTrue:[
- self borderStyle: ((BorderStyle complexFramed width: 2) "baseColor: Color gray")].!
Item was changed:
----- Method: ScrollBar>>initializeDownButton (in category 'initialize') -----
initializeDownButton
"initialize the receiver's downButton"
downButton := RectangleMorph
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
- self roundedScrollbarLook
ifTrue:
[downButton color: Color veryLightGray.
downButton borderStyle: (BorderStyle complexRaised width: 3)]
ifFalse: [downButton setBorderWidth: 1 borderColor: Color lightGray].
+
+ self class scrollBarsWithoutArrowButtons
+ ifFalse: [self addMorph: downButton].!
- self addMorph: downButton!
Item was changed:
----- Method: ScrollBar>>initializeEmbedded: (in category 'initialize') -----
initializeEmbedded: aBool
"aBool == true => inboard scrollbar
aBool == false => flop-out scrollbar"
+ self class roundedScrollBarLook ifFalse:[^self].
- self roundedScrollbarLook ifFalse:[^self].
aBool ifTrue:[
self borderStyle: (BorderStyle inset width: 2).
self cornerStyle: #square.
] ifFalse:[
self borderStyle: (BorderStyle width: 1 color: Color black).
self cornerStyle: #rounded.
].
self removeAllMorphs.
self initializeSlider.!
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 := self class roundedScrollBarLook
- menuButton := self roundedScrollbarLook
ifTrue: [RectangleMorph
newBounds: ((bounds isWide
ifTrue: [upButton bounds topRight]
ifFalse: [upButton bounds bottomLeft])
extent: self buttonExtent)]
ifFalse: [RectangleMorph
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
- self roundedScrollbarLook
ifTrue: [menuButton color: Color veryLightGray.
menuButton
borderStyle: (BorderStyle complexRaised width: 3)]
ifFalse: [menuButton setBorderWidth: 1 borderColor: Color lightGray].
self addMorph: menuButton!
Item was changed:
----- Method: ScrollBar>>initializePagingArea (in category 'initialize') -----
initializePagingArea
+
+ "Appearance"
- "initialize the receiver's pagingArea"
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]).
+ pagingArea setBorderWidth: 1 borderColor: (Color lightGray alpha: 0.5).
+ self addMorphBack: pagingArea.
+
+ "Interactions"
- color: (Color
- r: 0.6
- g: 0.6
- b: 0.8).
- pagingArea setBorderWidth: 1 borderColor: Color lightGray.
pagingArea
on: #mouseDown
send: #scrollPageInit:
to: self.
pagingArea
on: #mouseUp
send: #finishedScrolling
to: self.
+
+ !
- self addMorphBack: pagingArea.
- self roundedScrollbarLook
- ifTrue: [pagingArea
- color: (Color gray: 0.9)]!
Item was changed:
----- Method: ScrollBar>>initializeSlider (in category 'initialize') -----
initializeSlider
"initialize the receiver's slider"
+ self class roundedScrollBarLook
- self roundedScrollbarLook
ifTrue: [self initializeUpButton; initializeMenuButton; initializeDownButton; initializePagingArea]
ifFalse: [self initializeMenuButton; initializeUpButton; initializeDownButton; initializePagingArea].
super initializeSlider.
+ self class roundedScrollBarLook
- self roundedScrollbarLook
ifTrue: [slider cornerStyle: #rounded.
slider
borderStyle: (BorderStyle complexRaised width: 3).
sliderShadow cornerStyle: #rounded].
self sliderColor: self sliderColor!
Item was changed:
----- Method: ScrollBar>>initializeUpButton (in category 'initialize') -----
initializeUpButton
"initialize the receiver's upButton"
+ upButton := self class roundedScrollBarLook
- upButton := self roundedScrollbarLook
ifTrue: [RectangleMorph
newBounds: (self innerBounds topLeft extent: self buttonExtent)]
ifFalse: [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
- self roundedScrollbarLook
ifTrue: [upButton color: Color veryLightGray.
upButton
borderStyle: (BorderStyle complexRaised width: 3)]
ifFalse: [upButton setBorderWidth: 1 borderColor: Color lightGray].
+
+ self class scrollBarsWithoutArrowButtons
+ ifFalse: [self addMorph: upButton].!
- self addMorph: upButton!
Item was removed:
- ----- Method: ScrollBar>>roundedScrollbarLook (in category 'access') -----
- roundedScrollbarLook
- "Rounded look currently only shows up in flop-out mode"
- ^false and: [
- self class alwaysShowFlatScrollbarForAlternativeLook not]
- !
Item was changed:
----- Method: ScrollBar>>sliderShadowColor (in category 'access') -----
sliderShadowColor
+ ^ self class roundedScrollBarLook
- ^ self roundedScrollbarLook
ifTrue: [self sliderColor darker]
ifFalse: [super sliderShadowColor]
!
Item was changed:
----- Method: ScrollBar>>totalSliderArea (in category 'geometry') -----
totalSliderArea
+ | upperReferenceBounds lowerReferenceBounds |
+ 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 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)].
- | upperBoundsButton |
- upperBoundsButton := menuButton ifNil: [upButton].
- bounds isWide
- ifTrue: [
- upButton right > upperBoundsButton right
- ifTrue: [upperBoundsButton := upButton].
- ^upperBoundsButton bounds topRight - (1 at 0) corner: downButton bounds bottomLeft + (1 at 0)]
- ifFalse:[
- upButton bottom > upperBoundsButton bottom
- ifTrue: [upperBoundsButton := upButton].
- ^upperBoundsButton bounds bottomLeft - (0 at 1) corner: downButton bounds topRight + (0 at 1)].
!
Item was changed:
----- Method: ScrollBar>>updateSliderColor: (in category 'access') -----
updateSliderColor: aColor
| gradient |
- slider borderStyle: (BorderStyle width: 1 color: Color lightGray).
self borderWidth: 0.
Preferences gradientScrollBars ifFalse: [
+ slider borderStyle: (BorderStyle width: 1 color: aColor muchDarker).
slider color: aColor.
+ pagingArea color: (aColor darker alpha: 0.45).
- pagingArea color: aColor darker darker.
^ 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 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 bounds isWide
ifTrue:[0 at self height]
ifFalse:[self width at 0]).
pagingArea fillStyle: gradient.!
More information about the Packages
mailing list