The Trunk: Morphic-mt.889.mcz

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@0]
  ifFalse: [0@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@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@0]
  ifFalse: [0@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@0]
  ifFalse: [0@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@0)]
  ifFalse: [self menuButton bounds bottomLeft - (0@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@0)] ifFalse: [self topRight + (0@1)])]
- ifNil: [self topLeft corner: (bounds isWide ifTrue: [self bottomLeft + (1@0)] ifFalse: [self topRight + (0@1)])]
  ifNotNil: [:button | button bounds].
  lowerReferenceBounds := downButton visible
+ ifFalse: [(self orientation == #horizontal ifTrue: [self topRight - (1@0)] ifFalse: [self bottomLeft - (0@1)]) corner: self bottomRight]
- ifFalse: [(bounds isWide ifTrue: [self topRight - (1@0)] ifFalse: [self bottomLeft - (0@1)]) corner: self bottomRight]
  ifTrue: [downButton bounds].
+ ^ self orientation == #horizontal
- ^ bounds isWide
  ifTrue: [upperReferenceBounds topRight - (1@0) corner: lowerReferenceBounds bottomLeft + (1@0)]
  ifFalse:[upperReferenceBounds bottomLeft - (0@1) corner: lowerReferenceBounds topRight + (0@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@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 orientation == #horizontal
- gradient direction: (self bounds isWide
  ifTrue:[0@self height]
  ifFalse:[self width@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]!