[Cuis-dev] BoxedMorph padding

ken.dickey at whidbey.com ken.dickey at whidbey.com
Fri Sep 6 07:47:29 PDT 2024 

And for the rest of us, here is the 3 combined ChangeSets into one.

I think I have now reconstituted all the code I lost.

Again, sorry for the lost fileout.

Please test & feedback.

Cheers,
-KenD
-------------- next part --------------
'From Cuis7.1 [latest update: #6676] on 6 September 2024 at 7:41:20 am'!

!BoxedMorph methodsFor: 'accessing' stamp: 'KenD 9/3/2024 15:04:00'!
padding
	"Answer a point"
	self flag: #FakeIvar.
	^self valueOfProperty: #padding ifAbsentPut: [ 0 @ 0 ]! !

!BoxedMorph methodsFor: 'accessing' stamp: 'KenD 9/6/2024 05:40:24'!
padding: numberOrPoint
	"Save a point"
	self flag: #FakeIvar.
	self setProperty: #padding
		toValue: ((numberOrPoint class = Point) 
			ifTrue: [numberOrPoint] 
			ifFalse: [numberOrPoint @ numberOrPoint]).
	self morphExtent: (self minimumExtent max: self morphExtent).
	self redrawNeeded! !

!BoxedMorph methodsFor: 'geometry' stamp: 'KenD 9/6/2024 05:40:19'!
minimumExtent
	"This returns the minimum extent that the morph may be shrunk to.
	It is expressed in the morph own coordinates, like morphExtent."

	^ super minimumExtent + (self padding + self borderWidth * 2)! !

!BoxedMorph methodsFor: 'geometry interior' stamp: 'KenD 9/3/2024 15:24:23'!
interiorExtent

	"Answer extent inset from borderWidth and Padding"
	^self morphExtent - (2 * self borderWidth) - (2 * self padding)! !

!BoxedMorph methodsFor: 'geometry interior' stamp: 'KenD 9/5/2024 17:49:05'!
interiorOffset

	"Answer point inset from borderWidth and Padding"
	| x y |
	x := self borderWidth + self padding x.
	y := (self borderWidth + self padding y) negated.
	^x @ y! !

!BoxedMorph methodsFor: 'geometry interior' stamp: 'KenD 9/5/2024 17:49:26'!
interiorOrigin

	"Answer point inset from borderWidth and Padding"
	| x y |
	x := self borderWidth + self padding x.
	y := self borderWidth + self padding y.
	^x @ y! !


!LayoutMorph methodsFor: 'accessing' stamp: 'KenD 9/4/2024 11:50:46'!
padding: numberOrPoint

	super padding: numberOrPoint.
	self layoutSubmorphs ! !


!LayoutMorph methodsFor: 'accessing' stamp: 'KenD 9/3/2024 15:45:58'!
useEdgeSpace

	self flag: #deprecated.
	^ self padding > (0 @ 0)! !

!LayoutMorph methodsFor: 'accessing' stamp: 'KenD 9/4/2024 11:48:55'!
useEdgeSpace: aBoolean

	self flag: #deprecated.
	aBoolean 
		ifTrue: [ self padding: (self xSeparation @ self ySeparation) ]
		ifFalse: [self padding: (0 at 0)].
	self layoutSubmorphs 
! !

!LayoutMorph methodsFor: 'geometry' stamp: 'KenD 9/5/2024 18:07:03'!
minimumExtent: cachedValues
	"Answer size sufficient to frame my submorphs."
	
	| width height mle subs |
	width  := 0.
	height := 0.
	subs := self submorphsToLayout.
	(self direction = #vertical)
		ifTrue: [ "Column"
			subs do: [ :sm |
				mle := sm minimumLayoutExtent: cachedValues.
				"use maximum width across submorphs"
				width := width max: mle x.
				"sum up submorph heights, excluding separation"
				height := height + mle y.
				].
			width := width + (2 * self padding x).
			height := height + (2 * self padding y) + (subs size - 1 * self ySeparation)
		]
		ifFalse: [ "Row"
			subs do: [ :sm |
				mle := sm minimumLayoutExtent: cachedValues.
				"sum up submorphs width"
				width := width + mle x.
				"use maximum height across submorph"
				height := height max: mle y.
			].
			width := width + (2 * self padding x) + (subs size - 1 * self xSeparation). 
			height := height + (2 * self padding y).
		].

	^ (width @ height) + self extentBorder! !

!LayoutMorph methodsFor: 'layout' stamp: 'KenD 9/3/2024 16:22:52'!
layoutBounds
	"Return the bounds for laying out children of the receiver"

	^ self localBounds insetBy: (borderWidth + self padding)! !

!LayoutMorph methodsFor: 'layout' stamp: 'KenD 9/3/2024 18:40:24'!
layoutSubmorphsHorizontallyIn: boundsForLayout
	"Compute a new layout based on the given layout bounds."

	| visibleSubmorphs gap gapCount widths widthToAllocate leftOver x height y cache |
	"Preconditions: self isRow & morphExtent >= minimumLayoutExtent"
	(visibleSubmorphs := self submorphsToLayout reversed  "Display Order")
		ifEmpty: [ ^ self. "Nothing to layout, besides `sum` below, would fail" ].
	
	gap := self xSeparation.
	gapCount := visibleSubmorphs size - 1. "gap between each contained Morph"
	widthToAllocate := boundsForLayout width - (gapCount * gap).
	cache := IdentityDictionary new.
	widths := self widthsFor: visibleSubmorphs within: widthToAllocate minLayoutExtentCache: cache.
	leftOver := widthToAllocate - widths sum.
	x := boundsForLayout left + (leftOver * self axisEdgeWeight).

	visibleSubmorphs with: widths do: [ :sm :smWidth |
		height := self offAxisHeightFor: sm within: boundsForLayout height minLayoutExtentCache: cache.
		y := self offAxisYOffsetFor: sm within: boundsForLayout height - height.
		sm fitInto: (x @ (boundsForLayout top + y) extent: smWidth @ height).
		x := x + smWidth + gap.
	]! !

!LayoutMorph methodsFor: 'layout' stamp: 'KenD 9/3/2024 18:52:11'!
layoutSubmorphsVerticallyIn: boundsForLayout
	"Compute a new layout based on the given layout bounds."

	| visibleSubmorphs gap gapCount heights heightToAllocate leftOver y width x cache |
	"Preconditions: self isRow & morphExtent >= minimumLayoutExtent"
	(visibleSubmorphs := self submorphsToLayout reversed  "Display Order")
		ifEmpty: [ ^ self. "Nothing to layout, besides `sum` below, would fail" ].

	gap := self ySeparation.
	gapCount := visibleSubmorphs size - 1. "gap between each contained Morph"
	heightToAllocate := boundsForLayout height - (gapCount * gap).
	cache := IdentityDictionary new.
	heights := self heightsFor: visibleSubmorphs within: heightToAllocate minLayoutExtentCache: cache.
	leftOver := heightToAllocate - heights sum.
	y := boundsForLayout top + (leftOver * self axisEdgeWeight).

	visibleSubmorphs with: heights do: [ :sm :smHeight |
		width := self offAxisWidthFor: sm within: boundsForLayout width minLayoutExtentCache: cache.
		x := self offAxisXOffsetFor: sm within: boundsForLayout width - width.
		sm fitInto: (boundsForLayout left + x @ y extent: width @ smHeight).
		y := y + smHeight + gap.
	]! !

!LayoutMorph methodsFor: 'layout' stamp: 'KenD 9/3/2024 18:45:27'!
offAxisHeightFor: aMorph within: availableHeight minLayoutExtentCache: cache
	"Answer height for a single morph -- offAxis calculation for a Row"
	
	^(availableHeight * aMorph layoutSpec proportionalLayoutHeight)
							 max: (aMorph minimumLayoutExtent: cache) y.! !

!LayoutMorph methodsFor: 'layout' stamp: 'KenD 9/3/2024 18:45:59'!
offAxisWidthFor: aMorph within: availableWidth minLayoutExtentCache: cache
	"Answer width for a single morph -- offAxis calculation for a Column"

	^ (availableWidth * aMorph layoutSpec proportionalLayoutWidth)
						 	max: (aMorph minimumLayoutExtent: cache) x.
! !

!LayoutMorph methodsFor: 'layout' stamp: 'KenD 9/3/2024 18:48:57'!
offAxisXOffsetFor: aMorph within: availableWidth
	"Answer x offset for a single morph -- offAxis calculation for a Column"

	^ availableWidth * aMorph layoutSpec offAxisEdgeWeight. ! !

!LayoutMorph methodsFor: 'layout' stamp: 'KenD 9/3/2024 18:48:36'!
offAxisYOffsetFor: aMorph within: availableHeight
	"Answer y offset for a single morph -- offAxis calculation for a Row"
	
	^ availableHeight * aMorph layoutSpec offAxisEdgeWeight! !


!LayoutMorph class methodsFor: 'examples' stamp: 'KenD 9/3/2024 16:00:52'!
exampleEdgesColumn
	"Show 2 cases :1 useEdgeSpace true and 1 false"
	" self exampleEdgesColumn "
	| withEdge noEdge upSpec downSpec |
	withEdge := self newColumn :: padding: (20 @ 20);  separation: 20.
	noEdge := self newColumn ::  padding: (0 @ 0);  separation: 20.
	upSpec := LayoutSpec keepMorphExtent :: offAxisEdgeWeight: 0.
	upSpec proportionalWidth: 0.8 minimum: 100; proportionalHeight: 0.8 minimum: 100.
	downSpec := LayoutSpec keepMorphExtent :: offAxisEdgeWeight: 1.
	downSpec proportionalWidth: 0.5 minimum: 100; proportionalHeight: 0.5 minimum: 100.
	
	withEdge addMorph: (BoxedMorph new :: color: Color blue;  layoutSpec: upSpec).
	noEdge addMorph: (BoxedMorph new :: color: Color blue;  layoutSpec: upSpec).
	withEdge addMorph: (LabelMorph new :: contents: 'WITH Padding').
	noEdge addMorph: (LabelMorph new :: contents: 'withOUT Padding').
	withEdge addMorph: (BoxedMorph new :: layoutSpec: downSpec).
	noEdge addMorph: (BoxedMorph new ::  layoutSpec: downSpec).
	
	withEdge openInWorld.
	noEdge openInWorld.! !

!LayoutMorph class methodsFor: 'examples' stamp: 'KenD 9/3/2024 16:01:46'!
exampleEdgesRow
	"Show 2 cases: 1 useEdgeSpace true and 1 false"
	" self exampleEdgesRow "
	| withEdge noEdge upSpec downSpec |
	withEdge := self newRow :: padding: (20 @ 20);  separation: 20.
	noEdge := self newRow :: padding: (0 @ 0);  separation: 20.
	upSpec := LayoutSpec keepMorphExtent :: offAxisEdgeWeight: 0.
	upSpec proportionalWidth: 0.8 minimum: 100; proportionalHeight: 0.8 minimum: 100.
	downSpec := LayoutSpec keepMorphExtent :: offAxisEdgeWeight: 1.
	downSpec proportionalWidth: 0.5 minimum: 100; proportionalHeight: 0.5 minimum: 100.
	
	withEdge addMorph: (BoxedMorph new :: color: Color blue;  layoutSpec: upSpec).
	noEdge addMorph: (BoxedMorph new :: color: Color blue;  layoutSpec: upSpec).
	withEdge addMorph: (LabelMorph new :: contents: 'WITH Padding').
	noEdge addMorph: (LabelMorph new :: contents: 'withOUT Padding').
	withEdge addMorph: (BoxedMorph new :: layoutSpec: downSpec).
	noEdge addMorph: (BoxedMorph new ::  layoutSpec: downSpec).
	
	withEdge openInWorld.
	noEdge openInWorld.! !


!ImageMorph methodsFor: 'drawing' stamp: 'KenD 9/5/2024 18:15:49'!
drawOn: aCanvas

	self flag: 'Why Origin offset by 1 ??'.
	aCanvas image: image at: self interiorOrigin + 1.
	(borderWidth > 0) ifTrue: [
		aCanvas
			frameRectangle:  (`0 at 0` extent: extent)
			color:  borderColor
			borderWidth:  borderWidth 
			borderStyleSymbol:  #simple ]! !

!ImageMorph methodsFor: 'drawing' stamp: 'KenD 9/4/2024 12:00:06'!
minimumExtent
	^image extent + self extentBorder + (2 * self padding)! !


!InnerTextMorph methodsFor: 'drawing' stamp: 'KenD 9/4/2024 12:02:24'!
drawOn: aCanvas
	"Draw the receiver on a canvas"

	false ifTrue: [ self debugDrawLineRectsOn: aCanvas ].  "show line rects for debugging"

	aCanvas
		drawTextComposition: self textComposition
		at: self interiorOrigin
		extent: extent
		color: color
		selectionColor: (Theme current textHighlightFocused: self hasKeyboardFocus).

	model actualContents isEmpty ifTrue: [
		owner
			valueOfProperty: #emptyTextDisplayMessage
			ifPresentDo: [ :msg |
				aCanvas
					drawString: msg
					at: self interiorOrigin
					font: nil
					color: Theme current textEmptyDisplayMessage ]].! !


!LabelMorph methodsFor: 'drawing' stamp: 'KenD 9/4/2024 12:03:05'!
drawOn: aCanvas
	aCanvas
		drawString: (contents ifNil: [ '' ])
		at: self interiorOrigin
		font: self fontToUse
		color: color.
	(borderWidth > 0) ifTrue: [
		aCanvas
			frameRectangle: (`0 at 0` extent: extent)
			color: borderColor
			borderWidth: borderWidth
			borderStyleSymbol: #simple ]! !

!LabelMorph methodsFor: 'geometry' stamp: 'KenD 9/4/2024 12:05:18'!
minimumExtent

	^ self measureContents + (2 * self interiorOrigin)! !


!TextParagraphMorph methodsFor: 'drawing' stamp: 'KenD 9/4/2024 12:10:45'!
drawOn: aCanvas
	| b |
	b := self localBounds insetBy: self interiorOrigin.
	aCanvas
		fillRectangle: self localBounds color: color.
	aCanvas
		drawTextComposition: textComposition
		at: b topLeft
		extent: b extent
		color: Theme current text
		selectionColor: `Color red`
		avoidOverhang: true.
	aCanvas
		frameRectangle: self localBounds
		color: borderColor
		borderWidth: borderWidth
		borderStyleSymbol: nil! !

!TextParagraphMorph methodsFor: 'geometry' stamp: 'KenD 9/4/2024 12:11:43'!
minimumExtent

	^3 at 1 * FontFamily defaultLineSpacing ceiling + 2 + (2 *  self interiorOrigin)! !

More information about the Cuis-dev mailing list