The Trunk: Morphic-mt.845.mcz

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@0)]
+ ifFalse: [menuButton bounds bottomLeft - (0@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@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
  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@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@0)] ifFalse: [self topRight + (0@1)])]
  ifNotNil: [:button | button bounds].
+ lowerReferenceBounds := downButton visible
+ ifFalse: [(bounds isWide ifTrue: [self topRight - (1@0)] ifFalse: [self bottomLeft - (0@1)]) corner: self bottomRight]
+ ifTrue: [downButton 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)].
  !

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].'!