The Trunk: Morphic-mt.800.mcz

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@0)]
  ifFalse: [menuButton bounds bottomLeft - (0@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@0)] ifFalse: [self topRight + (0@1)])]
+ ifNotNil: [:button | button bounds].
+ lowerReferenceBounds := downButton owner
+ ifNil: [(bounds isWide ifTrue: [self topRight - (1@0)] ifFalse: [self bottomLeft - (0@1)]) corner: self bottomRight]
+ ifNotNil: [downButton bounds].
+ ^ bounds isWide
+ ifTrue: [upperReferenceBounds topRight - (1@0) corner: lowerReferenceBounds bottomLeft + (1@0)]
+ ifFalse:[upperReferenceBounds bottomLeft - (0@1) corner: lowerReferenceBounds topRight + (0@1)].
- | upperBoundsButton |
- upperBoundsButton := menuButton ifNil: [upButton].
- bounds isWide
- ifTrue: [
- upButton right > upperBoundsButton right
- ifTrue: [upperBoundsButton := upButton].
- ^upperBoundsButton bounds topRight - (1@0) corner: downButton bounds bottomLeft + (1@0)]
- ifFalse:[
- upButton bottom > upperBoundsButton bottom
- ifTrue: [upperBoundsButton := upButton].
- ^upperBoundsButton bounds bottomLeft - (0@1) corner: downButton bounds topRight + (0@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@slider height]
  ifFalse:[slider width@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@self height]
  ifFalse:[self width@0]).
  pagingArea fillStyle: gradient.!

In conjuction with narrow scrollbars and no menu button, you can save some space on screen with it. For the sake of comparison, you see the default setting on the right: gradient enabled, menu button visible, arrow buttons visible, normal width.

I thought about making the background/paging area transparent but this would affect discoverability of its features. Do you yet try to click on the area besides the draggable thumb? ;-)

Best,
Marcel