[Cuis-dev] BoxedMorph padding

ken.dickey at whidbey.com ken.dickey at whidbey.com
Wed Sep 4 14:02:42 PDT 2024 

Greetings,

Attached is a fileIn for adding padding to BoxedMorphs.

Padding is really just a property for now -- simulated iVar but no 
change to BoxedMorph instance shape.

You can use a morph menu to get an inspector to make visible the 
borderWidth and add padding (an integer or point).

Current code should run unchanged.

Updated drawing with padding in:
   LayoutMorph
   ImageMorph
   InnerTextMorph
   LabelMorph
   TextParagraphMorph

Note that #minimumExtent: now includes both borderWidth and padding.

The question is: is it worthwhile to add #padding to BoxedMorph, or 
should we just add to LayoutMorph?

Anyway, please play around with padding, let me know of breakage, and 
are there additional Morphs where drawOn: updates would be useful?

Other features?

Thanks for feedback,
-KenD
-------------- next part --------------
'From Cuis7.1 [latest update: #6671] on 4 September 2024 at 12:14:49 pm'!

!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/4/2024 11:52:36'!
padding: numberOrPoint
	"Save a point"
	self flag: #FakeIvar.
	self setProperty: #padding
		toValue: ((numberOrPoint class = Point) 
			ifTrue: [numberOrPoint] 
			ifFalse: [numberOrPoint @ numberOrPoint]).
	self redrawNeeded! !

!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/4/2024 12:14:27'!
interiorOrigin

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


!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: '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/4/2024 11:59:08'!
drawOn: aCanvas

	aCanvas image: image at: self interiorOrigin.
	(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)! !


!BoxedMorph reorganize!
('accessing' borderColor borderColor: borderWidth borderWidth: color color: padding padding:)
('initialization' defaultBorderColor defaultBorderWidth defaultColor initialize noBorder)
('drawing' drawOn:)
('geometry interior' interiorExtent interiorOrigin)
('geometry' ensureMinimumExtent extentBorder extentInOwner: extentInWorld extentInWorld: fitInto: fullBoundsInOwner heightInOwner: localBounds localBoundsForError morphBottomLeft morphBottomRight morphExtent morphExtent: morphExtentInOwner: morphExtentInWorld morphExtentInWorld: morphHeight morphHeight: morphHeightInOwner: morphLocalBounds morphPosition:extent: morphTopLeft morphTopRight morphWidth morphWidth: morphWidthInOwner: position:extent: privateExtent: rotationCenter topLeftInOwner widthInOwner:)
('geometry services' coversLocalPoint: coversPixel: includesPixel:)
('geometry testing' hasVariableExtent knowsOwnLocalBounds requiresVectorCanvas submorphsMightProtrude wantsContour)
('layout' minItemWidth)
('layout-properties' layoutSpec)
('testing' is:)
('halos and balloon help' haloShowsCoordinateSystem okayToResizeEasily okayToRotateEasily okayToScaleEasily)
('window like behavior' fullScreen resize:)
!

More information about the Cuis-dev mailing list