[Cuis-dev] PaddedMorph preview

Mon Sep 9 08:09:43 PDT 2024

I implemented the original suggestion of #padding in a PaddedMorph and 
have the example code attached.

Layered approach with (too) many fileIns.  Do in order.

Workspace code attached.

If anyone gets a chance, good to play with before Wednesday's Meetup.

Good on ya,
-KenD
-------------- next part --------------
'From Cuis7.1 [latest update: #6679] on 8 September 2024 at 1:20:17 pm'!
!classDefinition: #PaddedMorph category: #'Morphic-Kernel'!
BoxedMorph subclass: #PaddedMorph
	instanceVariableNames: 'padding'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Kernel'!

!PaddedMorph commentStamp: '<historical>' prior: 0!
In addition to a border, there is a padding area which acts as a frame around interior contents.

!

!classDefinition: #LayoutMorph category: #'Morphic-Layouts'!
PaddedMorph subclass: #LayoutMorph
	instanceVariableNames: 'direction separation axisEdgeWeight doAdoptWidgetsColor useEdgeSpace '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Layouts'!

!Morph methodsFor: 'accessing' stamp: 'KenD 9/7/2024 20:00:16'!
padding

	"We have no padding (see PaddedMorph).
	 If anyone asks, answer value for no padding"
	^`0 at 0`! !

!BoxedMorph methodsFor: 'geometry' stamp: 'KenD 9/7/2024 20:42:11'!
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 borderWidth * 2)! !

!PaddedMorph methodsFor: 'geometry' stamp: 'KenD 9/7/2024 20:33:57'!
interiorExtent

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

!PaddedMorph methodsFor: 'geometry' stamp: 'KenD 9/8/2024 12:56:27'!
interiorOrigin

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

!PaddedMorph methodsFor: 'geometry' stamp: 'KenD 9/7/2024 20:41:48'!
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)! !

!PaddedMorph methodsFor: 'accessing' stamp: 'KenD 9/7/2024 20:22:38'!
padding

	^padding ifNil: [ 0 at 0 ]! !

!PaddedMorph methodsFor: 'accessing' stamp: 'KenD 9/7/2024 20:12:59'!
padding: numberOrPoint

	padding := ((numberOrPoint class = Point) 
			ifTrue: [numberOrPoint] 
			ifFalse: [numberOrPoint @ numberOrPoint]).
	self morphExtent: (self minimumExtent max: self morphExtent).
	self redrawNeeded! !

!PaddedMorph methodsFor: 'initialization' stamp: 'KenD 9/7/2024 20:11:22'!
initialize

	super initialize.
	padding :=`0 at 0`! !

!classDefinition: #LayoutMorph category: #'Morphic-Layouts'!
PaddedMorph subclass: #LayoutMorph
	instanceVariableNames: 'direction separation axisEdgeWeight doAdoptWidgetsColor useEdgeSpace'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Layouts'!
-------------- next part --------------
'From Cuis7.1 [latest update: #6680] on 8 September 2024 at 2:38:28 pm'!
!classDefinition: #ImageMorph category: #'Morphic-Widgets'!
PaddedMorph subclass: #ImageMorph
	instanceVariableNames: 'image '
	classVariableNames: 'DefaultForm '
	poolDictionaries: ''
	category: 'Morphic-Widgets'!
!classDefinition: #LabelMorph category: #'Morphic-Widgets'!
PaddedMorph subclass: #LabelMorph
	instanceVariableNames: 'font emphasis contents '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!
!classDefinition: #TextParagraphMorph category: #'Morphic-Widgets'!
PaddedMorph subclass: #TextParagraphMorph
	instanceVariableNames: 'textComposition setsHeightOnContent shrinkFromExtent '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!

!LayoutMorph methodsFor: 'geometry' stamp: 'KenD 9/8/2024 12:52: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/8/2024 13:13:06'!
layoutBounds
	"Return the bounds for laying out children of the receiver"

	^ self interiorOrigin extent: self interiorExtent ! !

!ImageMorph methodsFor: 'drawing' stamp: 'KenD 9/8/2024 12:28:10'!
drawOn: aCanvas

	(padding > `0 at 0`) ifTrue: [ 	| innerOrigin |
		"Make use of my color in area between border and image"
		innerOrigin := borderWidth @ borderWidth.
		aCanvas
			fillRectangle:  (innerOrigin extent: extent - (2 * innerOrigin ))
			color:  color].
	(borderWidth > 0) ifTrue: [
		aCanvas
			frameRectangle:  (`0 at 0` extent: extent)
			color:  borderColor
			borderWidth:  borderWidth 
			borderStyleSymbol:  #simple ].
	aCanvas image: image at: self interiorOrigin.
! !

!ImageMorph methodsFor: 'drawing' stamp: 'KenD 9/8/2024 13:02:20'!
minimumExtent
	^image extent + self extentBorder + (2 * self padding)! !

!TextParagraphMorph methodsFor: 'drawing' stamp: 'KenD 9/8/2024 12:35:17'!
drawOn: aCanvas

	aCanvas
		fillRectangle: self localBounds color: color.
	aCanvas
		drawTextComposition: textComposition
		at: self interiorOrigin
		extent: self interiorExtent
		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/8/2024 13:08:10'!
minimumExtent

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

!InnerTextMorph methodsFor: 'drawing' stamp: 'KenD 9/7/2024 20:43:52'!
drawOn: aCanvas
	"Draw the receiver on a canvas"

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

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

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

!classDefinition: #ImageMorph category: #'Morphic-Widgets'!
PaddedMorph subclass: #ImageMorph
	instanceVariableNames: 'image'
	classVariableNames: 'DefaultForm'
	poolDictionaries: ''
	category: 'Morphic-Widgets'!
!classDefinition: #LabelMorph category: #'Morphic-Widgets'!
PaddedMorph subclass: #LabelMorph
	instanceVariableNames: 'font emphasis contents'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!
!classDefinition: #TextParagraphMorph category: #'Morphic-Widgets'!
PaddedMorph subclass: #TextParagraphMorph
	instanceVariableNames: 'textComposition setsHeightOnContent shrinkFromExtent'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Widgets'!
-------------- next part --------------
'From Cuis7.1 [latest update: #6680] on 8 September 2024 at 2:39:48 pm'!

!LabelMorph methodsFor: 'drawing' stamp: 'KenD 9/8/2024 13:06:07'!
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/8/2024 13:05:40'!
minimumExtent

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

-------------- next part --------------
'From Cuis7.1 [latest update: #6682] on 8 September 2024 at 2:50:11 pm'!

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

-------------- next part --------------
'From Cuis7.1 [latest update: #6683] on 8 September 2024 at 3:22:27 pm'!

!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 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! !

-------------- next part --------------
'From Cuis7.1 [latest update: #6684] on 9 September 2024 at 7:50:05 am'!
!classDefinition: #LayoutMorph category: #'Morphic-Layouts'!
PaddedMorph subclass: #LayoutMorph
	instanceVariableNames: 'direction separation axisEdgeWeight doAdoptWidgetsColor useEdgeSpace '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Layouts'!

!LayoutMorph methodsFor: 'initialization' stamp: 'KenD 9/9/2024 07:49:27'!
initialize
	super initialize.
	separation := 0.
	axisEdgeWeight := 0.0.
	padding := `0 at 0`.
	doAdoptWidgetsColor := false! !

!methodRemoval: LayoutMorph #useEdgeSpace stamp: 'KenD 9/9/2024 07:48:53'!
LayoutMorph removeSelector: #useEdgeSpace!
!methodRemoval: LayoutMorph #useEdgeSpace: stamp: 'KenD 9/9/2024 07:48:49'!
LayoutMorph removeSelector: #useEdgeSpace:!
!classDefinition: #LayoutMorph category: #'Morphic-Layouts'!
PaddedMorph subclass: #LayoutMorph
	instanceVariableNames: 'direction separation axisEdgeWeight doAdoptWidgetsColor'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Layouts'!
-------------- next part --------------

labelMorph := LabelMorph new
    borderWidth: 2;
    borderColor: Color red;
    color: Color cyan;
    padding: 0.

imageMorph := ImageMorph new
    borderWidth: 6;
    borderColor: Color green;
    padding: 0.

layoutMorph := LayoutMorph newColumn
    borderWidth: 2;
    borderColor: Color yellow;
    padding: 0;
    separation: 0;
    addMorph: labelMorph;
    addMorph: imageMorph;
    scaleBy: 3;
    openInWorld.

labelMorph padding: 4.
imageMorph padding: 6.
layoutMorph padding: 8.

layoutMorph padding: 0; morphExtent: layoutMorph minimumExtent.
layoutMorph separation: 3.

LayoutMorph exampleEdgesColumn.
LayoutMorph exampleEdgesRow.