[squeak-dev] The Trunk: Morphic-mt.1724.mczcommits at source.squeak.org commits at source.squeak.orgSat Feb 20 11:46:59 UTC 2021
Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1724.mcz ==================== Summary ==================== Name: Morphic-mt.1724 Author: mt Time: 20 February 2021, 12:46:52.542759 pm UUID: 635e4922-d576-8b43-b47e-6529b967d1a4 Ancestors: Morphic-mt.1723 Extracts gridding from PasteUpMorph as new layout policy: GridLayout -- so that it is available to any morph. - Adjust drag implementation in resizer-grips and splitters to be relative to the mouse-down position to make gridding feel better - Adds "self disableLayout: true" to avoid gridding in overlay morphs such as dialogs, flaps, balloons, menus - Adds new preference(s) for enabling the project world's grid - Inst var "griddingOn" no longer needed in PasteUpMorph - Removes all those scattered "gridPoint:" calls bc. layout policy takes care of that now - Some code clean-up in table-layout properties - Documents an interesting bug in HandMorph >> #handleEvent:, which is not caused by this change =============== Diff against Morphic-mt.1723 =============== Item was changed: ----- Method: AbstractResizerMorph>>mouseDown: (in category 'event handling') ----- mouseDown: anEvent + self referencePoint: anEvent position - self position.! - self referencePoint: anEvent position.! Item was changed: ----- Method: BalloonMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. + self disableLayout: true. "" self beSmoothCurve. offsetFromTarget := 0 @ 0. self setDefaultParameters.! Item was changed: ----- Method: BorderedMorph>>doFastWindowReframe: (in category 'resize handling') ----- doFastWindowReframe: ptName | newBounds delta | "For fast display, only higlight the rectangle during loop" newBounds := self bounds newRectButtonPressedDo: [:f | f withSideOrCorner: ptName setToPoint: (self pointFromWorld: Sensor cursorPoint) minExtent: self minimumExtent]. delta := newBounds origin - self bounds origin. self bounds: newBounds. self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2." self allOwnersDo: [:owner | + (owner layoutPolicy notNil and: [owner ~~ Project current world]) + ifTrue: [owner topLeft: owner topLeft + delta]]. - owner layoutPolicy ifNotNil: [owner topLeft: owner topLeft + delta]]. ^newBounds.! Item was changed: ----- Method: BottomLeftGripMorph>>apply: (in category 'target resize') ----- apply: delta | oldBounds | oldBounds := self target bounds. self target bounds: (oldBounds origin + (delta x @ 0) corner: oldBounds corner + (0 @ delta y)). self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2." self target allOwnersDo: [:owner | + (owner layoutPolicy notNil and: [owner ~~ Project current world]) + ifTrue: [owner left: owner left + delta x]].! - owner layoutPolicy ifNotNil: [owner left: owner left + delta x]].! Item was changed: ----- Method: CornerGripMorph>>mouseMove: (in category 'event handling') ----- mouseMove: anEvent | delta | self target ifNil: [^ self]. self target fastFramingOn ifTrue: [delta := self target doFastWindowReframe: self ptName] ifFalse: [ + delta := anEvent position - (self referencePoint + self position). - delta := self referencePoint ifNil: [0 at 0] ifNotNil: [anEvent position - self referencePoint]. - self referencePoint: anEvent position. self apply: delta. self bounds: (self bounds origin + delta extent: self bounds extent)].! Item was changed: ----- Method: DialogWindow>>createFilter (in category 'initialization') ----- createFilter "This is an invisible morph that catches keystrokes to filter content in multiple widgets at once. Needs #filterEnabled to be true." filterMorph := '' asText asMorph lock. filterMorph name: 'Filter'; visible: false; + disableLayout: true. - disableTableLayout: true. ^ filterMorph! Item was changed: ----- Method: DialogWindow>>initialize (in category 'initialization') ----- initialize super initialize. self changeTableLayout; listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap; rubberBandCells: true; + disableLayout: true; setProperty: #indicateKeyboardFocus toValue: #never. self createTitle: 'Dialog'. self createBody. self setDefaultParameters. keyMap := Dictionary new. exclusive := true. autoCancel := false. preferredPosition := self currentWorld center.! Item was changed: ----- Method: DialogWindow>>updateFilter (in category 'updating') ----- updateFilter self buttons do: [:ea | ea enabled: (self filter isEmpty or: [ea label asString includesSubstring: self filter caseSensitive: false])]. filterMorph visible: self filter notEmpty; + disableLayout: self filter isEmpty; - disableTableLayout: self filter isEmpty; contents: '<', self filter, '>'; textColor: self messageMorph textColor. self ensureSelectedButton.! Item was added: + LayoutPolicy subclass: #GridLayout + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Layouts'! Item was added: + ----- Method: GridLayout>>griddedPoint:in: (in category 'layout') ----- + griddedPoint: ungriddedPoint in: container + "For convenience only. Manually grid a point from the outside." + + | properties | + properties := container assureGridLayoutProperties. + ^ ((ungriddedPoint - container position - properties origin) + grid: properties modulus) + + container position + properties origin! Item was added: + ----- Method: GridLayout>>isGridLayout (in category 'testing') ----- + isGridLayout + + ^ true! Item was added: + ----- Method: GridLayout>>layout:in: (in category 'layout') ----- + layout: container in: box + "Moves and resizes the container's submorphs to snap to the grid cells. Ignore edge-adhereing morphs such as docking bars." + + | properties cellOrigin cellExtent | + properties := container assureGridLayoutProperties. + container submorphsDo: [:morph | + (morph disableLayout or: [morph hasProperty: #edgeToAdhereTo]) ifFalse: [ + cellOrigin := ((morph position - container position - properties origin) + grid: properties modulus) + + container position + properties origin. + cellExtent := (morph extent grid: properties modulus) max: properties modulus "= minExtent". + morph layoutInBounds: (cellOrigin extent: cellExtent) positioning: properties cellPositioning]].! Item was added: + LayoutProperties subclass: #GridLayoutProperties + instanceVariableNames: 'origin modulus layoutInset' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Layouts'! Item was added: + ----- Method: GridLayoutProperties>>includesGridLayoutProperties (in category 'testing') ----- + includesGridLayoutProperties + + ^ true! Item was added: + ----- Method: GridLayoutProperties>>initialize (in category 'initialize') ----- + initialize + + super initialize. + + origin := 0 at 0. + modulus := 8 at 8. + layoutInset := 0.! Item was added: + ----- Method: GridLayoutProperties>>layoutInset (in category 'accessing') ----- + layoutInset + + self flag: #todo. "mt: Move up to LayoutProperties." + ^ layoutInset! Item was added: + ----- Method: GridLayoutProperties>>layoutInset: (in category 'accessing') ----- + layoutInset: anObject + + self flag: #todo. "mt: Move up to LayoutProperties." + layoutInset := anObject.! Item was added: + ----- Method: GridLayoutProperties>>modulus (in category 'accessing') ----- + modulus + + ^ modulus! Item was added: + ----- Method: GridLayoutProperties>>modulus: (in category 'accessing') ----- + modulus: anObject + + modulus := anObject.! Item was added: + ----- Method: GridLayoutProperties>>origin (in category 'accessing') ----- + origin + + self flag: #discuss. "mt: Is this really needed? We could easily configure this through #layoutInset." + ^ origin! Item was added: + ----- Method: GridLayoutProperties>>origin: (in category 'accessing') ----- + origin: anObject + + origin := anObject.! Item was changed: ----- Method: HaloMorph>>doDrag:with: (in category 'private') ----- doDrag: evt with: dragHandle | thePoint | evt hand obtainHalo: self. thePoint := target point: evt position - positionOffset from: owner. + target setConstrainedPosition: thePoint hangOut: true. - target setConstrainedPosition:(target griddedPoint: thePoint) hangOut: true. ! Item was changed: ----- Method: HaloMorph>>doGrow:with: (in category 'private') ----- doGrow: evt with: growHandle "Called while the mouse is down in the grow handle" | newExtent extentToUse scale | evt hand obtainHalo: self. + newExtent := (target pointFromWorld: evt cursorPoint - positionOffset) - newExtent := (target pointFromWorld: (target griddedPoint: evt cursorPoint - positionOffset)) - target topLeft. evt shiftPressed ifTrue: [ scale := (newExtent x / (originalExtent x max: 1)) min: (newExtent y / (originalExtent y max: 1)). newExtent := (originalExtent x * scale) asInteger @ (originalExtent y * scale) asInteger ]. (newExtent x < 1 or: [newExtent y < 1 ]) ifTrue: [^ self]. target renderedMorph setExtentFromHalo: (extentToUse := newExtent). growHandle position: evt cursorPoint - (growHandle extent // 2). self layoutChanged. (self valueOfProperty: #commandInProgress) ifNotNil: [:cmd | "Update the final extent" cmd redoTarget: target renderedMorph selector: #setFlexExtentFromHalo: argument: extentToUse] ! Item was changed: ----- Method: HandMorph>>griddedPoint: (in category 'gridded cursor') ----- griddedPoint: aPoint "return the equivalent point snapped to the grid, if indeed any gridding is set" + self valueOfProperty: #gridStep ifPresentDo: [:step | | offset | - self valueOfProperty: #gridStep ifPresentDo: [:grid| |offset| offset := self valueOfProperty: #gridOffset ifAbsent: [0 at 0]. + ^ ((aPoint + targetOffset - offset) grid: step) - targetOffset + offset]. - ^ offset + (aPoint + (grid //2) - offset truncateTo: grid)]. ^aPoint! Item was added: + ----- Method: HandMorph>>griddingOn (in category 'gridded cursor') ----- + griddingOn + + ^ self hasSubmorphs + and: [(self hasProperty: #gridStep) + and: [self firstSubmorph disableLayout not]]! Item was changed: ----- Method: HandMorph>>handleEvent: (in category 'events-processing') ----- handleEvent: unfilteredEvent | filteredEvent | owner ifNil: [^ unfilteredEvent "not necessary but good style -- see Morph >> #handleEvent:"]. self logEvent: unfilteredEvent. "Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process." unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent]. self showEvent: unfilteredEvent. self sendListenEvents: unfilteredEvent. filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil. "filteredEvent := unfilteredEvent" " <-- use this to disable global capture filters" filteredEvent wasIgnored ifTrue: [ self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent]. filteredEvent isWindowEvent ifTrue: [ self sendEvent: filteredEvent focus: nil. self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent]. filteredEvent isKeyboard ifTrue:[ self sendKeyboardEvent: filteredEvent. self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent]. filteredEvent isDropEvent ifTrue:[ self sendEvent: filteredEvent focus: nil. self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent]. filteredEvent isMouse ifFalse: [ self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent]. " ********** MOUSE EVENT *********** " lastMouseEvent := filteredEvent. "Check for pending drag or double click operations." mouseClickState ifNotNil:[ (mouseClickState handleEvent: filteredEvent from: self) ifFalse:[ "Possibly dispatched #click: or something and will not re-establish otherwise" self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent]]. filteredEvent isMouseWheel ifTrue: [ self class sendMouseWheelToKeyboardFocus ifFalse: [self sendMouseEvent: filteredEvent] ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]]. self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent]. filteredEvent isMove ifTrue:[ self position: filteredEvent position. self sendMouseEvent: filteredEvent. self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent]. "Issue a synthetic move event if we're not at the position of the event" + self flag: #bug. "mt: Incompatible with how #mouseMove: is handled when #wantsEveryMouseMove: answers false. Handler might think that #mouseDown: was already received. For example, TextEditor and HaloMorph will issue drags in their #mouseMove: based on old data. That is, the first #mouseMove: appears to come before #mouseDown: while actually sent due to #moveToEvent:." filteredEvent position = self position ifFalse: [self moveToEvent: filteredEvent]. "Drop submorphs on button events" self hasSubmorphs ifTrue:[self dropMorphs: filteredEvent] ifFalse:[self sendMouseEvent: filteredEvent]. self mouseOverHandler processMouseOver: lastMouseEvent. ^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:" ! Item was changed: ----- Method: HandMorph>>position: (in category 'geometry') ----- + position: ungriddedPosition - position: aPoint "Overridden to align submorph origins to the grid if gridding is on." | adjustedPosition delta box | + adjustedPosition := ungriddedPosition. + self griddingOn + ifTrue: [adjustedPosition := self griddedPoint: ungriddedPosition]. + temporaryCursor + ifNotNil: [adjustedPosition := adjustedPosition + temporaryCursorOffset]. - adjustedPosition := aPoint. - temporaryCursor ifNotNil: [adjustedPosition := (self griddedPoint: adjustedPosition) + temporaryCursorOffset]. "Copied from Morph to avoid owner layoutChanged" "Change the position of this morph and and all of its submorphs." delta := adjustedPosition - bounds topLeft. delta isZero ifTrue: [^ self]. "Null change" box := self fullBounds. (delta dotProduct: delta) > 100 ifTrue:[ "e.g., more than 10 pixels moved" self invalidRect: box. self invalidRect: (box translateBy: delta). ] ifFalse:[ self invalidRect: (box merge: (box translateBy: delta)). ]. self privateFullMoveBy: delta. ! Item was added: + ----- Method: HandMorph>>turnOnGridding (in category 'gridded cursor') ----- + turnOnGridding + + self + gridTo: self world gridModulus + origin: self world gridOrigin.! Item was changed: ----- Method: HandleMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self extent: 16 @ 16. + self disableLayout: true.! - ! Item was added: + ----- Method: LayoutPolicy>>isGridLayout (in category 'testing') ----- + isGridLayout + + ^ false! Item was added: + ----- Method: LayoutProperties>>asGridLayoutProperties (in category 'converting') ----- + asGridLayoutProperties + + ^ GridLayoutProperties new + hResizing: self hResizing; + vResizing: self vResizing; + disableLayout: self disableLayout; + yourself! Item was changed: ----- Method: LayoutProperties>>asTableLayoutProperties (in category 'converting') ----- asTableLayoutProperties + + ^ TableLayoutProperties new - ^(TableLayoutProperties new) hResizing: self hResizing; vResizing: self vResizing; + disableLayout: self disableLayout; - disableTableLayout: self disableTableLayout; yourself! Item was changed: + ----- Method: LayoutProperties>>cellGap (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>cellGap (in category 'table defaults') ----- cellGap "Default" ^0! Item was changed: + ----- Method: LayoutProperties>>cellInset (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>cellInset (in category 'table defaults') ----- cellInset "Default" ^0! Item was changed: + ----- Method: LayoutProperties>>cellPositioning (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>cellPositioning (in category 'table defaults') ----- cellPositioning ^#center! Item was changed: + ----- Method: LayoutProperties>>cellSpacing (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>cellSpacing (in category 'table defaults') ----- cellSpacing "Default" ^#none! Item was added: + ----- Method: LayoutProperties>>includesGridLayoutProperties (in category 'testing') ----- + includesGridLayoutProperties + + ^ false! Item was added: + ----- Method: LayoutProperties>>includesTableLayoutProperties (in category 'testing') ----- + includesTableLayoutProperties + + ^ false! Item was removed: - ----- Method: LayoutProperties>>includesTableProperties (in category 'testing') ----- - includesTableProperties - ^false! Item was changed: ----- Method: LayoutProperties>>initializeFrom: (in category 'initialize') ----- initializeFrom: defaultProvider "Initialize the receiver from a default provider" + self hResizing: defaultProvider hResizing. self vResizing: defaultProvider vResizing. + self disableLayout: defaultProvider disableLayout.! - self disableTableLayout: defaultProvider disableTableLayout.! Item was changed: + ----- Method: LayoutProperties>>layoutInset (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>layoutInset (in category 'table defaults') ----- layoutInset ^0! Item was changed: + ----- Method: LayoutProperties>>listCentering (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>listCentering (in category 'table defaults') ----- listCentering "Default" ^#topLeft! Item was changed: + ----- Method: LayoutProperties>>listDirection (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>listDirection (in category 'table defaults') ----- listDirection "Default" ^#topToBottom! Item was changed: + ----- Method: LayoutProperties>>listSpacing (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>listSpacing (in category 'table defaults') ----- listSpacing "Default" ^#none! Item was changed: + ----- Method: LayoutProperties>>maxCellSize (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>maxCellSize (in category 'table defaults') ----- maxCellSize ^SmallInteger maxVal! Item was changed: + ----- Method: LayoutProperties>>minCellSize (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>minCellSize (in category 'table defaults') ----- minCellSize ^0! Item was added: + ----- Method: LayoutProperties>>modulus (in category 'defaults - grid layout') ----- + modulus + + ^ 8 at 8! Item was added: + ----- Method: LayoutProperties>>origin (in category 'defaults - grid layout') ----- + origin + + ^ 0 at 0! Item was added: + ----- Method: LayoutProperties>>printOn: (in category 'printing') ----- + printOn: stream + + self flag: #todo. "mt: Find a more readable format. Maybe with line breaks and tabs." + self storeOn: stream.! Item was changed: + ----- Method: LayoutProperties>>reverseTableCells (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>reverseTableCells (in category 'table defaults') ----- reverseTableCells ^false! Item was changed: + ----- Method: LayoutProperties>>rubberBandCells (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>rubberBandCells (in category 'table defaults') ----- rubberBandCells ^false! Item was added: + ----- Method: LayoutProperties>>storeOn: (in category 'printing') ----- + storeOn: stream + + | defaultProperties uniquePropertiesNames | + defaultProperties := self class new. + uniquePropertiesNames := self class allInstVarNames + select: [:name | (self instVarNamed: name) ~= (defaultProperties instVarNamed: name)]. + stream + nextPutAll: '(', self species name; + nextPutAll: ' new'. + uniquePropertiesNames + do: [:name | + stream + nextPutAll: ' ', name, ': '; + store: (self instVarNamed: name); + nextPut: $;]. + stream nextPutAll: ' yourself)'.! Item was removed: - ----- Method: LayoutProperties>>stringWithLayout (in category 'table defaults') ----- - stringWithLayout - | defaultValues uniqueValues | - defaultValues := TableLayoutProperties new. - uniqueValues := self class allInstVarNames - select: [:title | (self instVarNamed: title) - ~= (defaultValues instVarNamed: title)]. - ^ String - streamContents: [:aStream | - aStream nextPutAll: 'TableLayout new; '. - uniqueValues - do: [:title | aStream nextPutAll: title; - nextPut: $:; - space; - - print: (self instVarNamed: title). - (title = uniqueValues last) - ifTrue:[ aStream nextPut:$.] - ifFalse:[ aStream nextPut: $;; cr] - ]]! Item was changed: + ----- Method: LayoutProperties>>wrapCentering (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>wrapCentering (in category 'table defaults') ----- wrapCentering ^#topLeft! Item was changed: + ----- Method: LayoutProperties>>wrapDirection (in category 'defaults - table layout') ----- - ----- Method: LayoutProperties>>wrapDirection (in category 'table defaults') ----- wrapDirection ^#none! Item was changed: ----- Method: LeftGripMorph>>apply: (in category 'target resize') ----- apply: delta | oldBounds | oldBounds := self target bounds. self target bounds: (oldBounds origin + (delta x @ 0) corner: oldBounds corner). self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2." self target allOwnersDo: [:owner | + (owner layoutPolicy notNil and: [owner ~~ Project current world]) + ifTrue: [owner left: owner left + delta x]].! - owner layoutPolicy ifNotNil: [owner left: owner left + delta x]].! Item was changed: ----- Method: MenuMorph>>initialize (in category 'initialization') ----- initialize super initialize. self setDefaultParameters. self changeTableLayout. self listDirection: #topToBottom. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. + self disableLayout: true. defaultTarget := nil. selectedItem := nil. stayUp := false. popUpOwner := nil.! Item was added: + ----- Method: Morph>>assureGridLayoutProperties (in category 'layout properties') ----- + assureGridLayoutProperties + + | assuredProperties | + self layoutProperties + ifNil: [ + self layoutProperties: (assuredProperties := GridLayoutProperties new initializeFrom: self)] + ifNotNil: [:existingProperties | + existingProperties includesGridLayoutProperties + ifTrue: [assuredProperties := existingProperties] + ifFalse: [self layoutProperties: (assuredProperties := existingProperties asGridLayoutProperties)]]. + ^ assuredProperties! Item was changed: + ----- Method: Morph>>assureLayoutProperties (in category 'layout properties') ----- - ----- Method: Morph>>assureLayoutProperties (in category 'layout-properties') ----- assureLayoutProperties | props | props := self layoutProperties. props == self ifTrue:[props := nil]. props ifNil:[ props := LayoutProperties new initializeFrom: self. self layoutProperties: props]. ^props! Item was added: + ----- Method: Morph>>assureTableLayoutProperties (in category 'layout properties') ----- + assureTableLayoutProperties + + | assuredProperties | + self layoutProperties + ifNil: [ + self layoutProperties: (assuredProperties := TableLayoutProperties new initializeFrom: self)] + ifNotNil: [:existingProperties | + existingProperties includesTableLayoutProperties + ifTrue: [assuredProperties := existingProperties] + ifFalse: [self layoutProperties: (assuredProperties := existingProperties asTableLayoutProperties)]]. + ^ assuredProperties! Item was removed: - ----- Method: Morph>>assureTableProperties (in category 'layout-properties') ----- - assureTableProperties - | props | - props := self layoutProperties. - props == self ifTrue:[props := nil]. - props ifNil:[ - props := TableLayoutProperties new initializeFrom: self. - self layoutProperties: props]. - props includesTableProperties - ifFalse:[self layoutProperties: (props := props asTableLayoutProperties)]. - ^props! Item was changed: ----- Method: Morph>>beFlap: (in category 'accessing') ----- beFlap: aBool "Mark the receiver with the #flap property, or unmark it" aBool ifTrue: [self setProperty: #flap toValue: true. + self disableLayout: true. self hResizing: #rigid. self vResizing: #rigid] ifFalse: + [self removeProperty: #flap. + self disableLayout: false]! - [self removeProperty: #flap]! Item was changed: + ----- Method: Morph>>cellGap (in category 'layout properties - table') ----- - ----- Method: Morph>>cellGap (in category 'layout-properties') ----- cellGap "Layout specific. This property specifies an extra space *between* cells in the layout." | props | props := self layoutProperties. ^props ifNil:[0] ifNotNil:[props cellGap].! Item was changed: + ----- Method: Morph>>cellGap: (in category 'layout properties - table') ----- - ----- Method: Morph>>cellGap: (in category 'layout-properties') ----- cellGap: aNumber "Layout specific. This property specifies an extra space *between* cells in the layout." + self assureTableLayoutProperties cellGap: aNumber. - self assureTableProperties cellGap: aNumber. self layoutChanged.! Item was changed: + ----- Method: Morph>>cellInset (in category 'layout properties - table') ----- - ----- Method: Morph>>cellInset (in category 'layout-properties') ----- cellInset "Layout specific. This property specifies an extra inset for each cell in the layout." | props | props := self layoutProperties. ^props ifNil:[0] ifNotNil:[props cellInset].! Item was changed: + ----- Method: Morph>>cellInset: (in category 'layout properties - table') ----- - ----- Method: Morph>>cellInset: (in category 'layout-properties') ----- cellInset: aNumber "Layout specific. This property specifies an extra inset for each cell in the layout." + self assureTableLayoutProperties cellInset: aNumber. - self assureTableProperties cellInset: aNumber. self layoutChanged.! Item was changed: + ----- Method: Morph>>cellPositioning (in category 'layout properties - table') ----- - ----- Method: Morph>>cellPositioning (in category 'layout-properties') ----- cellPositioning "Layout specific. This property describes how the receiver should be layed out in its owner when the bounds of the cell assigned to the receiver do not exactly match its bounds. Possible values are: #topLeft, #topRight, #bottomLeft, #bottomRight, #topCenter, #leftCenter, #rightCenter, #bottomCenter, #center which align the receiver's bounds with the cell at the given point." | props | props := self layoutProperties. ^props ifNil:[#center] ifNotNil:[props cellPositioning].! Item was changed: + ----- Method: Morph>>cellPositioning: (in category 'layout properties - table') ----- - ----- Method: Morph>>cellPositioning: (in category 'layout-properties') ----- cellPositioning: aSymbol "Layout specific. This property describes how the receiver should be layed out in its owner when the bounds of the cell assigned to the receiver do not exactly match its bounds. Possible values are: #topLeft, #topRight, #bottomLeft, #bottomRight, #topCenter, #leftCenter, #rightCenter, #bottomCenter, #center which align the receiver's bounds with the cell at the given point." + self assureTableLayoutProperties cellPositioning: aSymbol. - self assureTableProperties cellPositioning: aSymbol. self layoutChanged.! Item was changed: + ----- Method: Morph>>cellPositioningString: (in category 'layout-menu') ----- - ----- Method: Morph>>cellPositioningString: (in category 'layout-properties') ----- cellPositioningString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self cellPositioning! Item was changed: + ----- Method: Morph>>cellSpacing (in category 'layout properties - table') ----- - ----- Method: Morph>>cellSpacing (in category 'layout-properties') ----- cellSpacing "Layout specific. This property describes how the cell size for each element in a list should be computed. #globalRect - globally equal rectangular cells #globalSquare - globally equal square cells #localRect - locally (e.g., per row/column) equal rectangular cells #localSquare - locally (e.g., per row/column) equal square cells #none - cells are sized based on available row/column constraints " | props | props := self layoutProperties. ^props ifNil:[#none] ifNotNil:[props cellSpacing].! Item was changed: + ----- Method: Morph>>cellSpacing: (in category 'layout properties - table') ----- - ----- Method: Morph>>cellSpacing: (in category 'layout-properties') ----- cellSpacing: aSymbol "Layout specific. This property describes how the cell size for each element in a list should be computed. #globalRect - globally equal rectangular cells #globalSquare - globally equal square cells #localRect - locally (e.g., per row/column) equal rectangular cells #localSquare - locally (e.g., per row/column) equal square cells #none - cells are sized based on available row/column constraints " self checkCellSpacingProperty: aSymbol. + self assureTableLayoutProperties cellSpacing: aSymbol. - self assureTableProperties cellSpacing: aSymbol. self layoutChanged.! Item was changed: + ----- Method: Morph>>cellSpacingString: (in category 'layout-menu') ----- - ----- Method: Morph>>cellSpacingString: (in category 'layout-properties') ----- cellSpacingString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self cellSpacing! Item was changed: + ----- Method: Morph>>copyLayoutProperties (in category 'layout properties') ----- - ----- Method: Morph>>copyLayoutProperties (in category 'layout-properties') ----- copyLayoutProperties + ^[Clipboard clipboardText: self layoutProperties storeString] ifError:[ nil ] ! - ^[Clipboard clipboardText: self layoutProperties stringWithLayout] ifError:[ nil ] ! Item was changed: + ----- Method: Morph>>disableLayout (in category 'layout properties') ----- - ----- Method: Morph>>disableLayout (in category 'layout-properties') ----- disableLayout "Layout specific. Disable laying out the receiver in a layout" | props | props := self layoutProperties. ^props ifNil:[false] ifNotNil:[props disableLayout].! Item was changed: + ----- Method: Morph>>disableLayout: (in category 'layout properties') ----- - ----- Method: Morph>>disableLayout: (in category 'layout-properties') ----- disableLayout: aBool + "Layout specific. Disable laying out the receiver in the owner's layout if any. The receiver's layout (policy) is not affected by this." - "Layout specific. Disable laying out the receiver in a layout" self fullBounds; layoutChanged. self assureLayoutProperties disableLayout: aBool. self fullBounds; layoutChanged; changed.! Item was changed: + ----- Method: Morph>>disableTableLayout (in category 'layout properties') ----- - ----- Method: Morph>>disableTableLayout (in category 'layout-properties') ----- disableTableLayout "Layout specific. Disable laying out the receiver in table layout" | props | props := self layoutProperties. ^props ifNil:[false] ifNotNil:[props disableTableLayout].! Item was changed: + ----- Method: Morph>>disableTableLayout: (in category 'layout properties') ----- - ----- Method: Morph>>disableTableLayout: (in category 'layout-properties') ----- disableTableLayout: aBool "Layout specific. Disable laying out the receiver in table layout" self fullBounds; layoutChanged. self assureLayoutProperties disableTableLayout: aBool. self fullBounds; layoutChanged; changed.! Item was added: + ----- Method: Morph>>gridModulus (in category 'layout properties - grid') ----- + gridModulus + "Layout specific. This property describes how the cell size in the grid." + + ^ self layoutProperties ifNil: [8 at 8] ifNotNil: [:properties | properties modulus]! Item was added: + ----- Method: Morph>>gridModulus: (in category 'layout properties - grid') ----- + gridModulus: aPoint + "Layout specific. This property describes how the cell size in the grid." + + self assureGridLayoutProperties modulus: aPoint. + self layoutChanged.! Item was added: + ----- Method: Morph>>gridOrigin (in category 'layout properties - grid') ----- + gridOrigin + "Layout specific. This property describes the offset in the grid." + + ^ self layoutProperties ifNil: [0 at 0] ifNotNil: [:properties | properties origin]! Item was added: + ----- Method: Morph>>gridOrigin: (in category 'layout properties - grid') ----- + gridOrigin: aPoint + "Layout specific. This property describes the offset in the grid." + + self assureGridLayoutProperties origin: aPoint. + self layoutChanged.! Item was removed: - ----- Method: Morph>>gridPoint: (in category 'geometry - misc') ----- - gridPoint: ungriddedPoint - - ^ ungriddedPoint! Item was removed: - ----- Method: Morph>>griddedPoint: (in category 'geometry - misc') ----- - griddedPoint: ungriddedPoint - - | griddingContext | - self flag: #arNote. "Used by event handling - should transform to pasteUp for gridding" - (griddingContext := self pasteUpMorph) ifNil: [^ ungriddedPoint]. - ^ griddingContext gridPoint: ungriddedPoint! Item was changed: + ----- Method: Morph>>hResizing (in category 'layout properties') ----- - ----- Method: Morph>>hResizing (in category 'layout-properties') ----- hResizing "Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are: #rigid - do not resize the receiver #spaceFill - resize to fill owner's available space #shrinkWrap - resize to fit children " | props | props := self layoutProperties. ^props ifNil:[#rigid] ifNotNil:[props hResizing].! Item was changed: + ----- Method: Morph>>hResizing: (in category 'layout properties') ----- - ----- Method: Morph>>hResizing: (in category 'layout-properties') ----- hResizing: aSymbol "Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are: #rigid - do not resize the receiver #spaceFill - resize to fill owner's available space #shrinkWrap - resize to fit children " self checkResizingProperty: aSymbol. self assureLayoutProperties hResizing: aSymbol. self layoutChanged. ! Item was changed: + ----- Method: Morph>>hResizingString: (in category 'layout-menu') ----- - ----- Method: Morph>>hResizingString: (in category 'layout-properties') ----- hResizingString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self hResizing! Item was changed: + ----- Method: Morph>>layoutFrame (in category 'layout properties - proportional') ----- - ----- Method: Morph>>layoutFrame (in category 'layout-properties') ----- layoutFrame "Layout specific. Return the layout frame describing where the receiver should appear in a proportional layout" ^ extension ifNotNil: [extension layoutFrame]! Item was changed: + ----- Method: Morph>>layoutFrame: (in category 'layout properties - proportional') ----- - ----- Method: Morph>>layoutFrame: (in category 'layout-properties') ----- layoutFrame: aLayoutFrame "Layout specific. Return the layout frame describing where the receiver should appear in a proportional layout" self layoutFrame == aLayoutFrame ifTrue:[^self]. self assureExtension layoutFrame: aLayoutFrame. self layoutChanged.! Item was changed: + ----- Method: Morph>>layoutInset (in category 'layout properties') ----- - ----- Method: Morph>>layoutInset (in category 'layout-properties') ----- layoutInset "Return the extra inset for layouts" | props | props := self layoutProperties. ^props ifNil:[0] ifNotNil:[props layoutInset].! Item was changed: + ----- Method: Morph>>layoutInset: (in category 'layout properties') ----- - ----- Method: Morph>>layoutInset: (in category 'layout-properties') ----- layoutInset: aNumber "Return the extra inset for layouts" + + self flag: #todo. "mt: Change to #assureLayoutProperties." + self assureTableLayoutProperties layoutInset: aNumber. - self assureTableProperties layoutInset: aNumber. self layoutChanged.! Item was changed: + ----- Method: Morph>>layoutPolicy (in category 'layout properties') ----- - ----- Method: Morph>>layoutPolicy (in category 'layout-properties') ----- layoutPolicy "Layout specific. Return the layout policy describing how children of the receiver should appear." ^ extension ifNotNil: [ extension layoutPolicy]! Item was changed: + ----- Method: Morph>>layoutPolicy: (in category 'layout properties') ----- - ----- Method: Morph>>layoutPolicy: (in category 'layout-properties') ----- layoutPolicy: aLayoutPolicy "Layout specific. Return the layout policy describing how children of the receiver should appear." self layoutPolicy == aLayoutPolicy ifTrue:[^self]. self assureExtension layoutPolicy: aLayoutPolicy. self layoutChanged.! Item was changed: + ----- Method: Morph>>layoutProperties (in category 'layout properties') ----- - ----- Method: Morph>>layoutProperties (in category 'layout-properties') ----- layoutProperties "Return the current layout properties associated with the receiver" ^ extension ifNotNil: [ extension layoutProperties]! Item was changed: + ----- Method: Morph>>layoutProperties: (in category 'layout properties') ----- - ----- Method: Morph>>layoutProperties: (in category 'layout-properties') ----- layoutProperties: newProperties "Return the current layout properties associated with the receiver" self layoutProperties == newProperties ifTrue:[^self]. self assureExtension layoutProperties: newProperties. ! Item was changed: + ----- Method: Morph>>listCentering (in category 'layout properties - table') ----- - ----- Method: Morph>>listCentering (in category 'layout-properties') ----- listCentering "Layout specific. This property describes how the rows/columns in a list-like layout should be centered. #topLeft - center at start of primary direction #bottomRight - center at end of primary direction #center - center in the middle of primary direction #justified - insert extra space inbetween rows/columns " | props | props := self layoutProperties. ^props ifNil:[#topLeft] ifNotNil:[props listCentering].! Item was changed: + ----- Method: Morph>>listCentering: (in category 'layout properties - table') ----- - ----- Method: Morph>>listCentering: (in category 'layout-properties') ----- listCentering: aSymbol "Layout specific. This property describes how the rows/columns in a list-like layout should be centered. #topLeft - center at start of primary direction #bottomRight - center at end of primary direction #center - center in the middle of primary direction #justified - insert extra space inbetween rows/columns " + self assureTableLayoutProperties listCentering: aSymbol. - self assureTableProperties listCentering: aSymbol. self layoutChanged.! Item was changed: + ----- Method: Morph>>listCenteringString: (in category 'layout-menu') ----- - ----- Method: Morph>>listCenteringString: (in category 'layout-properties') ----- listCenteringString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self listCentering! Item was changed: + ----- Method: Morph>>listDirection (in category 'layout properties - table') ----- - ----- Method: Morph>>listDirection (in category 'layout-properties') ----- listDirection "Layout specific. This property describes the direction in which a list-like layout should be applied. Possible values are: #leftToRight #rightToLeft #topToBottom #bottomToTop indicating the direction in which any layout should take place" | props | props := self layoutProperties. ^props ifNil:[#topToBottom] ifNotNil:[props listDirection].! Item was changed: + ----- Method: Morph>>listDirection: (in category 'layout properties - table') ----- - ----- Method: Morph>>listDirection: (in category 'layout-properties') ----- listDirection: aSymbol "Layout specific. This property describes the direction in which a list-like layout should be applied. Possible values are: #leftToRight #rightToLeft #topToBottom #bottomToTop indicating the direction in which any layout should take place" + self assureTableLayoutProperties listDirection: aSymbol. - self assureTableProperties listDirection: aSymbol. self layoutChanged.! Item was changed: + ----- Method: Morph>>listDirectionString: (in category 'layout-menu') ----- - ----- Method: Morph>>listDirectionString: (in category 'layout-properties') ----- listDirectionString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self listDirection! Item was changed: + ----- Method: Morph>>listSpacing (in category 'layout properties - table') ----- - ----- Method: Morph>>listSpacing (in category 'layout-properties') ----- listSpacing "Layout specific. This property describes how the heights for different rows in a table layout should be handled. #equal - all rows have the same height #none - all rows may have different heights " | props | props := self layoutProperties. ^props ifNil:[#none] ifNotNil:[props listSpacing].! Item was changed: + ----- Method: Morph>>listSpacing: (in category 'layout properties - table') ----- - ----- Method: Morph>>listSpacing: (in category 'layout-properties') ----- listSpacing: aSymbol "Layout specific. This property describes how the heights for different rows in a table layout should be handled. #equal - all rows have the same height #none - all rows may have different heights " self checkListSpacingProperty: aSymbol. + self assureTableLayoutProperties listSpacing: aSymbol. - self assureTableProperties listSpacing: aSymbol. self layoutChanged.! Item was changed: + ----- Method: Morph>>listSpacingString: (in category 'layout-menu') ----- - ----- Method: Morph>>listSpacingString: (in category 'layout-properties') ----- listSpacingString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self listSpacing! Item was changed: + ----- Method: Morph>>maxCellSize (in category 'layout properties - table') ----- - ----- Method: Morph>>maxCellSize (in category 'layout-properties') ----- maxCellSize "Layout specific. This property specifies the maximum size of a table cell." | props | props := self layoutProperties. ^props ifNil:[SmallInteger maxVal] ifNotNil:[props maxCellSize].! Item was changed: + ----- Method: Morph>>maxCellSize: (in category 'layout properties - table') ----- - ----- Method: Morph>>maxCellSize: (in category 'layout-properties') ----- maxCellSize: aPoint "Layout specific. This property specifies the maximum size of a table cell." + self assureTableLayoutProperties maxCellSize: aPoint. - self assureTableProperties maxCellSize: aPoint. self layoutChanged.! Item was changed: + ----- Method: Morph>>minCellSize (in category 'layout properties - table') ----- - ----- Method: Morph>>minCellSize (in category 'layout-properties') ----- minCellSize "Layout specific. This property specifies the minimal size of a table cell." | props | props := self layoutProperties. ^props ifNil:[0] ifNotNil:[props minCellSize].! Item was changed: + ----- Method: Morph>>minCellSize: (in category 'layout properties - table') ----- - ----- Method: Morph>>minCellSize: (in category 'layout-properties') ----- minCellSize: aPoint "Layout specific. This property specifies the minimal size of a table cell." + self assureTableLayoutProperties minCellSize: aPoint. - self assureTableProperties minCellSize: aPoint. self layoutChanged.! Item was changed: ----- Method: Morph>>resizeMorph: (in category 'meta-actions') ----- resizeMorph: evt | handle | handle := HandleMorph new forEachPointDo: [:newPoint | + self extent: newPoint - self bounds topLeft]. - self extent: (self griddedPoint: newPoint) - self bounds topLeft]. evt hand attachMorph: handle. handle startStepping. ! Item was changed: + ----- Method: Morph>>reverseTableCells (in category 'layout properties - table') ----- - ----- Method: Morph>>reverseTableCells (in category 'layout-properties') ----- reverseTableCells "Layout specific. This property describes if the cells should be treated in reverse order of submorphs." | props | props := self layoutProperties. ^props ifNil:[false] ifNotNil:[props reverseTableCells].! Item was changed: + ----- Method: Morph>>reverseTableCells: (in category 'layout properties - table') ----- - ----- Method: Morph>>reverseTableCells: (in category 'layout-properties') ----- reverseTableCells: aBool "Layout specific. This property describes if the cells should be treated in reverse order of submorphs." + self assureTableLayoutProperties reverseTableCells: aBool. - self assureTableProperties reverseTableCells: aBool. self layoutChanged.! Item was changed: + ----- Method: Morph>>rubberBandCells (in category 'layout properties - table') ----- - ----- Method: Morph>>rubberBandCells (in category 'layout-properties') ----- rubberBandCells "Layout specific. This property describes if a parent that is #shrinkWrapped around its children should ignore any #spaceFill children. E.g., when #rubberBandCells is true, the compound layout will always stay at the smallest available size, even though some child may be able to grow." | props | props := self layoutProperties. ^props ifNil:[false] ifNotNil:[props rubberBandCells].! Item was changed: + ----- Method: Morph>>rubberBandCells: (in category 'layout properties - table') ----- - ----- Method: Morph>>rubberBandCells: (in category 'layout-properties') ----- rubberBandCells: aBool "Layout specific. This property describes if a parent that is #shrinkWrapped around its children should ignore any #spaceFill children. E.g., when #rubberBandCells is true, the compound layout will always stay at the smallest available size, even though some child may be able to grow." + self assureTableLayoutProperties rubberBandCells: aBool. - self assureTableProperties rubberBandCells: aBool. self layoutChanged.! Item was changed: + ----- Method: Morph>>spaceFillWeight (in category 'layout properties - table') ----- - ----- Method: Morph>>spaceFillWeight (in category 'layout-properties') ----- spaceFillWeight "Layout specific. This property describes the relative weight that should be given to the receiver when extra space is distributed between different #spaceFill cells." ^ self valueOfProperty: #spaceFillWeight ifAbsent: [1]! Item was changed: + ----- Method: Morph>>spaceFillWeight: (in category 'layout properties - table') ----- - ----- Method: Morph>>spaceFillWeight: (in category 'layout-properties') ----- spaceFillWeight: aNumber "Layout specific. This property describes the relative weight that should be given to the receiver when extra space is distributed between different #spaceFill cells." aNumber = 1 ifTrue:[self removeProperty: #spaceFillWeight] ifFalse:[self setProperty: #spaceFillWeight toValue: aNumber]. self layoutChanged.! Item was changed: + ----- Method: Morph>>vResizeToFit: (in category 'layout properties') ----- - ----- Method: Morph>>vResizeToFit: (in category 'layout-properties') ----- vResizeToFit: aBoolean aBoolean ifTrue:[ self vResizing: #shrinkWrap. ] ifFalse:[ self vResizing: #rigid. ].! Item was changed: + ----- Method: Morph>>vResizing (in category 'layout properties') ----- - ----- Method: Morph>>vResizing (in category 'layout-properties') ----- vResizing "Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are: #rigid - do not resize the receiver #spaceFill - resize to fill owner's available space #shrinkWrap - resize to fit children " | props | props := self layoutProperties. ^props ifNil:[#rigid] ifNotNil:[props vResizing].! Item was changed: + ----- Method: Morph>>vResizing: (in category 'layout properties') ----- - ----- Method: Morph>>vResizing: (in category 'layout-properties') ----- vResizing: aSymbol "Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are: #rigid - do not resize the receiver #spaceFill - resize to fill owner's available space #shrinkWrap - resize to fit children " self checkResizingProperty: aSymbol. self assureLayoutProperties vResizing: aSymbol. self layoutChanged. ! Item was changed: + ----- Method: Morph>>vResizingString: (in category 'layout-menu') ----- - ----- Method: Morph>>vResizingString: (in category 'layout-properties') ----- vResizingString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self vResizing! Item was changed: + ----- Method: Morph>>wrapCentering (in category 'layout properties - table') ----- - ----- Method: Morph>>wrapCentering (in category 'layout-properties') ----- wrapCentering "Layout specific. This property describes how the rows/columns in a list-like layout should be centered. #topLeft - center at start of secondary direction #bottomRight - center at end of secondary direction #center - center in the middle of secondary direction #justified - insert extra space inbetween rows/columns " | props | props := self layoutProperties. ^props ifNil:[#topLeft] ifNotNil:[props wrapCentering].! Item was changed: + ----- Method: Morph>>wrapCentering: (in category 'layout properties - table') ----- - ----- Method: Morph>>wrapCentering: (in category 'layout-properties') ----- wrapCentering: aSymbol "Layout specific. This property describes how the rows/columns in a list-like layout should be centered. #topLeft - center at start of secondary direction #bottomRight - center at end of secondary direction #center - center in the middle of secondary direction #justified - insert extra space inbetween rows/columns " + self assureTableLayoutProperties wrapCentering: aSymbol. - self assureTableProperties wrapCentering: aSymbol. self layoutChanged.! Item was changed: + ----- Method: Morph>>wrapCenteringString: (in category 'layout-menu') ----- - ----- Method: Morph>>wrapCenteringString: (in category 'layout-properties') ----- wrapCenteringString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self wrapCentering! Item was changed: + ----- Method: Morph>>wrapDirection (in category 'layout properties - table') ----- - ----- Method: Morph>>wrapDirection (in category 'layout-properties') ----- wrapDirection "Layout specific. This property describes the direction along which a list-like layout should be wrapped. Possible values are: #leftToRight #rightToLeft #topToBottom #bottomToTop #none indicating in which direction wrapping should occur. This direction must be orthogonal to the list direction, that is if listDirection is #leftToRight or #rightToLeft then wrapDirection must be #topToBottom or #bottomToTop and vice versa." | props | props := self layoutProperties. ^props ifNil:[#none] ifNotNil:[props wrapDirection].! Item was changed: + ----- Method: Morph>>wrapDirection: (in category 'layout properties - table') ----- - ----- Method: Morph>>wrapDirection: (in category 'layout-properties') ----- wrapDirection: aSymbol "Layout specific. This property describes the direction along which a list-like layout should be wrapped. Possible values are: #leftToRight #rightToLeft #topToBottom #bottomToTop #none indicating in which direction wrapping should occur. This direction must be orthogonal to the list direction, that is if listDirection is #leftToRight or #rightToLeft then wrapDirection must be #topToBottom or #bottomToTop and vice versa." + self assureTableLayoutProperties wrapDirection: aSymbol. - self assureTableProperties wrapDirection: aSymbol. self layoutChanged. ! Item was changed: + ----- Method: Morph>>wrapDirectionString: (in category 'layout-menu') ----- - ----- Method: Morph>>wrapDirectionString: (in category 'layout-properties') ----- wrapDirectionString: aSymbol ^self layoutMenuPropertyString: aSymbol from: self wrapDirection ! Item was added: + ----- Method: MorphicProject class>>applyUserInterfaceTheme (in category 'preferences') ----- + applyUserInterfaceTheme + + self current addDeferredUIMessage: [ + "After all immediate changes where applied, we can reset to values that match the current world configuration:" + self worldGridOrigin: nil. + self worldGridModulus: nil. + self current world griddingOn + ifTrue: [self current world firstHand turnOnGridding]].! Item was added: + ----- Method: MorphicProject class>>worldGridEnabled (in category 'preferences') ----- + worldGridEnabled + <preference: 'Snap Morphs to World Grid' + categoryList: #('Morphic' 'Tools') + description: 'When true, morphs placed in the world will align with a regular grid. This includes tool windows.' + type: #Boolean> + ^ self current isMorphic and: [self current world griddingOn]! Item was added: + ----- Method: MorphicProject class>>worldGridEnabled: (in category 'preferences') ----- + worldGridEnabled: aBooleanOrNil + + (aBooleanOrNil ifNil: [false]) = self current world griddingOn + ifFalse: [self current world griddingOnOff]. + + "Snap to grid when dragging something." + self current world griddingOn + ifTrue: [self current world firstHand turnOnGridding] + ifFalse: [self current world firstHand turnOffGridding].! Item was added: + ----- Method: MorphicProject class>>worldGridModulus (in category 'preferences') ----- + worldGridModulus + <preference: 'World Grid Modulus' + categoryList: #('Morphic' 'Tools') + description: 'Configures the cell extent of the world''s grid, which is useful to accommodate screen resolution and personal style.' + type: #String> + + ^ self current isMorphic + ifFalse: [0 at 0] + ifTrue: [self current world gridModulus]! Item was added: + ----- Method: MorphicProject class>>worldGridModulus: (in category 'preferences') ----- + worldGridModulus: aPointOrCode + + | value | + self current isMorphic ifFalse: [^ self]. + value := (aPointOrCode isString ifTrue: [Compiler evaluate: aPointOrCode]) ifNil: [(self current world clearArea width // 60 "num cells") asPoint]. + value isPoint ifFalse: [^ self]. + self current world gridModulus: value.! Item was added: + ----- Method: MorphicProject class>>worldGridOrigin (in category 'preferences') ----- + worldGridOrigin + <preference: 'World Grid Origin' + categoryList: #('Morphic' 'Tools') + description: 'Configures the offset of the world''s grid, which is useful to accommodate docking bars and other edge-adhering morphs.' + type: #String> + + ^ self current isMorphic + ifFalse: [0 at 0] + ifTrue: [self current world gridOrigin]! Item was added: + ----- Method: MorphicProject class>>worldGridOrigin: (in category 'preferences') ----- + worldGridOrigin: aPointOrCode + + | value | + self current isMorphic ifFalse: [^ self]. + value := (aPointOrCode isString ifTrue: [Compiler evaluate: aPointOrCode]) ifNil: [self current world clearArea origin]. + value isPoint ifFalse: [^ self]. + self current world gridOrigin: value. ! Item was changed: ----- Method: NewBalloonMorph>>initialize (in category 'initialization') ----- initialize super initialize. + self disableLayout: true. self setDefaultParameters. textMorph := TextMorph new wrapFlag: false; lock; yourself. self addMorph: textMorph.! Item was changed: BorderedMorph subclass: #PasteUpMorph + instanceVariableNames: 'presenter model cursor padding backgroundMorph turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState' - instanceVariableNames: 'presenter model cursor padding backgroundMorph turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState griddingOn' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'! !PasteUpMorph commentStamp: '<historical>' prior: 0! A morph whose submorphs comprise a paste-up of rectangular subparts which "show through". Anything called a 'Playfield' is a PasteUpMorph. Facilities commonly needed on pages of graphical presentations and on simulation playfields, such as the painting of new objects, turtle trails, gradient fills, background paintings, parts-bin behavior, collision-detection, etc., are (or will be) provided. A World, the entire Smalltalk screen, is a PasteUpMorph. A World responds true to isWorld. Morph subclasses that have specialized menus (BookMorph) build them in the message addBookMenuItemsTo:hand:. A PasteUpMorph that is a world, builds its menu in HandMorph buildWorldMenu. presenter A Presenter in charge of stopButton stepButton and goButton, mouseOverHalosEnabled soundsEnabled fenceEnabled coloredTilesEnabled. model <not used> cursor ?? padding ?? backgroundMorph A Form that covers the background. turtleTrailsForm Moving submorphs may leave trails on this form. turtlePen Draws the trails. lastTurtlePositions A Dictionary of (aPlayer -> aPoint) so turtle trails can be drawn only once each step cycle. The point is the start of the current stroke. isPartsBin If true, every object dragged out is copied. autoLineLayout ?? indicateCursor ?? resizeToFit ?? wantsMouseOverHalos If true, simply moving the cursor over a submorph brings up its halo. worldState If I am also a World, keeps the hands, damageRecorder, stepList etc. griddingOn If true, submorphs are on a grid ! Item was changed: ----- Method: PasteUpMorph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') ----- acceptDroppingMorph: dropped event: evt "The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied" | aMorph | (self isWorldMorph and: [dropped isTransferMorph and: [dropped dragTransferType = #filesAndDirectories]]) ifTrue: [^ self dropFiles: dropped passenger event: evt]. aMorph := self morphToDropFrom: dropped. self isWorldMorph ifFalse: [super acceptDroppingMorph: aMorph event: evt] ifTrue: ["Add the given morph to this world and start stepping it if it wants to be." aMorph isInWorld ifFalse: [aMorph position: evt position]. self addMorphFront: aMorph. (aMorph fullBounds intersects: self viewBox) ifFalse: [Beeper beep. aMorph position: self bounds center]]. aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]]. aMorph allMorphsDo: "Establish any penDown morphs in new world" [:m | | tfm mm | m player ifNotNil: [m player getPenDown ifTrue: [((mm := m player costume) notNil and: [(tfm := mm owner transformFrom: self) notNil]) ifTrue: [self noteNewLocation: (tfm localPointToGlobal: mm referencePosition) forPlayer: m player]]]]. self isPartsBin ifTrue: [aMorph isPartsDonor: true. aMorph stopSteppingSelfAndSubmorphs. aMorph suspendEventHandler] ifFalse: [self world startSteppingSubmorphsOf: aMorph]. " self presenter morph: aMorph droppedIntoPasteUpMorph: self." - self griddingOn ifTrue: [aMorph position: (self gridPoint: aMorph position)]. self showingListView ifTrue: [self sortSubmorphsBy: (self valueOfProperty: #sortOrder). self currentWorld abandonAllHalos]. self bringTopmostsToFront.! Item was removed: - ----- Method: PasteUpMorph>>gridModulus (in category 'gridding') ----- - gridModulus - - ^ self gridSpec extent! Item was removed: - ----- Method: PasteUpMorph>>gridModulus: (in category 'gridding') ----- - gridModulus: newModulus - - self gridSpecPut: (self gridOrigin extent: newModulus). - self changed! Item was removed: - ----- Method: PasteUpMorph>>gridOrigin (in category 'gridding') ----- - gridOrigin - - ^ self gridSpec origin! Item was removed: - ----- Method: PasteUpMorph>>gridOrigin: (in category 'gridding') ----- - gridOrigin: newOrigin - - ^ self gridSpecPut: (newOrigin extent: self gridModulus)! Item was removed: - ----- Method: PasteUpMorph>>gridPoint: (in category 'geometry') ----- - gridPoint: ungriddedPoint - - self griddingOn ifFalse: [^ ungriddedPoint]. - ^ (ungriddedPoint - self position - self gridOrigin grid: self gridModulus) - + self position + self gridOrigin! Item was removed: - ----- Method: PasteUpMorph>>gridSpec (in category 'gridding') ----- - gridSpec - "Gridding rectangle provides origin and modulus" - - ^ self valueOfProperty: #gridSpec ifAbsent: [0 at 0 extent: 8 at 8]! Item was removed: - ----- Method: PasteUpMorph>>gridSpecPut: (in category 'gridding') ----- - gridSpecPut: newSpec - "Gridding rectangle provides origin and modulus" - - ^ self setProperty: #gridSpec toValue: newSpec! Item was changed: ----- Method: PasteUpMorph>>griddingOn (in category 'gridding') ----- griddingOn + ^ self layoutPolicy notNil and: [self layoutPolicy isGridLayout]! - ^ griddingOn ifNil: [false]! Item was changed: ----- Method: PasteUpMorph>>griddingOnOff (in category 'gridding') ----- griddingOnOff + "Change grid layout. Consider the #clearArea to ignore docking bars and other adhereing morphs." + + self layoutPolicy: (self griddingOn ifFalse: [GridLayout new]).! - - griddingOn := self griddingOn not. - self changed! Item was changed: ----- Method: PolygonMorph>>addHandles (in category 'editing') ----- addHandles "Put moving handles at the vertices. Put adding handles at edge midpoints. Moving over adjacent vertex and dropping will delete a vertex. " | tri | self removeHandles. handles := OrderedCollection new. tri := Array with: 0 @ -4 with: 4 @ 3 with: -3 @ 3. + tri := (tri * RealEstateAgent scaleFactor) truncated. vertices withIndexDo: [:vertPt :vertIndex | | handle | handle := EllipseMorph + newBounds: (Rectangle center: vertPt extent: (8 at 8) * RealEstateAgent scaleFactor) - newBounds: (Rectangle center: vertPt extent: 8 @ 8) color: (self handleColorAt: vertIndex) . + handle disableLayout: true. handle on: #mouseMove send: #dragVertex:event:fromHandle: to: self withValue: vertIndex. handle on: #mouseUp send: #dropVertex:event:fromHandle: to: self withValue: vertIndex. handle on: #click send: #clickVertex:event:fromHandle: to: self withValue: vertIndex. self addMorph: handle. handles addLast: handle. (closed or: [1 = vertices size "Give a small polygon a chance to grow. -wiz" or: [vertIndex < vertices size]]) ifTrue: [| newVert | newVert := PolygonMorph vertices: (tri collect: [:p | p + (vertPt + (vertices atWrap: vertIndex + 1) // 2)]) color: Color green borderWidth: 1 borderColor: Color black. + newVert disableLayout: true. newVert on: #mouseDown send: #newVertex:event:fromHandle: to: self withValue: vertIndex. self addMorph: newVert. handles addLast: newVert]]. self isCurvy ifTrue: [self updateHandles; layoutChanged]. self changed! Item was changed: ----- Method: PolygonMorph>>dragVertex:event:fromHandle: (in category 'editing') ----- dragVertex: ix event: evt fromHandle: handle | p | + p := evt cursorPoint. + self flag: #workaround. "mt: Explicitely check for grid layout in owner to then let the vertex snap to that grid." + (self owner notNil and: [self owner layoutPolicy notNil and: [self owner layoutPolicy isGridLayout]]) + ifTrue: [p := self owner layoutPolicy griddedPoint: p in: self owner]. - p := self isCurve - ifTrue: [evt cursorPoint] - ifFalse: [self griddedPoint: evt cursorPoint]. handle position: p - (handle extent//2). self verticesAt: ix put: p. ! Item was changed: ----- Method: PolygonMorph>>extent: (in category 'geometry') ----- extent: newExtent "Not really advisable, but we can preserve most of the geometry if we don't shrink things too small." + | safeExtent | + (self extent closeTo: newExtent) ifTrue: [^ self]. + safeExtent := newExtent max: self minimumExtent. - | safeExtent center | - center := self referencePosition. - safeExtent := newExtent max: 20 at 20. self setVertices: (vertices collect: + [:p | p - self position * (safeExtent asFloatPoint / (bounds extent max: 1 at 1)) + self position])! - [:p | p - center * (safeExtent asFloatPoint / (bounds extent max: 1 at 1)) + center])! Item was changed: ----- Method: PolygonMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" + self minimumExtent: 20 at 20. vertices := Array with: 5 @ 0 with: 20 @ 10 with: 0 @ 20. closed := true. smoothCurve := false. arrows := #none. self computeBounds! Item was removed: - ----- Method: PolygonMorph>>justDroppedInto:event: (in category 'dropping/grabbing') ----- - justDroppedInto: newOwner event: evt - - | delta | - (newOwner isKindOf: PasteUpMorph) ifTrue: - ["Compensate for border width so that gridded drop - is consistent with gridded drag of handles." - delta := self borderWidth+1//2. - self position: (newOwner gridPoint: self position + delta) - delta]. - ^ super justDroppedInto: newOwner event: evt! Item was changed: ----- Method: ProportionalSplitterMorph>>updateFromEvent: (in category 'events') ----- updateFromEvent: anEvent | delta | + lastMouse ifNil: [ lastMouse := anEvent position - self position ]. - lastMouse ifNil: [ lastMouse := anEvent position ]. delta := splitsTopAndBottom + ifTrue: [ 0 @ ((self normalizedY: anEvent cursorPoint y) - (lastMouse y + self top)) ] + ifFalse: [ (self normalizedX: anEvent cursorPoint x) - (lastMouse x + self left) @ 0 ]. - ifTrue: [ 0 @ ((self normalizedY: anEvent cursorPoint y) - lastMouse y) ] - ifFalse: [ (self normalizedX: anEvent cursorPoint x) - lastMouse x @ 0 ]. - lastMouse := splitsTopAndBottom - ifTrue: [ lastMouse x @ (self normalizedY: anEvent cursorPoint y) ] - ifFalse: [ (self normalizedX: anEvent cursorPoint x) @ lastMouse y ]. self repositionBy: delta! Item was removed: - ----- Method: SelectionMorph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') ----- - aboutToBeGrabbedBy: aHand - slippage := 0 at 0. - ^ super aboutToBeGrabbedBy: aHand - ! Item was changed: ----- Method: SelectionMorph>>extent: (in category 'geometry') ----- extent: newExtent "Set the receiver's extent Extend or contract the receiver's selection to encompass morphs within the new extent." super extent: newExtent. + self selectSubmorphsOf: (self world ifNil: [^ self])! - self selectSubmorphsOf: (self pasteUpMorph ifNil: [^ self])! Item was changed: ----- Method: SelectionMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" selectedItems := OrderedCollection new. + itemsAlreadySelected := OrderedCollection new.! - itemsAlreadySelected := OrderedCollection new. - slippage := 0 @ 0! Item was changed: ----- Method: SelectionMorph>>privateFullMoveBy: (in category 'private') ----- privateFullMoveBy: delta + "Overridden to also move the currently encompassed morphs like they would be my submorphs." + + super privateFullMoveBy: delta. + selectedItems do: [:m | m position: m position + delta]. - - | griddedDelta griddingMorph | - selectedItems isEmpty ifTrue: [^ super privateFullMoveBy: delta]. - griddingMorph := self pasteUpMorph. - griddingMorph ifNil: [^ super privateFullMoveBy: delta]. - griddedDelta := (griddingMorph gridPoint: self position + delta + slippage) - - (griddingMorph gridPoint: self position). - slippage := slippage + (delta - griddedDelta). "keep track of how we lag the true movement." - griddedDelta = (0 at 0) ifTrue: [^ self]. - super privateFullMoveBy: griddedDelta. - selectedItems do: - [:m | m position: (m position + griddedDelta) ] ! Item was added: + ----- Method: SimpleHaloMorph>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + "Each halo is a (kind of global) overlay that should not be bothered with the world's current layout policy. For example, a halo must match the target's bounds, which can be any inner part of the graphical hierarchy." + self disableLayout: true.! Item was changed: ----- Method: SystemWindow>>justDroppedInto:event: (in category 'geometry') ----- justDroppedInto: aMorph event: anEvent isCollapsed ifTrue: [self position: ((self position max: 0 at 0) grid: 8 at 8). collapsedFrame := self bounds] ifFalse: [fullFrame := self bounds]. self beKeyWindow. self hasDropShadow: Preferences menuAppearance3d. "See #startDragFromLabel:." aMorph == self world ifTrue: [self assureLabelAreaVisible]. (Project uiManager openToolsAttachedToMouseCursor and: (self hasProperty: #initialDrop)) ifTrue: [ self removeProperty: #initialDrop. (self submorphs detect: [:m | m isKindOf: BottomRightGripMorph] ifNone: []) ifNotNil: [:grip | grip + referencePoint: anEvent position - grip position; - referencePoint: anEvent position; setProperty: #targetHadDropShadow toValue: true "See MorphicToolBuilder >> #open:". self hasDropShadow: false; lookFocused. anEvent hand newMouseFocus: grip.]]. ^super justDroppedInto: aMorph event: anEvent! Item was changed: ----- Method: TableLayout>>layout:in: (in category 'layout') ----- layout: aMorph in: box "Compute the layout for the given morph based on the new bounds" | cells arrangement horizontal newBounds | aMorph hasSubmorphs ifFalse: [^self]. + properties := aMorph assureTableLayoutProperties. - properties := aMorph assureTableProperties. newBounds := box origin asIntegerPoint corner: box corner asIntegerPoint. (properties wrapDirection == #none and: [properties cellSpacing == #none]) ifTrue: ["get into the fast lane" properties listCentering == #justified ifFalse: ["can't deal with that" properties listDirection == #leftToRight ifTrue: [^self layoutLeftToRight: aMorph in: newBounds]. properties listDirection == #topToBottom ifTrue: [^self layoutTopToBottom: aMorph in: newBounds]]]. horizontal := (properties listDirection == #topToBottom or: [properties listDirection == #bottomToTop]) not. "Step 1: Compute the minimum extent for all the children of aMorph" cells := self computeCellSizes: aMorph in: (0 @ 0 corner: newBounds extent) horizontal: horizontal. "Step 2: Compute the arrangement of the cells for each row and column" arrangement := self computeCellArrangement: cells in: newBounds horizontal: horizontal target: aMorph. "Step 3: Compute the extra spacing for each cell" self computeExtraSpacing: arrangement in: newBounds horizontal: horizontal target: aMorph. "Step 4: Place the children within the cells accordingly" self placeCells: arrangement in: newBounds horizontal: horizontal target: aMorph! Item was changed: ----- Method: TableLayout>>minExtentOf:in: (in category 'layout') ----- minExtentOf: aMorph in: box "Return the minimal size aMorph's children would require given the new bounds" | cells arrangement horizontal newBounds minX minY dir | minExtentCache isNil ifFalse: [^minExtentCache]. aMorph hasSubmorphs ifFalse: [^0 @ 0]. + properties := aMorph assureTableLayoutProperties. - properties := aMorph assureTableProperties. (properties wrapDirection == #none and: [properties cellSpacing == #none]) ifTrue: ["Get into the fast lane" dir := properties listDirection. (dir == #leftToRight or: [dir == #rightToLeft]) ifTrue: [^self minExtentHorizontal: aMorph]. (dir == #topToBottom or: [dir == #bottomToTop]) ifTrue: [^self minExtentVertical: aMorph]]. newBounds := box origin asIntegerPoint corner: box corner asIntegerPoint. horizontal := (properties listDirection == #topToBottom or: [properties listDirection == #bottomToTop]) not. "Step 1: Compute the minimum extent for all the children of aMorph" cells := self computeCellSizes: aMorph in: (0 @ 0 corner: newBounds extent) horizontal: horizontal. "Step 2: Compute the arrangement of the cells for each row and column" arrangement := self computeCellArrangement: cells in: newBounds horizontal: horizontal target: aMorph. "Step 3: Extract the minimum size out of the arrangement" minX := minY := 0. arrangement do: [:cell | minX := minX max: cell cellSize x + cell extraSpace x. minY := minY + cell cellSize y + cell extraSpace y]. minExtentCache := horizontal ifTrue: [minX @ minY] ifFalse: [minY @ minX]. ^minExtentCache! Item was changed: + ----- Method: TableLayoutProperties>>cellGap (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>cellGap (in category 'table defaults') ----- cellGap "ifNil is just for migration of old instances." ^ cellGap ifNil: [0]! Item was changed: + ----- Method: TableLayoutProperties>>cellInset (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>cellInset (in category 'table defaults') ----- cellInset ^cellInset! Item was changed: + ----- Method: TableLayoutProperties>>cellPositioning (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>cellPositioning (in category 'table defaults') ----- cellPositioning ^cellPositioning! Item was changed: + ----- Method: TableLayoutProperties>>cellSpacing (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>cellSpacing (in category 'table defaults') ----- cellSpacing ^cellSpacing! Item was added: + ----- Method: TableLayoutProperties>>includesTableLayoutProperties (in category 'testing') ----- + includesTableLayoutProperties + + ^ true! Item was removed: - ----- Method: TableLayoutProperties>>includesTableProperties (in category 'testing') ----- - includesTableProperties - ^true! Item was changed: + ----- Method: TableLayoutProperties>>layoutInset (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>layoutInset (in category 'table defaults') ----- layoutInset + + self flag: #todo. "mt: Move up to LayoutProperties. Maybe also #cellInset and #cellPositioning because those seem rather independent from the way cells as computed." + ^ layoutInset! - ^layoutInset! Item was changed: ----- Method: TableLayoutProperties>>layoutInset: (in category 'accessing') ----- layoutInset: aNumber + + self flag: #todo. "mt: Move up to LayoutProperties. Maybe also #cellInset and #cellPositioning because those seem rather independent from the way cells as computed." + layoutInset := aNumber.! - layoutInset := aNumber! Item was changed: + ----- Method: TableLayoutProperties>>listCentering (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>listCentering (in category 'table defaults') ----- listCentering ^listCentering! Item was changed: + ----- Method: TableLayoutProperties>>listDirection (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>listDirection (in category 'table defaults') ----- listDirection ^listDirection! Item was changed: + ----- Method: TableLayoutProperties>>listSpacing (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>listSpacing (in category 'table defaults') ----- listSpacing ^listSpacing! Item was changed: + ----- Method: TableLayoutProperties>>maxCellSize (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>maxCellSize (in category 'table defaults') ----- maxCellSize ^maxCellSize! Item was changed: + ----- Method: TableLayoutProperties>>minCellSize (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>minCellSize (in category 'table defaults') ----- minCellSize ^minCellSize! Item was changed: + ----- Method: TableLayoutProperties>>reverseTableCells (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>reverseTableCells (in category 'table defaults') ----- reverseTableCells ^reverseTableCells! Item was changed: + ----- Method: TableLayoutProperties>>rubberBandCells (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>rubberBandCells (in category 'table defaults') ----- rubberBandCells ^rubberBandCells! Item was changed: + ----- Method: TableLayoutProperties>>wrapCentering (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>wrapCentering (in category 'table defaults') ----- wrapCentering ^wrapCentering! Item was changed: + ----- Method: TableLayoutProperties>>wrapDirection (in category 'accessing') ----- - ----- Method: TableLayoutProperties>>wrapDirection (in category 'table defaults') ----- wrapDirection ^wrapDirection! Item was changed: ----- Method: TopGripMorph>>apply: (in category 'target resize') ----- apply: delta | oldBounds | oldBounds := self target bounds. self target bounds: (oldBounds origin + (0 @ delta y) corner: oldBounds corner). self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2." self target allOwnersDo: [:owner | + (owner layoutPolicy notNil and: [owner ~~ Project current world]) + ifTrue: [owner top: owner top + delta y]].! - owner layoutPolicy ifNotNil: [owner top: owner top + delta y]].! Item was changed: ----- Method: TopLeftGripMorph>>apply: (in category 'target resize') ----- apply: delta | oldBounds | oldBounds := self target bounds. self target bounds: (oldBounds origin + delta corner: oldBounds corner). self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2." self target allOwnersDo: [:owner | + (owner layoutPolicy notNil and: [owner ~~ Project current world]) + ifTrue: [owner topLeft: owner topLeft + delta]].! - owner layoutPolicy ifNotNil: [owner topLeft: owner topLeft + delta]].! Item was changed: ----- Method: TopRightGripMorph>>apply: (in category 'target resize') ----- apply: delta | oldBounds | oldBounds := self target bounds. self target bounds: (oldBounds origin + (0 at delta y) corner: oldBounds corner + (delta x @ 0)). self flag: #workaround. "mt: Due to a layout-specific 'let us start in the top-left corner of a layout cell'-behavior, we have to go up the owner chain and propagate the delta. See Morph >> #layoutInBounds:positioning: and there section 1.2." self target allOwnersDo: [:owner | + (owner layoutPolicy notNil and: [owner ~~ Project current world]) + ifTrue: [owner top: owner top + delta y]].! - owner layoutPolicy ifNotNil: [owner top: owner top + delta y]].! Item was changed: ----- Method: TransferMorph>>initialize (in category 'initialization') ----- initialize super initialize. self changeTableLayout; + disableLayout: true; listDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3; cellGap: 3; wrapCentering: #center; cellPositioning: #leftCenter; setProperty: #indicateKeyboardFocus toValue: #never. self doMove. self on: #keyStroke send: #keyStroke: to: self. self on: #keyUp send: #updateFromUserInputEvent: to: self. self on: #keyDown send: #updateFromUserInputEvent: to: self. self setDefaultParameters.!
More information about the Squeak-dev mailing list |