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

commits at source.squeak.org commits at source.squeak.org
Thu Apr 16 22:05:33 UTC 2015


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



More information about the Packages mailing list