[Pkg] The Trunk: Morphic-mt.845.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Apr 9 08:01:26 UTC 2015


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

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



More information about the Packages mailing list