Squeak-dev August 2019

squeak-dev@lists.squeakfoundation.org

35 participants
288 discussions

The Trunk: MorphicExtras-mt.257.mcz
by commits＠source.squeak.org 22 Aug '19

22 Aug '19

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-mt.257.mcz ==================== Summary ==================== Name: MorphicExtras-mt.257 Author: mt Time: 22 August 2019, 3:24:32.845931 pm UUID: 5d7d8b41-7ad2-a04a-9230-d8f712f4bdb5 Ancestors: MorphicExtras-tcj.256 Complements Morphic-mt.1506 including cellInset-to-cellGap conversion. =============== Diff against MorphicExtras-tcj.256 =============== Item was changed: ----- Method: ObjectsTool>>initializeToStandAlone (in category 'initialization') ----- initializeToStandAlone "Initialize the receiver so that it can live as a stand-alone morph" + + | buttonPane aBin aColor tabsPane | - | buttonPane aBin aColor heights tabsPane | self basicInitialize. + self + layoutInset: 0; - self layoutInset: 0; - layoutPolicy: ProportionalLayout new; useRoundedCorners; hResizing: #rigid; + vResizing: #shrinkWrap; + extent: RealEstateAgent standardSize; + listDirection: #topToBottom; + wrapDirection: #none. - vResizing: #rigid; - extent: (self minimumWidth @ self minimumHeight). "mode buttons" buttonPane := self paneForTabs: self modeTabs. buttonPane color: self baseBackgroundColor. buttonPane vResizing: #shrinkWrap; setNameTo: 'ButtonPane'; addMorphFront: self dismissButton; addMorphBack: self helpButton; color: (aColor := buttonPane color) darker; layoutInset: 5; - wrapDirection: nil; width: self width; layoutChanged; fullBounds. "Place holder for a tabs or text pane" tabsPane := Morph new. tabsPane color: self baseBackgroundColor; setNameTo: 'TabPane'; + hResizing: #spaceFill; + vResizing: #shrinkWrap. - hResizing: #spaceFill. - heights := { buttonPane height. 40 }. - - buttonPane vResizing: #spaceFill. - self - addMorph: buttonPane - fullFrame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 0) - offsets: (0 @ 0 corner: 0 @ heights first)). - - self - addMorph: tabsPane - fullFrame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 0) - offsets: (0 @ heights first corner: 0 @ (heights first + heights second))). - aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #()) changeTableLayout; listDirection: #leftToRight; wrapDirection: #topToBottom; + vResizing: #shrinkWrap; color: aColor lighter lighter; borderColor: aColor lighter lighter; setNameTo: 'Parts'; dropEnabled: false; - vResizing: #spaceFill; yourself. + + self addMorphBack: buttonPane. + self addMorphBack: tabsPane. + self addMorphBack: aBin. + - self - addMorph: aBin - fullFrame: (LayoutFrame - fractions: (0 @ 0 corner: 1 @ 1) - offsets: (0 @ (heights first + heights second) corner: 0 @ 0)). - - self borderWidth: 1; borderColor: self baseBorderColor; color: self baseBackgroundColor; setNameTo: 'Objects' translated; + showCategories.! - showCategories. - ! Item was changed: ----- Method: ObjectsTool>>initializeWithTabs: (in category 'tabs') ----- initializeWithTabs: tabList "Initialize the receiver to have the given tabs" + | oldPane newPane | oldPane := self tabsPane ifNil: [ self searchPane ]. newPane := (self paneForTabs: tabList) setNameTo: 'TabPane'; yourself. - newPane layoutFrame: oldPane layoutFrame. self replaceSubmorph: oldPane by: newPane. - newPane layoutChanged; fullBounds. - self fixLayoutFrames. ! Item was changed: ----- Method: ObjectsTool>>installQuads:fromButton: (in category 'alphabetic') ----- installQuads: quads fromButton: aButton "Install items in the bottom pane that correspond to the given set of quads, as triggered from the given button" | aPartsBin sortedQuads oldResizing | aPartsBin := self partsBin. oldResizing := aPartsBin vResizing. aPartsBin removeAllMorphs. sortedQuads := ((PartsBin translatedQuads: quads) select: [ :each | Smalltalk hasClassNamed: each first ]) sort: [ :a :b | a third < b third ]. aPartsBin listDirection: #leftToRight quadList: sortedQuads. aButton ifNotNil: [self highlightOnlySubmorph: aButton in: self tabsPane]. aPartsBin vResizing: oldResizing. + aPartsBin layoutChanged; fullBounds.! - aPartsBin layoutChanged; fullBounds. - self isFlap ifFalse: [ self minimizePartsBinSize ].! Item was changed: ----- Method: ObjectsTool>>paneForTabs: (in category 'tabs') ----- paneForTabs: tabList "Answer a pane bearing tabs for the given list" | aPane | tabList do: [:t | t color: Color transparent. t borderWidth: 1; borderColor: Color black]. aPane := Morph new changeTableLayout; color: self baseBackgroundColor; listDirection: #leftToRight; wrapDirection: #topToBottom; vResizing: #spaceFill; hResizing: #spaceFill; + cellGap: 6; - cellInset: 6; layoutInset: 4; listCentering: #center; - listSpacing: #equal; addAllMorphs: tabList; yourself. aPane width: self layoutBounds width. ^ aPane! Item was removed: - ----- Method: ObjectsTool>>position: (in category 'layout') ----- - position: aPoint - "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed" - self position = aPoint ifTrue: [ ^self ]. - super position: aPoint. - self fixLayoutFrames.! Item was changed: ----- Method: ObjectsTool>>showSearchPane (in category 'search') ----- showSearchPane "Set the receiver up so that it shows the search pane" + | tabsPane aPane | - | tabsPane aPane frame | modeSymbol == #search ifTrue: [ ^self ]. self partsBin removeAllMorphs. tabsPane := self tabsPane. aPane := self newSearchPane. - aPane layoutChanged; fullBounds. - - aPane layoutFrame: (frame := tabsPane layoutFrame copy). - frame bottomOffset: (frame topOffset + aPane height). self replaceSubmorph: tabsPane by: aPane. - self partsBin layoutFrame topOffset: frame bottomOffset. self modeSymbol: #search. self showMorphsMatchingSearchString. ActiveHand newKeyboardFocus: aPane! Item was changed: ----- Method: PostscriptCanvas class>>fontSampler (in category 'font mapping') ----- fontSampler "Produces a Postscript .eps file on disk, returns a Morph." "PostscriptCanvas fontSampler" "PostscriptCanvas fontSampler openInWorld" | morph file | morph := Morph new layoutPolicy: TableLayout new; listDirection: #topToBottom; wrapDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: Color white. TextStyle actualTextStyles keysAndValuesDo: [ :styleName :style | { style fontArray first. style fontArray last } do: [ :baseFont | | info | 0 to: 2 do: [ :i | | font string string2 textMorph row | font := baseFont emphasized: i. (i isZero or: [ font ~~ baseFont ]) ifTrue: [ string := font fontNameWithPointSize. row := Morph new layoutPolicy: TableLayout new; listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap; + cellGap: 20@0; - cellSpacing: 20@0; color: Color white. textMorph := TextMorph new hResizing: #spaceFill; backgroundColor: Color white; beAllFont: font; contentsAsIs: string. row addMorphBack: (textMorph imageForm asMorph). info := self postscriptFontInfoForFont: font. string2 := String streamContents: [ :stream | stream nextPutAll: info first; space; print: (font pixelSize * info second) rounded. ]. textMorph := TextMorph new hResizing: #spaceFill; backgroundColor: Color white; beAllFont: font; contentsAsIs: string2. row addMorphBack: textMorph. morph addMorphBack: row. ] ] ] ]. morph bounds: Project current world bounds. morph layoutChanged; fullBounds. file := (FileDirectory default newFileNamed: 'PSFontSampler.eps'). Cursor wait showWhile: [ file nextPutAll: (EPSCanvas morphAsPostscript: morph) ]. ^morph!

1 0

The Trunk: Tools-mt.879.mcz
by commits＠source.squeak.org 22 Aug '19

22 Aug '19

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.879.mcz ==================== Summary ==================== Name: Tools-mt.879 Author: mt Time: 22 August 2019, 3:23:56.181931 pm UUID: 202fe5ca-ec2e-0548-a239-c4eaaee54522 Ancestors: Tools-mt.878 Complements Morphic-mt.1506 including cellInset-to-cellGap conversion. =============== Diff against Tools-mt.878 =============== Item was changed: ----- Method: ArchiveViewer>>createButtonBar (in category 'initialization') ----- createButtonBar | bar | bar := AlignmentMorph newRow. bar color: self defaultBackgroundColor; rubberBandCells: false; vResizing: #shrinkWrap; + cellGap: 6 @ 0. - cellInset: 6 @ 0. #(#('new archive' #canCreateNewArchive #createNewArchive 'Create a new, empty archive and discard this one') #('load archive' #canOpenNewArchive #openNewArchive 'Open another archive and discard this one') #('save archive' #canSaveArchive #saveArchive 'Save this archive under a new name') #('extract all' #canExtractAll #extractAll 'Extract all this archive''s members into a directory') #('add file' #canAddMember #addMember 'Add a file to this archive') #('add clipboard' #canAddMember #addMemberFromClipboard 'Add the contents of the clipboard as a new file') #('add dir ' #canAddMember #addDirectory 'Add the entire contents of a directory, with all of its subdirectories') #('extract member' #canExtractMember #extractMember 'Extract the selected member to a file') #('delete member' #canDeleteMember #deleteMember 'Remove the selected member from this archive') #('rename member' #canRenameMember #renameMember 'Rename the selected member') #('view all' #canViewAllContents #changeViewAll Contents 'Toggle the view of all the selected member''s contents')) do: [:arr | | button | (button := PluggableButtonMorph on: self getState: arr second action: arr third) vResizing: #spaceFill; hResizing: #spaceFill; onColor: self buttonOnColor offColor: self buttonOffColor; label: arr first withCRs; setBalloonText: arr fourth. bar addMorphBack: button]. ^bar! Item was changed: ----- Method: FileList2>>optionalButtonRow (in category 'initialization') ----- optionalButtonRow "Answer the button row associated with a file list" | aRow | aRow := AlignmentMorph newRow beSticky. aRow color: Color transparent. aRow clipSubmorphs: true. + aRow layoutInset: 5@1; cellGap: 6. - aRow layoutInset: 5@1; cellInset: 6. self universalButtonServices do: "just the three sort-by items" [:service | aRow addMorphBack: (service buttonToTriggerIn: self). (service selector == #sortBySize) ifTrue: [aRow addTransparentSpacerOfSize: (4@0)]]. aRow setNameTo: 'buttons'. aRow setProperty: #buttonRow toValue: true. "Used for dynamic retrieval later on" ^ aRow!

1 0

The Trunk: ToolBuilder-Morphic-mt.239.mcz
by commits＠source.squeak.org 22 Aug '19

22 Aug '19

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.239.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.239 Author: mt Time: 22 August 2019, 3:23:14.140931 pm UUID: 58f445df-8248-a143-8d2e-82b27bef37f2 Ancestors: ToolBuilder-Morphic-mt.238 Complements Morphic-mt.1506 including cellInset-to-cellGap conversion. =============== Diff against ToolBuilder-Morphic-mt.238 =============== Item was changed: ----- Method: DialogWindow>>openAsTool (in category '*ToolBuilder-Morphic-opening') ----- openAsTool + - self flag: #dev. - "cm: The following line may no longer be necessary." - preferredPosition isMorph ifFalse: [ self moveToHand ]. ^ self getUserResponse! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableDialog: (in category 'widgets optional') ----- buildPluggableDialog: aSpec | widget | widget := self dialogClass new. self register: widget id: aSpec name. widget model: aSpec model. "Set child dependent layout properties. The pane morph holds the special contents." widget paneMorph wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). self setLayoutHintsFor: widget paneMorph spec: aSpec. widget paneMorph layoutInset: (aSpec padding ifNil: [ProportionalSplitterMorph gripThickness]). + widget paneMorph cellGap: (aSpec spacing ifNil: [ProportionalSplitterMorph gripThickness]). - widget paneMorph cellInset: (aSpec spacing ifNil: [ProportionalSplitterMorph gripThickness]). widget paneMorph wantsPaneSplitters ifTrue: [ widget paneMorph addCornerGrips"addEdgeGrips". widget paneMorph grips do: [:ea | ea showHandle: true]]. "Now create the children." panes := OrderedCollection new. aSpec children isSymbol ifTrue: [ widget getChildrenSelector: aSpec children. widget update: aSpec children] ifFalse: [ self buildAll: aSpec children in: widget paneMorph]. "Now create the buttons." aSpec buttons isSymbol ifTrue: [ widget getButtonsSelector: aSpec buttons. widget update: aSpec buttons] ifFalse: [ self buildAll: aSpec buttons in: widget buttonRowMorph. widget updateButtonProperties]. aSpec title ifNotNil: [:label | label isSymbol ifTrue:[widget getTitleSelector: label; update: label] ifFalse:[widget title: label]]. aSpec message ifNotNil: [:label | label isSymbol ifTrue:[widget getMessageSelector: label; update: label] ifFalse:[widget message: label]]. "Interaction behavior." aSpec autoCancel ifNotNil: [:b | widget autoCancel: b]. aSpec exclusive ifNotNil: [:b | widget exclusive: b]. widget closeDialogSelector: aSpec closeAction. self buildHelpFor: widget spec: aSpec. "Everything is shrink-wrapped around the pane morph." widget paneMorph extent: (aSpec extent ifNil:[widget initialExtent]). ^ widget! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggablePanel: (in category 'widgets required') ----- buildPluggablePanel: aSpec | widget | widget := self panelClass new. self register: widget id: aSpec name. widget model: aSpec model. "Set child dependent layout properties." widget wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [false]). self setLayoutHintsFor: widget spec: aSpec. widget layoutInset: (aSpec padding ifNil: [0]). + widget cellGap: (aSpec spacing ifNil: [ - widget cellInset: (aSpec spacing ifNil: [ widget wantsPaneSplitters ifTrue: [ProportionalSplitterMorph gripThickness] ifFalse: [2]]). "Now create the children." aSpec children isSymbol ifTrue: [ widget getChildrenSelector: aSpec children. widget update: aSpec children] ifFalse: [ self buildAll: aSpec children in: widget]. self setFrame: aSpec frame in: widget. self setLayout: aSpec layout in: widget. parent ifNotNil:[self add: widget to: parent]. widget borderWidth: 0. self buildHelpFor: widget spec: aSpec. widget color: Color transparent. ^ widget! Item was changed: ----- Method: MorphicToolBuilder>>buildPluggableWindow: (in category 'widgets required') ----- buildPluggableWindow: aSpec | widget | aSpec layout == #proportional ifFalse:[ "This needs to be implemented - probably by adding a single pane and then the rest" ^self error: 'Not implemented'. ]. widget := (self windowClassFor: aSpec) new. self register: widget id: aSpec name. widget model: aSpec model. "Set child dependent layout properties." widget wantsPaneSplitters: (aSpec wantsResizeHandles ifNil: [true]). self setLayoutHintsFor: widget spec: aSpec. widget layoutInset: (aSpec padding ifNil: [ProportionalSplitterMorph gripThickness]). + widget cellGap: (aSpec spacing ifNil: [ProportionalSplitterMorph gripThickness]). - widget cellInset: (aSpec spacing ifNil: [ProportionalSplitterMorph gripThickness]). "Now create the children." panes := OrderedCollection new. aSpec children isSymbol ifTrue: [ widget getChildrenSelector: aSpec children. widget update: aSpec children] ifFalse: [ self buildAll: aSpec children in: widget]. widget setUpdatablePanesFrom: panes. aSpec label ifNotNil: [:label| label isSymbol ifTrue:[widget getLabelSelector: label] ifFalse:[widget setLabel: label]]. aSpec multiWindowStyle notNil ifTrue: [widget savedMultiWindowState: (SavedMultiWindowState on: aSpec model)]. widget closeWindowSelector: aSpec closeAction. self buildHelpFor: widget spec: aSpec. widget bounds: (RealEstateAgent initialFrameFor: widget initialExtent: (aSpec extent ifNil:[widget initialExtent]) world: self currentWorld). ^ widget! Item was changed: ----- Method: PluggableCheckBoxMorph>>basicPanel (in category 'installing') ----- basicPanel ^BorderedMorph new beTransparent; extent: 0@0; borderWidth: 0; layoutInset: 0; + cellGap: 0; - cellInset: 0; layoutPolicy: TableLayout new; listCentering: #topLeft; cellPositioning: #center; hResizing: #spaceFill; vResizing: #shrinkWrap; yourself! Item was changed: ----- Method: PluggableDropDownListMorph>>basicPanel (in category 'drawing') ----- basicPanel ^BorderedMorph new beTransparent; extent: 0@0; borderWidth: 0; layoutInset: 0; + cellGap: 0; - cellInset: 0; layoutPolicy: TableLayout new; listCentering: #topLeft; cellPositioning: #center; hResizing: #spaceFill; vResizing: #shrinkWrap; yourself!

1 0

The Trunk: Morphic-mt.1507.mcz
by commits＠source.squeak.org 22 Aug '19

22 Aug '19

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1507.mcz ==================== Summary ==================== Name: Morphic-mt.1507 Author: mt Time: 22 August 2019, 3:22:40.651931 pm UUID: c98ab63c-5f59-2f42-89cd-9296468afd0f Ancestors: Morphic-mt.1506 Complements Morphic-mt.1506 including cellInset-to-cellGap conversion. =============== Diff against Morphic-mt.1506 =============== Item was changed: ----- Method: AlignmentMorph class>>columnPrototype (in category 'instance creation') ----- columnPrototype "Answer a prototypical column" | sampleMorphs aColumn | sampleMorphs := #(red yellow green) collect: [:aColor | Morph new extent: 130 @ 38; color: (Color perform: aColor); setNameTo: aColor asString; yourself]. aColumn := self inAColumn: sampleMorphs. aColumn setNameTo: 'Column'. aColumn color: Color veryVeryLightGray. + aColumn cellGap: 4; layoutInset: 6. - aColumn cellInset: 4; layoutInset: 6. aColumn enableDragNDrop. aColumn setBalloonText: 'Things dropped into here will automatically be organized into a column. Once you have added your own items here, you will want to remove the sample colored rectangles that this started with, and you will want to change this balloon help message to one of your own!!' translated. ^ aColumn! Item was changed: ----- Method: AlignmentMorph class>>rowPrototype (in category 'instance creation') ----- rowPrototype "Answer a prototypical row" | sampleMorphs aRow | sampleMorphs := (1 to: (2 + 3 atRandom)) collect: [:integer | EllipseMorph new extent: ((60 + (20 atRandom)) @ (80 + ((20 atRandom)))); color: Color random; setNameTo: ('egg', integer asString); yourself]. aRow := self inARow: sampleMorphs. aRow setNameTo: 'Row'. aRow enableDragNDrop. + aRow cellGap: 6. - aRow cellInset: 6. aRow layoutInset: 8. aRow setBalloonText: 'Things dropped into here will automatically be organized into a row. Once you have added your own items here, you will want to remove the sample colored eggs that this started with, and you will want to change this balloon help message to one of your own!!' translated. aRow color: Color veryVeryLightGray. ^ aRow "AlignmentMorph rowPrototype openInHand"! Item was changed: ----- Method: BorderedMorph>>addMorph:fullFrame: (in category 'resize handling') ----- addMorph: aMorph fullFrame: aLayoutFrame "Add aMorph according to aLayoutFrame." + self cellGap > 0 ifTrue: [ - self cellInset > 0 ifTrue: [ | left right bottom top spacing | + spacing := self cellGap. - spacing := self cellInset. left := aLayoutFrame leftOffset ifNil: [0]. right := aLayoutFrame rightOffset ifNil: [0]. bottom := aLayoutFrame bottomOffset ifNil: [0]. top := aLayoutFrame topOffset ifNil: [0]. "Add a spacing to the frame if it is not top or leftmost." aLayoutFrame leftFraction = 0 ifFalse: [left := left + spacing] ifTrue: [ "Expect another, resizable widget besides me if I have a fixed width." aLayoutFrame hasFixedWidth ifTrue: [right := right - spacing]]. aLayoutFrame topFraction = 0 ifFalse: [top := top + spacing] ifTrue: [ "Expect another, resizable widget besides me if I have a fixed height." aLayoutFrame hasFixedHeight ifTrue: [bottom := bottom - spacing]]. aLayoutFrame topOffset: top; bottomOffset: bottom; leftOffset: left; rightOffset: right]. super addMorph: aMorph fullFrame: aLayoutFrame. self wantsPaneSplitters ifTrue: [self addPaneSplitters].! Item was changed: ----- Method: DialogWindow>>createBody (in category 'initialization') ----- createBody | body | body := Morph new name: 'Body'; changeTableLayout; hResizing: #shrinkWrap; vResizing: #shrinkWrap; + rubberBandCells: true; listDirection: #topToBottom; - cellPositioning: #topCenter; layoutInset: (10@5 corner: 10@10); + cellGap: 5; - cellInset: 5; color: Color transparent; yourself. body addAllMorphs: {self createMessage: ''. self createPane. self createButtonRow. self createFilter}. self addMorphBack: body.! Item was changed: ----- Method: DialogWindow>>createButtonRow (in category 'initialization') ----- createButtonRow ^ buttonRow := Morph new name: 'Buttons'; color: Color transparent; changeTableLayout; vResizing: #shrinkWrap; hResizing: #spaceFill; listDirection: #leftToRight; listCentering: #center; + cellGap: 5; - cellInset: 5; yourself! Item was changed: ----- Method: DialogWindow>>createTitle: (in category 'initialization') ----- createTitle: aString "Mimick behavior of MenuMorph title creation." | box closeButton menuButton | box := Morph new name: #title; changeTableLayout; listDirection: #leftToRight; - listCentering: #justified; yourself. titleMorph := aString asText asMorph lock. closeButton := SystemWindowButton new color: Color transparent; target: self; extent: 12@12; actionSelector: #cancelDialog; balloonText: 'Cancel this dialog' translated; borderWidth: 0; labelGraphic: SystemWindow closeBoxImage; extent: SystemWindow closeBoxImage extent; visible: self class includeCloseButton; yourself. menuButton := SystemWindowButton new color: Color transparent; target: self; actionSelector: #offerDialogMenu; balloonText: 'Dialog menu' translated; borderWidth: 0; labelGraphic: SystemWindow menuBoxImage; extent: SystemWindow menuBoxImage extent; visible: self class includeControlMenu; yourself. box addAllMorphs: {closeButton. titleMorph. menuButton}. self addMorphBack: box. + self setTitleParameters.! - self setTitleParameters. - ! Item was changed: ----- Method: DialogWindow>>getUserResponse (in category 'running') ----- getUserResponse | hand world | self message ifEmpty: [messageMorph delete]. "Do not waste space." + self paneMorph submorphs + ifEmpty: ["Do not waste space and avoid strange button-row wraps." + self paneMorph delete. + self buttonRowMorph wrapDirection: #none]. - self paneMorph submorphs ifEmpty: [self paneMorph delete]. "Do not waste space." hand := self currentHand. world := self currentWorld. self fullBounds. self moveToPreferredPosition. self openInWorld: world. hand showTemporaryCursor: nil. "Since we are out of context, reset the cursor." hand keyboardFocus in: [:priorKeyboardFocus | hand mouseFocus in: [:priorMouseFocus | self exclusive ifTrue: [hand newMouseFocus: self]. hand newKeyboardFocus: self. [self isInWorld] whileTrue:[world doOneSubCycle]. hand newKeyboardFocus: priorKeyboardFocus. hand newMouseFocus: priorMouseFocus]]. ^ result! Item was changed: ----- Method: DialogWindow>>initialize (in category 'initialization') ----- initialize super initialize. self changeTableLayout; listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap; + rubberBandCells: true; setProperty: #indicateKeyboardFocus toValue: #never. self createTitle: 'Dialog'. self createBody. self setDefaultParameters. keyMap := Dictionary new. exclusive := true. autoCancel := false. preferredPosition := ActiveWorld center.! Item was changed: ----- Method: DialogWindow>>moveToPreferredPosition (in category 'initialization') ----- moveToPreferredPosition self center: (preferredPosition isPoint ifTrue: [ preferredPosition ] + ifFalse: [ self center + self currentHand position - preferredPosition center ]). - ifFalse: [ self center + ActiveHand position - preferredPosition center ]). self bounds: (self bounds translatedToBeWithin: self currentWorld bounds)! Item was changed: ----- Method: DialogWindow>>setMessageParameters (in category 'initialization') ----- setMessageParameters messageMorph ifNotNil: [ | fontToUse colorToUse | fontToUse := self userInterfaceTheme font ifNil: [TextStyle defaultFont]. colorToUse := self userInterfaceTheme textColor ifNil: [Color black]. + + messageMorph + hResizing: #shrinkWrap; + vResizing: #shrinkWrap. + - messageMorph contents addAttribute: (TextFontReference toFont: fontToUse); addAttribute: (TextColor color: colorToUse). + messageMorph textColor: colorToUse].! - messageMorph textColor: colorToUse. - messageMorph releaseParagraph; changed].! Item was changed: ----- Method: DialogWindow>>setTitleParameters (in category 'initialization') ----- setTitleParameters (self submorphNamed: #title) ifNotNil: [:title | title fillStyle: (self class gradientDialog ifFalse: [SolidFillStyle color: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])] ifTrue: [self titleGradientFor: title from: (self userInterfaceTheme titleColor ifNil: [Color r: 0.658 g: 0.678 b: 0.78])]); borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle simple]) copy; borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]); borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]); cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]); vResizing: #shrinkWrap; hResizing: #spaceFill; + cellGap: 5; - wrapCentering: #center; - cellPositioning: #center; - cellInset: 0; layoutInset: (5@3 corner: 5@ (2+(self wantsRoundedCorners ifFalse: [0] ifTrue: [self cornerRadius])))]. titleMorph ifNotNil: [ | fontToUse colorToUse | fontToUse := self userInterfaceTheme titleFont ifNil: [TextStyle defaultFont]. colorToUse := self userInterfaceTheme titleTextColor ifNil: [Color black]. "Temporary HACK for 64-bit CI build. Can be removed in the future." titleMorph contents isText ifFalse: [^ self]. + + titleMorph + hResizing: #spaceFill; + vResizing: #shrinkWrap. titleMorph contents addAttribute: (TextFontReference toFont: fontToUse); + addAttribute: (TextColor color: colorToUse); + addAttribute: TextAlignment centered].! - addAttribute: (TextColor color: colorToUse). - titleMorph releaseParagraph; changed].! Item was changed: ----- Method: DialogWindow>>updateButtonExtent: (in category 'updating') ----- updateButtonExtent: margin "Update all button extents." (buttonRow submorphs collect: [:ea | ea minimumExtent]) max + margin in: [:preferredExtent | buttonRow submorphsDo: [:ea | ea extent: preferredExtent]]. "See if horizontal button layout would be more appropriate." self flag: #magicNumber. "mt: Remove number with computation, maybe choose button font and 20 characters" (buttonRow submorphs collect: [:ea | ea fullBounds width]) sum > 400 ifTrue: [buttonRow hResizing: #shrinkWrap; listDirection: #topToBottom; + wrapDirection: #none; layoutInset: (buttonRow owner fullBounds width - (buttonRow owner layoutInset left*2) - buttonRow submorphs first fullBounds width // 2@0)] ifFalse: [buttonRow hResizing: #spaceFill; listDirection: #leftToRight; + wrapDirection: #topToBottom; layoutInset: 0].! Item was changed: ----- Method: DockingBarItemMorph>>updateLayoutInDockingBar (in category 'private') ----- updateLayoutInDockingBar owner isVertical ifTrue: [ self hResizing: #spaceFill. self vResizing: #shrinkWrap ] ifFalse: [ self hResizing: #shrinkWrap. + self vResizing: #spaceFill ].! - self vResizing: #spaceFill ]. - self extent: self minWidth @ self minHeight! Item was changed: ----- Method: DockingBarMorph>>initialize (in category 'initialize-release') ----- initialize "initialize the receiver" super initialize. self changeTableLayout. selectedItem := nil. activeSubMenu := nil. fillsOwner := true. avoidVisibleBordersAtEdge := true. autoGradient := MenuMorph gradientMenu. self setDefaultParameters ; + rubberBandCells: true ; beFloating ; beSticky ; layoutInset: 0 ; dropEnabled: true! Item was removed: - ----- Method: DockingBarMorph>>noteNewOwner: (in category 'submorphs-accessing') ----- - noteNewOwner: aMorph - "I have just been added as a submorph of aMorph" - super noteNewOwner: aMorph. - - self submorphs - do: [:each | each adjustLayoutBounds]. - ! Item was removed: - ----- Method: DockingBarMorph>>removedMorph: (in category 'submorphs-add/remove') ----- - removedMorph: aMorph - "If this docking bar accepts dropped morphs, it will grow automatically due to its layout policy. Unfortunately, it will not shrink after the removal of any submorph because of the shrinkWrap-spaceFill combination in the vertical axis. To enforce a proper layout update, we can set the docking-bar's extent to a minimum because it fill automatically grow to fit its current contents. Consider this a workaround until we have a better layout policy." - - self flag: #workaround. - self extent: 1@1.! Item was changed: ----- Method: GradientEditor>>addButtonRow (in category 'initialization') ----- addButtonRow | button button2 buttonRow button3 | buttonRow := RectangleMorph new borderWidth: 0; color: Color transparent; layoutPolicy: TableLayout new; hResizing: #spaceFil; vResizing: #spaceFill; cellPositioning: #center; listCentering: #topLeft; listDirection: #LeftToRight; reverseTableCells: true; + cellGap: 4. - cellInset: 4. button := PluggableButtonMorph on: self getState: nil action: #addHandle label: #addColorButtonLabel. button hResizing: #spaceFill; vResizing: #spaceFill. buttonRow addMorph: button. button2 := PluggableButtonMorph on: self getState: nil action: #deleteHandle label: #removeColorButtonLabel. button2 hResizing: #spaceFill; vResizing: #spaceFill. buttonRow addMorph: button2. button3 := PluggableButtonMorph on: self getState: nil action: #delete label: #closeButtonLabel. button3 hResizing: #spaceFill; vResizing: #spaceFill. buttonRow addMorph: button3. self addMorph: buttonRow! Item was changed: ----- Method: GradientEditor>>myLayout (in category 'initialization') ----- myLayout self color: (Color white darker) ; cornerStyle: #rounded ; borderWidth: 0; layoutPolicy: TableLayout new; hResizing: #shrinkWrap; vResizing: #shrinkWrap; cellPositioning: #center; listCentering: #topLeft; layoutInset: 4; listDirection: #topToBottom; reverseTableCells: true; wrapCentering: #topLeft; + cellGap: 4! - cellInset: 4! Item was changed: ----- Method: HSVAColorSelectorMorph>>initialize (in category 'initialization') ----- initialize "Initialize the receiver." super initialize. self extent: 180@168; changeTableLayout; + cellGap: 4; - cellInset: 4; aMorph: self newAColorMorph; hsvMorph: self newHSVColorMorph; addMorphBack: self hsvMorph; addMorphBack: self aMorph. self aMorph color: self hsvMorph selectedColor! Item was changed: ----- Method: HSVColorSelectorMorph>>initialize (in category 'initialization') ----- initialize "Initialize the receiver." super initialize. self borderWidth: 0; changeTableLayout; + cellGap: 4; - cellInset: 4; listDirection: #leftToRight; cellPositioning: #topLeft; svMorph: self newSVColorMorph; hMorph: self newHColorMorph; addMorphBack: self svMorph; addMorphBack: self hMorph; extent: 192@152; hue: 0.5! Item was removed: - ----- Method: MenuItemMorph>>noteNewOwner: (in category 'submorphs-accessing') ----- - noteNewOwner: aMorph - "I have just been added as a submorph of aMorph" - super noteNewOwner: aMorph. - - self updateLayoutInDockingBar! Item was changed: ----- Method: MenuMorph>>initialize (in category 'initialization') ----- initialize super initialize. - bounds := 0 @ 0 corner: 40 @ 10. - self setDefaultParameters. self changeTableLayout. self listDirection: #topToBottom. self hResizing: #shrinkWrap. self vResizing: #shrinkWrap. defaultTarget := nil. selectedItem := nil. stayUp := false. popUpOwner := nil.! Item was changed: ----- Method: MenuMorph>>setTitleParametersFor: (in category 'initialization') ----- setTitleParametersFor: aMenuTitle aMenuTitle color: (self userInterfaceTheme titleColor ifNil: [Color transparent]); borderStyle: (self userInterfaceTheme titleBorderStyle ifNil: [BorderStyle simple]) copy; borderColor: (self userInterfaceTheme titleBorderColor ifNil: [Color r: 0.6 g: 0.7 b: 1]); borderWidth: (self userInterfaceTheme titleBorderWidth ifNil: [0]); cornerStyle: (self wantsRoundedCorners ifTrue: [#rounded] ifFalse: [#square]); vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #center; + cellGap: 5; - cellInset: 5; layoutInset: (5@0 corner: 5@0).! Item was changed: ----- Method: NewColorPickerMorph>>newBottomRow (in category 'initialize-release') ----- newBottomRow ^ Morph new color: Color transparent ; changeTableLayout ; listDirection: #leftToRight ; hResizing: #spaceFill; vResizing: #shrinkWrap ; height: 20 ; + cellGap: 4 ; - cellInset: 4 ; addMorph: (StringMorph contents: 'Current selection:' translated) ; addMorphBack: self newColorPresenterMorph ; addMorphBack: self newCloseButton! Item was changed: ----- Method: NewColorPickerMorph>>setup (in category 'initialize-release') ----- setup self color: (Color white darker) ; cornerStyle: #rounded ; changeTableLayout ; hResizing: #shrinkWrap ; vResizing: #shrinkWrap ; extent: 240@240 ; addMorphBack: hsvaMorph ; addMorphBack: self newColorExpressionMorph ; addMorphBack: self newBottomRow ; layoutInset: 4 ; + cellGap: 2. - cellInset: 2. Preferences menuAppearance3d ifTrue: [self addDropShadow]. ! Item was changed: ----- Method: NewColorPickerMorph>>setupForProperties (in category 'initialize-release') ----- setupForProperties self color: (Color white darker) ; changeTableLayout ; hResizing: #shrinkWrap ; vResizing: #shrinkWrap ; extent: 240@240 ; addMorphBack: hsvaMorph ; layoutInset: 4 ; + cellGap: 2.! - cellInset: 2.! Item was changed: ----- Method: PasteUpMorph>>autoLineLayout: (in category 'options') ----- autoLineLayout: aBoolean "Make the receiver be viewed with auto-line-layout, which means that its submorphs will be laid out left-to-right and then top-to-bottom in the manner of a word processor, or (if aBoolean is false,) cease applying auto-line-layout" aBoolean ifTrue: [self viewingNormally ifTrue: [self saveBoundsOfSubmorphs]]. aBoolean ifTrue:[ self layoutPolicy: TableLayout new. + self layoutInset: 8; cellGap: 4. - self layoutInset: 8; cellInset: 4. self listDirection: #leftToRight; wrapDirection: #topToBottom. ] ifFalse:[ self layoutPolicy: nil. + self layoutInset: 0; cellGap: 0. - self layoutInset: 0; cellInset: 0. ]. ! Item was changed: ----- Method: ScrollBar class>>arrowSamples (in category 'images - samples') ----- arrowSamples "create a set of arrow with different sizes, colors and directions" " ScrollBar arrowSamples. " | column | column := AlignmentMorph newColumn vResizing: #shrinkWrap; hResizing: #shrinkWrap; layoutInset: 1; borderColor: Color black; borderWidth: 0; wrapCentering: #center; cellPositioning: #center; color: Color white; yourself. self sampleSizes do: [:size | | row | row := AlignmentMorph newRow color: Color transparent; vResizing: #shrinkWrap; + cellGap: 2 @ 0; + yourself. - cellInset: 2 @ 0 yourself. self sampleColors do: [:color | #(#top #right #bottom #left ) do: [:direction | row addMorphBack: (ScrollBar arrowOfDirection: direction size: size color: color) asMorph]]. column addMorphBack: row]. column openInHand! Item was changed: ----- Method: ScrollBar class>>boxSamples (in category 'images - samples') ----- boxSamples "create a set of box with different sizes and colors" " ScrollBar boxSamples. " | column | column := AlignmentMorph newColumn vResizing: #shrinkWrap; hResizing: #shrinkWrap; layoutInset: 1; borderColor: Color black; borderWidth: 0; wrapCentering: #center; cellPositioning: #center; color: Color white; yourself. "" self sampleSizes do: [:size | | row | row := AlignmentMorph newRow color: Color transparent; vResizing: #shrinkWrap; + cellGap: 2 @ 0; + yourself. - cellInset: 2 @ 0 yourself. "" self sampleColors do: [:color | row addMorphBack: (ScrollBar boxOfSize: size color: color) asMorph]. "" column addMorphBack: row]. "" "" column openInHand! Item was changed: ----- Method: SystemProgressMorph>>initialize (in category 'initialization') ----- initialize super initialize. activeSlots := 0. bars := Array new: 10. labels := Array new: 10. lock := Semaphore forMutualExclusion. self setDefaultParameters; setProperty: #morphicLayerNumber toValue: self morphicLayerNumber; layoutPolicy: TableLayout new; listDirection: #topToBottom; cellPositioning: #leftCenter; + cellGap: 5; - cellInset: 5; listCentering: #center; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: Inset; minWidth: 150! Item was changed: ----- Method: SystemWindow>>initialize (in category 'initialization') ----- initialize "Initialize a system window. Add label, stripes, etc., if desired" super initialize. self layoutPolicy: ProportionalLayout new. self wantsPaneSplitters: true. self layoutInset: ProportionalSplitterMorph gripThickness. + self cellGap: ProportionalSplitterMorph gripThickness. - self cellInset: ProportionalSplitterMorph gripThickness. self initializeLabelArea. self addCornerGrips. self setDefaultParameters. allowReframeHandles := true. isCollapsed := false. paneMorphs := Array new. mustNotClose := false. updatablePanes := Array new. self initializeKeyboardShortcuts.! Item was changed: ----- Method: SystemWindow>>labelHeight (in category 'label') ----- labelHeight "Answer the height for the window label. The standard behavior is at bottom; a hook is provided so that models can stipulate other heights, in support of various less-window-looking demos." | aHeight | (model notNil and: [model respondsTo: #desiredWindowLabelHeightIn:]) ifTrue: [(aHeight := model desiredWindowLabelHeightIn: self) ifNotNil: [^ aHeight]]. ^ label ifNil: [0] ifNotNil: + [(label height + self cellInset + self cellGap + self layoutInset) max: - [(label height + self cellInset + self layoutInset) max: (collapseBox ifNotNil: [collapseBox height] ifNil: [10])]! Item was changed: ----- Method: TransferMorph>>initialize (in category 'initialization') ----- initialize super initialize. self changeTableLayout; listDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 3; + cellGap: 3; - cellInset: 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.! Item was changed: + (PackageInfo named: 'Morphic') postscript: '"Convert all cell insets to cell gaps." + TableLayoutProperties allInstancesDo: [:ea | + ea cellInset isZero ifFalse: [ + ea + cellGap: (ea cellInset isRectangle ifTrue: [ea cellInset topLeft] ifFalse: [ea cellInset]); + cellInset: 0]].'! - (PackageInfo named: 'Morphic') postscript: '"Added Git Browser to Tools menu" - TheWorldMainDockingBar updateInstances'!

1 0

The Trunk: Morphic-mt.1506.mcz
by commits＠source.squeak.org 22 Aug '19

22 Aug '19

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1506.mcz ==================== Summary ==================== Name: Morphic-mt.1506 Author: mt Time: 22 August 2019, 3:21:14.301931 pm UUID: f552fa72-83f9-0545-b307-97b720eeae6e Ancestors: Morphic-mt.1505 Several layout fixes. See http://forum.world.st/Please-Review-Many-fixes-for-Morphic-s-layout-tp51022…. Brief summary: - Adds #cellGap as layout property - Fixes #cellInset use in table layout - Fixes integration of text morphs in table layouts (i.e., adds height-for-width support to layout algorithm) - Fixes layout cell computation regarding fullBounds vs. bounds, that is, #shrinkWrap is now working as expected :-) - Improves documentation of #doLayoutIn:, #layoutInBounds:, #adjustLayoutBounds, #minExtent - Avoid #invalidRect:from: if you are not #visible - Avoid #layoutChanged propagation if you do #disable(Table)Layout - Adds several convenience messages such as #outerExtent:, #innerPosition: and similar. See 'geometry - layout' message category. - Fixes several layout bugs around ScrollBar, ScrollPane, TransformMorph Overall, visible flickering effects due to incomplete layout computations should not occur anymore. =============== Diff against Morphic-mt.1505 =============== Item was added: + ----- Method: LayoutProperties>>cellGap (in category 'table defaults') ----- + cellGap + "Default" + ^0! Item was added: + ----- Method: LayoutProperties>>disableLayout (in category 'accessing') ----- + disableLayout + ^disableLayout! Item was added: + ----- Method: LayoutProperties>>disableLayout: (in category 'accessing') ----- + disableLayout: aBool + disableLayout := aBool! Item was changed: + ----- Method: Morph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') ----- - ----- Method: Morph>>acceptDroppingMorph:event: (in category 'layout') ----- acceptDroppingMorph: aMorph event: evt "This message is sent when a morph is dropped onto a morph that has agreed to accept the dropped morph by responding 'true' to the wantsDroppedMorph:Event: message. This default implementation just adds the given morph to the receiver." | layout | layout := self layoutPolicy. layout ifNil:[^self addMorph: aMorph]. self privateAddMorph: aMorph atIndex: (layout indexForInserting: aMorph at: evt position in: self).! Item was changed: ----- Method: Morph>>addTableLayoutMenuItems:hand: (in category 'layout-menu') ----- addTableLayoutMenuItems: aMenu hand: aHand | menu sub | menu := MenuMorph new defaultTarget: self. menu addUpdating: #hasReverseCellsString action: #changeReverseCells. menu addUpdating: #hasClipLayoutCellsString action: #changeClipLayoutCells. menu addUpdating: #hasRubberBandCellsString action: #changeRubberBandCells. menu addLine. + menu add: 'change cell gap...' translated action: #changeCellGap:. menu add: 'change cell inset...' translated action: #changeCellInset:. menu add: 'change min cell size...' translated action: #changeMinCellSize:. menu add: 'change max cell size...' translated action: #changeMaxCellSize:. menu addLine. sub := MenuMorph new defaultTarget: self. #(leftToRight rightToLeft topToBottom bottomToTop) do:[:sym| sub addUpdating: #listDirectionString: target: self selector: #changeListDirection: argumentList: (Array with: sym)]. menu add: 'list direction' translated subMenu: sub. sub := MenuMorph new defaultTarget: self. #(none leftToRight rightToLeft topToBottom bottomToTop) do:[:sym| sub addUpdating: #wrapDirectionString: target: self selector: #wrapDirection: argumentList: (Array with: sym)]. menu add: 'wrap direction' translated subMenu: sub. sub := MenuMorph new defaultTarget: self. #(center topLeft topRight bottomLeft bottomRight topCenter leftCenter rightCenter bottomCenter) do:[:sym| sub addUpdating: #cellPositioningString: target: self selector: #cellPositioning: argumentList: (Array with: sym)]. menu add: 'cell positioning' translated subMenu: sub. sub := MenuMorph new defaultTarget: self. #(topLeft bottomRight center justified) do:[:sym| sub addUpdating: #listCenteringString: target: self selector: #listCentering: argumentList: (Array with: sym)]. menu add: 'list centering' translated subMenu: sub. sub := MenuMorph new defaultTarget: self. #(topLeft bottomRight center justified) do:[:sym| sub addUpdating: #wrapCenteringString: target: self selector: #wrapCentering: argumentList: (Array with: sym)]. menu add: 'wrap centering' translated subMenu: sub. sub := MenuMorph new defaultTarget: self. #(none equal) do:[:sym| sub addUpdating: #listSpacingString: target: self selector: #listSpacing: argumentList: (Array with: sym)]. menu add: 'list spacing' translated subMenu: sub. sub := MenuMorph new defaultTarget: self. #(none localRect localSquare globalRect globalSquare) do:[:sym| sub addUpdating: #cellSpacingString: target: self selector: #cellSpacing: argumentList: (Array with: sym)]. menu add: 'cell spacing' translated subMenu: sub. aMenu ifNotNil:[aMenu add: 'table layout' translated subMenu: menu]. ^menu! Item was changed: ----- Method: Morph>>adjustLayoutBounds (in category 'layout') ----- adjustLayoutBounds "Adjust the receivers bounds depending on the resizing strategy imposed" + + | hFit vFit box sbox myExtent myOrigin myBox | - | hFit vFit box myExtent extent | hFit := self hResizing. vFit := self vResizing. (hFit == #shrinkWrap or:[vFit == #shrinkWrap]) ifFalse:[^self]. "not needed" + + (self cellSpacing == #none and: [self listSpacing == #none]) ifFalse: [ + self flag: #todo. "mt: Find a way to make cell sizes accessible from here." + self notify: 'It is not possible to shrink-wrap around submorphs when the layout policy reserves extra cell space. At this point, we have no access to that extra cell space and we do not know whether the submorph did make use of that extra space. So, shrink-wrapping could make the bounds very unstable.\\Please either reset #cellSpacing and #listSpacing - or change the resizing strategy to #rigid or #spaceFill.' withCRs. + ^ self]. + box := self layoutBounds. + sbox := self submorphBoundsForShrinkWrap outsetBy: self cellInset. + myExtent := box extent. + myOrigin := box origin. + hFit == #shrinkWrap ifTrue:[ + myExtent := sbox extent x @ myExtent y. + myOrigin := sbox origin x @ myOrigin y]. + vFit == #shrinkWrap ifTrue:[ + myExtent := myExtent x @ sbox extent y. + myOrigin := myOrigin x @ sbox origin y]. - extent := self submorphBounds corner - box origin. - hFit == #shrinkWrap ifTrue:[myExtent := extent x @ myExtent y]. - vFit == #shrinkWrap ifTrue:[myExtent := myExtent x @ extent y]. "Make sure we don't get smaller than minWidth/minHeight" myExtent x < self minWidth ifTrue:[ myExtent := (myExtent x max: (self minWidth - self bounds width + self layoutBounds width)) @ myExtent y]. myExtent y < self minHeight ifTrue:[ myExtent := myExtent x @ (myExtent y max: (self minHeight - self bounds height + self layoutBounds height))]. + + myBox := myOrigin extent: myExtent. + self setLayoutBoundsFromLayout: myBox.! - self layoutBounds: (box origin extent: myExtent).! Item was changed: + ----- Method: Morph>>align:with: (in category 'geometry - misc') ----- - ----- Method: Morph>>align:with: (in category 'geometry') ----- align: aPoint1 with: aPoint2 "Translate by aPoint2 - aPoint1." ^ self position: self position + (aPoint2 - aPoint1)! Item was changed: + ----- Method: Morph>>bounds:from: (in category 'geometry - local/global') ----- - ----- Method: Morph>>bounds:from: (in category 'geometry') ----- bounds: aRectangle from: referenceMorph "Return the receiver's bounds as seen by aMorphs coordinate frame" owner ifNil: [^ aRectangle]. ^(owner transformFrom: referenceMorph) globalBoundsToLocal: aRectangle ! Item was changed: + ----- Method: Morph>>bounds:in: (in category 'geometry - local/global') ----- - ----- Method: Morph>>bounds:in: (in category 'geometry') ----- bounds: aRectangle in: referenceMorph "Return the receiver's bounds as seen by aMorphs coordinate frame" owner ifNil: [^ aRectangle]. ^(owner transformFrom: referenceMorph) localBoundsToGlobal: aRectangle ! Item was changed: + ----- Method: Morph>>boundsIn: (in category 'geometry - local/global') ----- - ----- Method: Morph>>boundsIn: (in category 'geometry') ----- boundsIn: referenceMorph "Return the receiver's bounds as seen by aMorphs coordinate frame" ^self bounds: self bounds in: referenceMorph! Item was changed: + ----- Method: Morph>>boundsInWorld (in category 'geometry - local/global') ----- - ----- Method: Morph>>boundsInWorld (in category 'geometry') ----- boundsInWorld ^self bounds: self bounds in: self world! Item was added: + ----- 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 added: + ----- Method: Morph>>cellGap: (in category 'layout-properties') ----- + cellGap: aNumber + "Layout specific. This property specifies an extra space *between* cells in the layout." + self assureTableProperties cellGap: aNumber. + self layoutChanged.! Item was changed: ----- 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 assert: aSymbol isSymbol. "Guard against a common mistake." self assureTableProperties cellSpacing: aSymbol. self layoutChanged.! Item was added: + ----- Method: Morph>>changeCellGap: (in category 'layout-menu') ----- + changeCellGap: evt + | handle | + handle := HandleMorph new forEachPointDo:[:newPoint | + self cellGap: (newPoint - evt cursorPoint) asIntegerPoint // 5]. + evt hand attachMorph: handle. + handle startStepping. + ! Item was added: + ----- Method: Morph>>changeHeightForWidth (in category 'layout-menu') ----- + changeHeightForWidth + "Convenience. Configure morphs that do not have a layout policy to be layed out properly in an owner that has such a policy. Tell that owner that I change my height if somebody changes my width." + + self + hResizing: #spaceFill; + vResizing: #shrinkWrap; + wrapDirection: #topToBottom.! Item was changed: ----- Method: Morph>>changeTableLayout (in category 'layout-menu') ----- changeTableLayout | layout | ((layout := self layoutPolicy) notNil and:[layout isTableLayout]) ifTrue:[^self]. "already table layout" + self layoutPolicy: TableLayout new.! - self layoutPolicy: TableLayout new. - self layoutChanged.! Item was added: + ----- Method: Morph>>changeWidthForHeight (in category 'layout-menu') ----- + changeWidthForHeight + "Convenience. Configure morphs that do not have a layout policy to be layed out properly in an owner that has such a policy. Tell that owner that I change my width if somebody changes my height." + + self + hResizing: #shrinkWrap; + vResizing: #spaceFill; + wrapDirection: #leftToRight.! Item was added: + ----- Method: Morph>>changesHeightForWidth (in category 'layout-menu') ----- + changesHeightForWidth + + ^ (self hResizing ~= #shrinkWrap + and: [self vResizing = #shrinkWrap]) + and: [self wrapDirection ~= #none]! Item was added: + ----- Method: Morph>>changesWidthForHeight (in category 'layout-menu') ----- + changesWidthForHeight + + ^ (self hResizing = #shrinkWrap + and: [self vResizing ~= #shrinkWrap]) + and: [self wrapDirection ~= #none]! Item was changed: ----- Method: Morph>>clipSubmorphs: (in category 'drawing') ----- clipSubmorphs: aBool "Drawing specific. If this property is set, clip the receiver's submorphs to the receiver's clipping bounds." + + self fullBounds; changed. + - self invalidRect: self fullBounds. aBool == false ifTrue:[self removeProperty: #clipSubmorphs] ifFalse:[self setProperty: #clipSubmorphs toValue: aBool]. + + self + layoutChanged; + fullBounds; changed.! - self invalidRect: self fullBounds.! Item was added: + ----- 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 added: + ----- Method: Morph>>disableLayout: (in category 'layout-properties') ----- + disableLayout: aBool + "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') ----- disableTableLayout: aBool "Layout specific. Disable laying out the receiver in table layout" + + self fullBounds; layoutChanged. self assureLayoutProperties disableTableLayout: aBool. + self fullBounds; layoutChanged; changed.! - self layoutChanged.! Item was changed: ----- Method: Morph>>doLayoutIn: (in category 'layout') ----- doLayoutIn: layoutBounds "Compute a new layout based on the given layout bounds." + | box priorBounds | + "0) Quick return. No children means no effect in layout policies. Use #minWidth and #minHeight to implement #shrinkWrap for morphs without submorphs." + self hasSubmorphs ifFalse: [^ fullBounds := self outerBounds]. + + "X.1) Prepare redraw. Testing for #bounds or #layoutBounds would be sufficient to figure out if we need an invalidation afterwards but #outerBounds is what we need for all leaf nodes so we use that" - "Note: Testing for #bounds or #layoutBounds would be sufficient to - figure out if we need an invalidation afterwards but #outerBounds - is what we need for all leaf nodes so we use that." - - | layout box priorBounds | priorBounds := self outerBounds. + + "1) Compute the new layout. This goes down the entire morph hierarchy. See #layoutInBounds: and #minExtent, which are the usual layout-policy callbacks." + self layoutPolicy ifNotNil: [:layout | + + "1.1) Compute the new layout." + self removeProperty: #doLayoutAgain. + layout layout: self in: layoutBounds. + + "1.2) Do one additional run on the layout if requested in #layoutInBounds:." + (self hasProperty: #doLayoutAgain) ifTrue: [ + self removeProperty: #doLayoutAgain. + layout flushLayoutCache. + layout layout: self in: layoutBounds]. + self assert: (self hasProperty: #doLayoutAgain) not]. + + "2) Give our children a chance to manually adjust after layout computation. This allows morphs to layout in their owner without having to use a layout policy." + self submorphsDo: [:m | m ownerChanged]. + + "3) Watch out for minimal extent and apply #shrinkWrap constraints." - submorphs isEmpty ifTrue: [^fullBounds := priorBounds]. - "Send #ownerChanged to our children" - submorphs do: [:m | m ownerChanged]. - layout := self layoutPolicy. - layout ifNotNil: [layout layout: self in: layoutBounds]. self adjustLayoutBounds. + + "4) Compute and set the new full bounds. IMPORTANT to finish layout computation." fullBounds := self privateFullBounds. + + "X.2) Redraw." box := self outerBounds. + box = priorBounds ifFalse: [ + self invalidRect: (priorBounds quickMerge: box)].! - box = priorBounds - ifFalse: [self invalidRect: (priorBounds quickMerge: box)]! Item was changed: ----- Method: Morph>>fullBounds (in category 'layout') ----- fullBounds "Return the bounding box of the receiver and all its children. Recompute the layout if necessary." fullBounds ifNotNil:[^fullBounds]. "Errors at this point can be critical so make sure we catch 'em all right" + [self doLayoutIn: self layoutBounds] on: Error, Warning, Halt do:[:ex| - [self doLayoutIn: self layoutBounds] on: Error do:[:ex| "This should do it unless you don't screw up the bounds" fullBounds := bounds. ex pass]. ^fullBounds! Item was changed: + ----- Method: Morph>>fullBoundsInWorld (in category 'geometry - local/global') ----- - ----- Method: Morph>>fullBoundsInWorld (in category 'geometry') ----- fullBoundsInWorld ^self bounds: self fullBounds in: self world! Item was changed: + ----- Method: Morph>>globalPointToLocal: (in category 'geometry - local/global') ----- - ----- Method: Morph>>globalPointToLocal: (in category 'geometry') ----- globalPointToLocal: aPoint ^self point: aPoint from: nil! Item was changed: + ----- Method: Morph>>gridPoint: (in category 'geometry - misc') ----- - ----- Method: Morph>>gridPoint: (in category 'geometry') ----- gridPoint: ungriddedPoint ^ ungriddedPoint! Item was changed: + ----- Method: Morph>>griddedPoint: (in category 'geometry - misc') ----- - ----- Method: Morph>>griddedPoint: (in category 'geometry') ----- 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>>hide (in category 'drawing') ----- hide + + self visible ifTrue: [self visible: false].! - owner ifNil: [^ self]. - self visible ifTrue: [self visible: false. self changed]! Item was changed: + ----- Method: Morph>>innerBounds (in category 'geometry - layout') ----- - ----- Method: Morph>>innerBounds (in category 'geometry') ----- innerBounds "Return the inner rectangle enclosed by the bounds of this morph excluding the space taken by its borders. For an unbordered morph, this is just its bounds." ^ self bounds insetBy: self borderStyle inset! Item was added: + ----- Method: Morph>>innerBounds: (in category 'geometry - layout') ----- + innerBounds: aRectangle + "Set the bounds for laying out children of the receiver. + Note: written so that #innerBounds can be changed without touching this method" + | outer inner | + outer := self bounds. + inner := self innerBounds. + self bounds: (aRectangle origin + (outer origin - inner origin) corner: + aRectangle corner + (outer corner - inner corner)).! Item was added: + ----- Method: Morph>>innerExtent (in category 'geometry - layout') ----- + innerExtent + + ^ self innerBounds extent! Item was added: + ----- Method: Morph>>innerExtent: (in category 'geometry - layout') ----- + innerExtent: aPoint + + self innerBounds: (self innerPosition extent: aPoint).! Item was added: + ----- Method: Morph>>innerPosition (in category 'geometry - layout') ----- + innerPosition + + ^ self innerBounds topLeft! Item was added: + ----- Method: Morph>>innerPosition: (in category 'geometry - layout') ----- + innerPosition: aPoint + + | prior delta | + prior := self innerBounds. + delta := (aPoint - prior topLeft) rounded. + self innerBounds: (prior translateBy: delta).! Item was changed: + ----- Method: Morph>>intersects: (in category 'geometry - local/global') ----- - ----- Method: Morph>>intersects: (in category 'geometry') ----- intersects: aRectangle "Answer whether aRectangle, which is in World coordinates, intersects me." ^self fullBoundsInWorld intersects: aRectangle! Item was changed: ----- Method: Morph>>invalidRect:from: (in category 'change reporting') ----- invalidRect: aRectangle from: aMorph | damageRect | + self visible ifFalse: [ ^self ]. aRectangle hasPositiveExtent ifFalse: [ ^self ]. damageRect := aRectangle. aMorph == self ifFalse:[ "Clip to receiver's clipping bounds if the damage came from a child" self clipSubmorphs ifTrue:[damageRect := aRectangle intersect: self clippingBounds]]. owner ifNotNil: [owner invalidRect: damageRect from: self].! Item was changed: + ----- Method: Morph>>layoutBounds (in category 'geometry - layout') ----- - ----- Method: Morph>>layoutBounds (in category 'layout') ----- layoutBounds "Return the bounds for laying out children of the receiver" | inset box | inset := self layoutInset. box := self innerBounds. inset isZero ifTrue:[^box]. ^box insetBy: inset.! Item was changed: + ----- Method: Morph>>layoutBounds: (in category 'geometry - layout') ----- - ----- Method: Morph>>layoutBounds: (in category 'layout') ----- layoutBounds: aRectangle "Set the bounds for laying out children of the receiver. Note: written so that #layoutBounds can be changed without touching this method" | outer inner | outer := self bounds. inner := self layoutBounds. self bounds: (aRectangle origin + (outer origin - inner origin) corner: aRectangle corner + (outer corner - inner corner)).! Item was changed: ----- Method: Morph>>layoutChanged (in category 'layout') ----- layoutChanged + "Notify my dependents (such as owner and submorphs) about a possible layout change after, for example, a change in position or extent. As a result, the layout will be re-computed for this morph and all its submorphs on the next #fullBounds call." + + "0) Skip duplicate notifications. Only once after every successful layout computation." + fullBounds ifNil: [^self]. + + "1) Clear layout caches." - | layout | - fullBounds ifNil:[^self]. "layout will be recomputed so don't bother" fullBounds := nil. + self layoutPolicy ifNotNil:[:layout | layout flushLayoutCache]. + + "2) Notify all dependents. Note that we do not send #ownerChanged to our submorphs now because we have to ensure that each submorph gets notified *exactly once* right before layout computation. See #doLayoutIn:." + self owner ifNotNil: [:o | self disableLayout ifFalse: [o layoutChanged]].! - layout := self layoutPolicy. - layout ifNotNil:[layout flushLayoutCache]. - owner ifNotNil: [owner layoutChanged]. - "note: does not send #ownerChanged here - we'll do this when computing the new layout"! Item was added: + ----- Method: Morph>>layoutComputed (in category 'layout') ----- + layoutComputed + + ^ fullBounds notNil! Item was added: + ----- Method: Morph>>layoutExtent (in category 'geometry - layout') ----- + layoutExtent + + ^ self layoutBounds extent! Item was added: + ----- Method: Morph>>layoutExtent: (in category 'geometry - layout') ----- + layoutExtent: aPoint + + self layoutBounds: (self layoutPosition extent: aPoint).! Item was changed: ----- Method: Morph>>layoutInBounds: (in category 'layout') ----- layoutInBounds: cellBounds "Layout specific. Apply the given bounds to the receiver after being layed out in its owner." + + | box aSymbol | + "1) We are getting new bounds here but we haven't computed the receiver's layout yet." + self layoutComputed ifFalse:[ + "Although the receiver has reported its #minExtent before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints (see #adjustLayoutBounds) then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds." + + "1.1) Adjust the box for #rigid receiver. Both #spaceFill and #shrinkWrap can use the cellBounds for now, which is important for many space-fills in a row or column to have the same widths (or heights) such as all MenuMorphItems in our MenuMorph." + box := cellBounds origin extent: + (self hResizing == #rigid ifTrue: [self bounds extent x] ifFalse: [cellBounds extent x]) @ + (self vResizing == #rigid ifTrue: [self bounds extent y] ifFalse: [cellBounds extent y]). + + "1.2) Move and resize the receiver to get started." + self + setPositionFromLayout: box origin; + setExtentFromLayout: box extent. + + "1.3) Adjust to layout bounds and do the layout." - | box aSymbol delta | - fullBounds ifNil:["We are getting new bounds here but we haven't computed the receiver's layout yet. Although the receiver has reported its minimal size before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds." - cellBounds origin = self bounds origin ifFalse:[ - box := self outerBounds. - delta := cellBounds origin - self bounds origin. - self invalidRect: (box merge: (box translateBy: delta)). - self privateFullMoveBy: delta]. "sigh..." - box := cellBounds origin extent: "adjust for #rigid receiver" - (self hResizing == #rigid ifTrue:[self bounds extent x] ifFalse:[cellBounds extent x]) @ - (self vResizing == #rigid ifTrue:[self bounds extent y] ifFalse:[cellBounds extent y]). - "Compute inset of layout bounds" box := box origin - (self bounds origin - self layoutBounds origin) corner: box corner - (self bounds corner - self layoutBounds corner). - "And do the layout within the new bounds" - self layoutBounds: box. self doLayoutIn: box]. + + " self assert: self layoutComputed. + self assert: self owner layoutComputed not. + " + "2) Are we done already?" + cellBounds extent = self bounds extent + "Nice fit. I usually am done here if #minExtent did already trigger layout update (via #fullBounds) while my owner's layout was calculating the cell sizes." + ifTrue:[^ self setPositionFromLayout: cellBounds origin]. + + "3) We have the receiver's layout. Maybe we just computed it or we did not invalidate it in this run. The latter happens if our owner invalidates without telling us. The user dragging size grips in windows, for example. Now we have to consider #spaceFill constraints, which may trigger re-computation of the receiver's layout." + box := self bounds. - cellBounds = self fullBounds ifTrue:[^self]. "already up to date" - cellBounds extent = self fullBounds extent "nice fit" - ifTrue:[^self position: cellBounds origin]. - box := bounds. - "match #spaceFill constraints" self hResizing == #spaceFill + ifTrue: [ + "Support dynamic width-for-height due to space-fill constraint -- another layout run needed?" + (box width ~= cellBounds width and: [self vResizing == #shrinkWrap]) + ifTrue: [self owner ifNotNil: [:o | o setProperty: #doLayoutAgain toValue: true]]. + "Fill the cell." + box := box origin extent: cellBounds width @ box height]. + - ifTrue:[box := box origin extent: cellBounds width @ box height]. self vResizing == #spaceFill + ifTrue: [ + "Support dynamic height-for-width due to space-fill constraint -- another layout run needed?" + (box height ~= cellBounds height and: [self hResizing == #shrinkWrap]) + ifTrue: [self owner ifNotNil: [:o | o setProperty: #doLayoutAgain toValue: true]]. + "Fill the cell." + box := box origin extent: box width @ cellBounds height]. + + "4) We have the receiver's layout. Align in the cell according o the owners layout properties." + self flag: #refactor. "mt: #layoutInBounds: should also provide cellPositioning, not only cellBounds. There should be no need to access the owner in this method." + aSymbol := self owner ifNil: [#center] ifNotNil: [:o | o cellPositioning]. - ifTrue:[box := box origin extent: box width @ cellBounds height]. - "align accordingly" - aSymbol := (owner ifNil:[self]) cellPositioning. box := box align: (box perform: aSymbol) with: (cellBounds perform: aSymbol). + + " self assert: self layoutComputed. + self assert: self owner layoutComputed not. + " + "5) Install the new bounds. This may invalidate my layout again, which is okay because my owner will ask about my fullBounds in #doLayoutIn: (and #privateFullBounds). My layout will be re-computed then." - "and install new bounds" self bounds: box.! Item was added: + ----- Method: Morph>>layoutPosition (in category 'geometry - layout') ----- + layoutPosition + + ^ self layoutBounds topLeft! Item was added: + ----- Method: Morph>>layoutPosition: (in category 'geometry - layout') ----- + layoutPosition: aPoint + + | prior delta | + prior := self layoutBounds. + delta := (aPoint - prior topLeft) rounded. + self layoutBounds: (prior translateBy: delta).! Item was changed: ----- 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 assert: aSymbol isSymbol. "Guard against a common mistake." self assureTableProperties listSpacing: aSymbol. self layoutChanged.! Item was changed: + ----- Method: Morph>>localPointToGlobal: (in category 'geometry - local/global') ----- - ----- Method: Morph>>localPointToGlobal: (in category 'geometry') ----- localPointToGlobal: aPoint ^self point: aPoint in: nil! Item was changed: ----- Method: Morph>>minExtent (in category 'layout') ----- minExtent "Layout specific. Return the minimum size the receiver can be represented in. Implementation note: When this message is sent from an owner trying to lay out its children it will traverse down the morph tree and recompute the minimal arrangement of the morphs based on which the minimal extent is returned. When a morph with some layout strategy is encountered, the morph will ask its strategy to compute the new arrangement. However, since the final size given to the receiver is unknown at the point of the query, the assumption is made that the current bounds of the receiver are the base on which the layout should be computed. This scheme prevents strange layout changes when for instance, a table is contained in another table. Unless the inner table has been resized manually (which means its bounds are already enlarged) the arrangement of the inner table will not change here. Thus the entire layout computation is basically an iterative process which may have different results depending on the incremental changes applied." | layout minExtent extra hFit vFit | hFit := self hResizing. vFit := self vResizing. + + (self owner isNil or: [self owner layoutPolicy isNil]) + ifTrue: [ + hFit == #spaceFill ifTrue: [hFit := #rigid]. + vFit == #spaceFill ifTrue: [vFit := #rigid]]. + + "0) The receiver will not adjust to parents layout by growing or shrinking, which means that an accurate layout defines the minimum size. So, compute the layout and return its bounds as minimal extent. DO NOT return fullBounds because the morph itself is being layed out." (hFit == #spaceFill or: [vFit == #spaceFill]) + ifFalse: [self fullBounds. ^ self bounds extent]. - ifFalse: - ["The receiver will not adjust to parents layout by growing or shrinking, - which means that an accurate layout defines the minimum size." + "1) Ask the layout policy to compute the minimum extent." - ^self fullBounds extent]. - - "An exception -- a receiver with #shrinkWrap constraints but no children is being treated #rigid (the equivalent to a #spaceFill receiver in a non-layouting owner)" - self hasSubmorphs - ifFalse: - [hFit == #shrinkWrap ifTrue: [hFit := #rigid]. - vFit == #shrinkWrap ifTrue: [vFit := #rigid]]. layout := self layoutPolicy. layout isNil ifTrue: [minExtent := 0@0] ifFalse: [minExtent := layout minExtentOf: self in: self layoutBounds]. + "2) #rigid fitting has to stay as is." hFit == #rigid + ifTrue: [minExtent := self width @ minExtent y]. - ifTrue: [minExtent := self fullBounds extent x @ minExtent y] - ifFalse: - [extra := self bounds width - self layoutBounds width. - minExtent := (minExtent x + extra) @ minExtent y]. vFit == #rigid + ifTrue: [minExtent := minExtent x @ self height]. - ifTrue: [minExtent := minExtent x @ self fullBounds extent y] - ifFalse: - [extra := self bounds height - self layoutBounds height. - minExtent := minExtent x @ (minExtent y + extra)]. + "3) #spaceFill fitting has to account for layout inset." + hFit == #spaceFill + ifTrue: [ + (vFit == #shrinkWrap and: [self wrapDirection ~= #none]) + ifTrue: [minExtent := 1 @ minExtent y "Give h-space a chance to v-wrap and v-shrink."] + ifFalse: [ + extra := self bounds width - self layoutBounds width. + minExtent := (minExtent x + extra) @ minExtent y]]. + vFit == #spaceFill + ifTrue: [ + (hFit == #shrinkWrap and: [self wrapDirection ~= #none]) + ifTrue: [minExtent := minExtent x @ 1 "Give v-space a chance to h-wrap and h-shrink."] + ifFalse: [ + extra := self bounds height - self layoutBounds height. + minExtent := minExtent x @ (minExtent y + extra)]]. + + "4) #shrinkWrap fitting has to support height-for-width (or width-for-height)." + (hFit == #shrinkWrap and: [layout notNil]) + ifTrue: [ + self fullBounds. "Compute layout now to get shrink-wrapped width." + minExtent := self width @ minExtent y]. + (vFit == #shrinkWrap and: [layout notNil]) + ifTrue: [ + self fullBounds. "Compute layout now to get shrink-wrapped height." + minExtent := minExtent x @ self height]. + + "5) For morphs without submorphs, use #minWidth and #minHeight to implement #shrinkWrap such as in MenuItemMorph" ^ minExtent max: self minWidth @ self minHeight! Item was changed: + ----- Method: Morph>>minimumExtent (in category 'geometry - layout') ----- - ----- Method: Morph>>minimumExtent (in category 'geometry') ----- minimumExtent ^ self minWidth @ self minHeight! Item was changed: + ----- Method: Morph>>minimumExtent: (in category 'geometry - layout') ----- - ----- Method: Morph>>minimumExtent: (in category 'geometry') ----- minimumExtent: aPoint "Do not shrink below this extent." self minWidth: aPoint x; minHeight: aPoint y.! Item was changed: + ----- Method: Morph>>minimumHeight (in category 'geometry - layout') ----- - ----- Method: Morph>>minimumHeight (in category 'geometry') ----- minimumHeight "Wrapper for layout-specific function to avoid confusion." ^ self minHeight! Item was changed: + ----- Method: Morph>>minimumHeight: (in category 'geometry - layout') ----- - ----- Method: Morph>>minimumHeight: (in category 'geometry') ----- minimumHeight: aNumber "Wrapper for layout-specific function to avoid confusion." self minHeight: aNumber.! Item was changed: + ----- Method: Morph>>minimumWidth (in category 'geometry - layout') ----- - ----- Method: Morph>>minimumWidth (in category 'geometry') ----- minimumWidth "Wrapper for layout-specific function to avoid confusion." ^ self minWidth! Item was changed: + ----- Method: Morph>>minimumWidth: (in category 'geometry - layout') ----- - ----- Method: Morph>>minimumWidth: (in category 'geometry') ----- minimumWidth: aNumber "Wrapper for layout-specific function to avoid confusion." self minWidth: aNumber.! Item was changed: + ----- Method: Morph>>outerBounds (in category 'geometry - layout') ----- - ----- Method: Morph>>outerBounds (in category 'geometry') ----- outerBounds "Return the 'outer' bounds of the receiver, e.g., the bounds that need to be invalidated when the receiver changes." | box | box := self bounds. self hasDropShadow ifTrue:[box := self expandFullBoundsForDropShadow: box]. self hasRolloverBorder ifTrue:[box := self expandFullBoundsForRolloverBorder: box]. ^box! Item was added: + ----- Method: Morph>>outerBounds: (in category 'geometry - layout') ----- + outerBounds: aRectangle + "Set the bounds for laying out children of the receiver. + Note: written so that #outerBounds can be changed without touching this method" + | outer inner | + outer := self bounds. + inner := self outerBounds. + self bounds: (aRectangle origin + (outer origin - inner origin) corner: + aRectangle corner + (outer corner - inner corner)).! Item was added: + ----- Method: Morph>>outerExtent (in category 'geometry - layout') ----- + outerExtent + + ^ self outerBounds extent! Item was added: + ----- Method: Morph>>outerExtent: (in category 'geometry - layout') ----- + outerExtent: aPoint + + self outerBounds: (self outerPosition extent: aPoint).! Item was added: + ----- Method: Morph>>outerPosition (in category 'geometry - layout') ----- + outerPosition + + ^ self outerBounds topLeft! Item was added: + ----- Method: Morph>>outerPosition: (in category 'geometry - layout') ----- + outerPosition: aPoint + + | prior delta | + prior := self outerBounds. + delta := (aPoint - prior topLeft) rounded. + self outerBounds: (prior translateBy: delta).! Item was changed: + ----- Method: Morph>>overlapsShadowForm:bounds: (in category 'geometry - etoys') ----- - ----- Method: Morph>>overlapsShadowForm:bounds: (in category 'geometry') ----- overlapsShadowForm: itsShadow bounds: itsBounds "Answer true if itsShadow and my shadow overlap at all" | overlapExtent overlap myRect myShadow goalRect goalShadow bb | overlap := self fullBounds intersect: itsBounds. overlapExtent := overlap extent. overlapExtent > (0 @ 0) ifFalse: [^ false]. myRect := overlap translateBy: 0 @ 0 - self topLeft. myShadow := (self imageForm contentsOfArea: myRect) stencil. goalRect := overlap translateBy: 0 @ 0 - itsBounds topLeft. goalShadow := (itsShadow contentsOfArea: goalRect) stencil. "compute a pixel-by-pixel AND of the two stencils. Result will be black (pixel value = 1) where black parts of the stencils overlap" bb := BitBlt toForm: myShadow. bb copyForm: goalShadow to: 0 @ 0 rule: Form and. ^(bb destForm tallyPixelValues second) > 0 ! Item was changed: ----- Method: Morph>>ownerChanged (in category 'change reporting') ----- ownerChanged + "This morph's owner has changed its geometry and is about to update its layout. This is a simple layout hook to update this morph's geometry according to its owner. + + For more advanced strategies, use a LayoutPolicy with some LayoutProperties. See #layoutPolicy: and maybe also #doLayoutIn:." - "The receiver's owner, some kind of a pasteup, has changed its layout." + self snapToEdgeIfAppropriate.! - self snapToEdgeIfAppropriate! Item was changed: + ----- Method: Morph>>point:from: (in category 'geometry - local/global') ----- - ----- Method: Morph>>point:from: (in category 'geometry') ----- point: aPoint from: aReferenceMorph owner ifNil: [^ aPoint]. ^ (owner transformFrom: aReferenceMorph) globalPointToLocal: aPoint. ! Item was changed: + ----- Method: Morph>>point:in: (in category 'geometry - local/global') ----- - ----- Method: Morph>>point:in: (in category 'geometry') ----- point: aPoint in: aReferenceMorph owner ifNil: [^ aPoint]. ^ (owner transformFrom: aReferenceMorph) localPointToGlobal: aPoint. ! Item was changed: + ----- Method: Morph>>pointFromWorld: (in category 'geometry - local/global') ----- - ----- Method: Morph>>pointFromWorld: (in category 'geometry') ----- pointFromWorld: aPoint ^self point: aPoint from: self world! Item was changed: + ----- Method: Morph>>pointInWorld: (in category 'geometry - local/global') ----- - ----- Method: Morph>>pointInWorld: (in category 'geometry') ----- pointInWorld: aPoint ^self point: aPoint in: self world! Item was changed: ----- Method: Morph>>position: (in category 'geometry') ----- position: aPoint + "Change the position of this morph, which is the top left corner of its bounds." + - "Change the position of this morph and and all of its - submorphs. " | delta box | + delta := (aPoint - self bounds topLeft) rounded. + + "Skip drawing and layout updates for null changes." + (delta x = 0 and: [delta y = 0]) - delta := (aPoint - bounds topLeft) rounded. - (delta x = 0 - and: [delta y = 0]) ifTrue: [^ self]. + + "Optimize drawing. Record one damage rectangle for short distance and two damage rectangles for large distances." + box := self fullBounds. + (delta dotProduct: delta) > 100 "More than 10 pixels?" + ifTrue: [self + invalidRect: box; + invalidRect: (box translateBy: delta)] - "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))]. + + "Move this morph and *all* of its submorphs." - invalidRect: (box - merge: (box translateBy: delta))]. self privateFullMoveBy: delta. + + "For all known layout policies, my layout and the layout of my children is fine. Only the layout of my owner might be affected. So, tell about it." + self owner ifNotNil: [:o | o layoutChanged].! - owner - ifNotNil: [owner layoutChanged]! Item was changed: + ----- Method: Morph>>positionInWorld (in category 'geometry - local/global') ----- - ----- Method: Morph>>positionInWorld (in category 'geometry') ----- positionInWorld ^ self pointInWorld: self position. ! Item was changed: + ----- Method: Morph>>positionSubmorphs (in category 'geometry - misc') ----- - ----- Method: Morph>>positionSubmorphs (in category 'geometry') ----- positionSubmorphs self submorphsDo: [:aMorph | aMorph snapToEdgeIfAppropriate]! Item was added: + ----- Method: Morph>>privateFullBoundsForRedraw (in category 'layout') ----- + privateFullBoundsForRedraw + "Private. Compute the current submorph bounds *all the way down* to trigger re-draw. Implementation is based on #privateFullBounds and #submorphBounds. Avoid triggering layout computation but return bounds as is." + + | box | + self hasSubmorphs ifFalse: [^ self outerBounds]. + box := self outerBounds copy. + box := box quickMerge: (self clipSubmorphs + ifTrue: [self submorphBoundsForShrinkWrap intersect: self clippingBounds] + ifFalse: [self submorphBoundsForShrinkWrap]). + ^box origin asIntegerPoint corner: box corner asIntegerPoint! Item was changed: + ----- Method: Morph>>screenLocation (in category 'geometry - etoys') ----- - ----- Method: Morph>>screenLocation (in category 'geometry') ----- screenLocation "For compatibility only" ^ self fullBounds origin! Item was changed: + ----- Method: Morph>>screenRectangle (in category 'geometry - etoys') ----- - ----- Method: Morph>>screenRectangle (in category 'geometry') ----- screenRectangle "For compatibility only" ^ self fullBounds! Item was changed: + ----- Method: Morph>>setConstrainedPosition:hangOut: (in category 'geometry - misc') ----- - ----- Method: Morph>>setConstrainedPosition:hangOut: (in category 'geometry') ----- setConstrainedPosition: aPoint hangOut: partiallyOutside "Change the position of this morph and and all of its submorphs to aPoint, but don't let me go outside my owner's bounds. Let me go within two pixels of completely outside if partiallyOutside is true." | trialRect delta boundingMorph bRect | self flag: #smelly. "mt: The consideration of partiallyOutside is strange... The explicit #laoyutChanged, too." owner ifNil:[^self]. trialRect := aPoint extent: self bounds extent. boundingMorph := self topRendererOrSelf owner. delta := boundingMorph ifNil: [0@0] ifNotNil: [ bRect := partiallyOutside ifTrue: [boundingMorph bounds insetBy: self extent negated + boundingMorph borderWidth + (2@2)] ifFalse: [boundingMorph bounds]. trialRect amountToTranslateWithin: bRect]. self position: aPoint + delta. self layoutChanged "So that, eg, surrounding text will readjust" ! Item was added: + ----- Method: Morph>>setExtentFromLayout: (in category 'layout') ----- + setExtentFromLayout: aPoint + "Sets the extent for laying out children of the receiver. We avoid triggering #layoutChanged again. This implementation is based on #extent:." + + "self assert: self owner layoutComputed not." + + self flag: #compatibility. "mt: There are way too many morphs that use #extent: to implement their own layout strategy such as updating gradient fills and submorph positions AND TEXT MORPH PARAGRAPHS (!!). So, we *must* call #extent: to trigger those layout updates. Since our owner has not yet computed its layout, we are fine performance-wise." + self extent: aPoint. + + self flag: #alternative. "mt: The following code represents the desired implementation of this method." + "(self extent closeTo: aPoint) ifTrue: [^ self]. + + self invalidRect: self outerBounds. + bounds := bounds topLeft extent: aPoint. + + self removeProperty: #dropShadow. + self invalidRect: self outerBounds."! Item was added: + ----- Method: Morph>>setLayoutBoundsFromLayout: (in category 'layout') ----- + setLayoutBoundsFromLayout: newLayoutBounds + "Set the bounds for laying out children of the receiver. WE DO NOT MOVE CHILDREN HERE!! + + Note that this code is written so that #layoutBounds can be changed without touching this method. For example, the layout bounds are smaller or larger than the current bounds. + + WE MUST NOT TRIGGER #layoutChanged AGAIN!! See #doLayoutIn: and #adjustLayoutBounds." + + | priorBounds outer inner box | + priorBounds := self outerBounds. + + outer := self bounds. + inner := self layoutBounds. + bounds := newLayoutBounds origin + (outer origin - inner origin) corner: + newLayoutBounds corner + (outer corner - inner corner). + + bounds = outer ifFalse: [ + self removeProperty: #dropShadow. + self invalidRect: (priorBounds quickMerge: self outerBounds)].! Item was added: + ----- Method: Morph>>setPositionFromLayout: (in category 'layout') ----- + setPositionFromLayout: aPoint + "Sets the position for laying out children of the receiver. We have to move the children here. We avoid triggering #layoutChanged again. This implementation is based on #position:." + + | delta box | + delta := (aPoint - self bounds topLeft) rounded. + (delta x = 0 and: [delta y = 0]) ifTrue: [^ self]. + + box := self privateFullBoundsForRedraw. + self invalidRect: (box merge: (box translateBy: delta)). + + self privateFullMoveBy: delta.! Item was changed: + ----- Method: Morph>>shiftSubmorphsOtherThan:by: (in category 'geometry - misc') ----- - ----- Method: Morph>>shiftSubmorphsOtherThan:by: (in category 'geometry') ----- shiftSubmorphsOtherThan: listNotToShift by: delta | rejectList | rejectList := listNotToShift ifNil: [OrderedCollection new]. (submorphs copyWithoutAll: rejectList) do: [:m | m position: (m position + delta)]! Item was changed: ----- Method: Morph>>show (in category 'drawing') ----- show + + self visible ifFalse: [self visible: true].! - "Make sure this morph is on-stage." - self visible ifFalse: [self visible: true. self changed]! Item was added: + ----- Method: Morph>>submorphBoundsForShrinkWrap (in category 'layout') ----- + submorphBoundsForShrinkWrap + "Private. Compute the submorph bounds of the receiver to shrink-wrap around. Note that we are not interested in my submorphs' fullBounds. For full-bound wrapping, use #shrinkWrap all the way down." + + | box | + self submorphsDo: [:m | + m visible ifTrue: [ + box + ifNil:[box := m bounds copy] + ifNotNil:[box := box quickMerge: m bounds]]]. + box ifNil:[^ self layoutBounds]. "e.g., having submorphs but not visible" + ^ box origin asIntegerPoint corner: box corner asIntegerPoint! Item was changed: + ----- Method: Morph>>transformedBy: (in category 'geometry - misc') ----- - ----- Method: Morph>>transformedBy: (in category 'geometry') ----- transformedBy: aTransform aTransform isIdentity ifTrue:[^self]. aTransform isPureTranslation ifTrue:[ ^self position: (aTransform localPointToGlobal: self position). ]. ^self addFlexShell transformedBy: aTransform! Item was changed: ----- Method: Morph>>visible: (in category 'drawing') ----- visible: aBoolean "set the 'visible' attribute of the receiver to aBoolean" (extension isNil and:[aBoolean]) ifTrue: [^ self]. self visible == aBoolean ifTrue: [^ self]. + + self changed. self assureExtension visible: aBoolean. self changed! Item was changed: + ----- Method: Morph>>worldBounds (in category 'geometry - misc') ----- - ----- Method: Morph>>worldBounds (in category 'geometry') ----- worldBounds ^ self world bounds! Item was changed: + ----- Method: Morph>>worldBoundsForHalo (in category 'geometry - misc') ----- - ----- Method: Morph>>worldBoundsForHalo (in category 'geometry') ----- worldBoundsForHalo "Answer the rectangle to be used as the inner dimension of my halos. Allow for showing either bounds or fullBounds, and compensate for the optional bounds rectangle." | r | r := (Preferences haloEnclosesFullBounds) ifFalse: [ self boundsIn: nil ] ifTrue: [ self fullBoundsInWorld ]. Preferences showBoundsInHalo ifTrue: [ ^r outsetBy: 2 ]. ^r! Item was changed: ----- Method: PluggableTextMorph>>setSelection: (in category 'model access') ----- + setSelection: anInterval + "Sets a new selection of characters. If the argument is nil, give the model a chance to just leave the selection where it currently is." + + (anInterval notNil and: [anInterval ~= selectionInterval]) ifTrue: [ + + "Note old selection." + textMorph selectionChanged. + + "Update selection." + selectionInterval := anInterval. + textMorph editor selectFrom: anInterval first to: anInterval last. - setSelection: sel + "Note new selection." + textMorph selectionChanged]. - "Give the model a chance to just leave the selection where it currently is." - sel ifNil: [^ self]. + "Even if there is no change, ensure that the selection is visible." - selectionInterval := sel. - textMorph editor selectFrom: sel first to: sel last. self scrollSelectionIntoView.! Item was changed: ----- Method: PluggableTextMorph>>wrapFlag: (in category 'accessing') ----- wrapFlag: aBoolean textMorph ifNil: [self setText: '']. textMorph wrapFlag: aBoolean; autoFit: true. "Text navigation will be tedious if there is no horizontal scroll bar w/o wrapping." aBoolean ifFalse: [self showHScrollBarOnlyWhenNeeded]. + self layoutChanged.! - self - resizeScrollBars; - resizeScroller; - hideOrShowScrollBars; - setScrollDeltas.! Item was changed: ----- Method: ScrollBar>>initializeDownButton (in category 'initialize') ----- initializeDownButton "initialize the receiver's downButton" downButton := RectangleMorph newBounds: self boundsForDownButton. downButton on: #mouseDown send: #scrollDownInit to: self. downButton on: #mouseUp send: #finishedScrolling to: self. self updateDownButtonImage. self addMorphFront: downButton. + downButton + visible: self class scrollBarsWithoutArrowButtons not; + disableLayout: downButton visible not.! - downButton visible: self class scrollBarsWithoutArrowButtons not.! Item was changed: ----- Method: ScrollBar>>initializeMenuButton (in category 'initialize') ----- initializeMenuButton "initialize the receiver's menuButton" "Preferences disable: #scrollBarsWithoutMenuButton" "Preferences enable: #scrollBarsWithoutMenuButton" menuButton := RectangleMorph newBounds: self boundsForMenuButton. menuButton on: #mouseEnter send: #menuButtonMouseEnter: to: self. menuButton on: #mouseDown send: #menuButtonMouseDown: to: self. menuButton on: #mouseLeave send: #menuButtonMouseLeave: to: self. "menuButton addMorphCentered: (RectangleMorph newBounds: (0 @ 0 extent: 4 @ 2) color: Color black)." self updateMenuButtonImage. self addMorphFront: menuButton. + menuButton + visible: (self class scrollBarsWithoutMenuButton or: [self orientation == #horizontal]) not; + disableLayout: menuButton visible not.! - menuButton visible: (self class scrollBarsWithoutMenuButton or: [self orientation == #horizontal]) not.! Item was changed: ----- Method: ScrollBar>>initializeUpButton (in category 'initialize') ----- initializeUpButton "initialize the receiver's upButton" upButton := RectangleMorph newBounds: self boundsForUpButton. upButton on: #mouseDown send: #scrollUpInit to: self. upButton on: #mouseUp send: #finishedScrolling to: self. self updateUpButtonImage. self addMorph: upButton. + upButton + visible: self class scrollBarsWithoutArrowButtons not; + disableLayout: upButton visible not.! - upButton visible: self class scrollBarsWithoutArrowButtons not.! Item was changed: ----- Method: ScrollBar>>updateSlider (in category 'updating') ----- updateSlider | imagesNeedUpdate | imagesNeedUpdate := upButton width ~= (self orientation == #horizontal ifTrue: [self height] ifFalse: [self width]). self menuButton visible: (self orientation == #horizontal or: [self class scrollBarsWithoutMenuButton]) not; + disableLayout: self menuButton visible not; bounds: self boundsForMenuButton. + self upButton - upButton visible: self class scrollBarsWithoutArrowButtons not; + disableLayout: self upButton visible not; bounds: self boundsForUpButton. + self downButton - downButton visible: self class scrollBarsWithoutArrowButtons not; + disableLayout: self downButton visible not; bounds: self boundsForDownButton. super updateSlider. pagingArea bounds: self totalSliderArea. self expandSlider. imagesNeedUpdate ifTrue: [ self menuButton visible ifTrue: [self updateMenuButtonImage]. + self upButton visible ifTrue: [self updateUpButtonImage]. + self downButton visible ifTrue: [self updateDownButtonImage]].! - upButton visible ifTrue: [self updateUpButtonImage]. - downButton visible ifTrue: [self updateDownButtonImage]].! Item was changed: ----- Method: ScrollPane class>>useRetractableScrollBars: (in category 'preferences') ----- useRetractableScrollBars: aBoolean UseRetractableScrollBars = aBoolean ifTrue: [^ self]. UseRetractableScrollBars := aBoolean. ScrollPane allSubInstances do: [:pane | + pane retractable: aBoolean].! - pane retractable: aBoolean. - pane setScrollDeltas].! Item was added: + ----- Method: ScrollPane>>adjustOffset (in category 'scrolling') ----- + adjustOffset + "Layout specific. If our scroller is large enough, avoid hiding contents due to bad offset." + + | sbox adjustedOffset | + sbox := scroller submorphBoundsForShrinkWrap. + adjustedOffset := (sbox width <= scroller width ifTrue: [0] ifFalse: [scroller offset x]) @ + (sbox height <= scroller height ifTrue: [0] ifFalse: [scroller offset y]). + scroller offset: adjustedOffset.! Item was removed: - ----- Method: ScrollPane>>borderStyle: (in category 'accessing') ----- - borderStyle: aBorderStyle - super borderStyle: aBorderStyle. - scroller ifNotNil: [self setScrollDeltas].! Item was removed: - ----- Method: ScrollPane>>borderWidth: (in category 'accessing') ----- - borderWidth: aNumber - super borderWidth: aNumber. - self resizeScroller; setScrollDeltas! Item was added: + ----- Method: ScrollPane>>doLayoutIn: (in category 'layout') ----- + doLayoutIn: layoutBounds + "Manually layout my submorphs. Maybe we can find a proper layout policy in the future." + + self removeProperty: #doLayoutAgain. + self + resizeScrollBars; + resizeScroller; + adjustOffset; + setScrollDeltas. + + "Do one additional run if required." + (self hasProperty: #doLayoutAgain) ifTrue: [ + self doLayoutIn: layoutBounds. + self assert: (self hasProperty: #doLayoutAgain) not. + ^ self]. + + super doLayoutIn: layoutBounds.! Item was removed: - ----- Method: ScrollPane>>extent: (in category 'geometry') ----- - extent: aPoint - - self handleResizeAction: [ - (bounds extent closeTo: aPoint) - ifTrue: [false] - ifFalse: [ - super extent: aPoint. - owner ifNotNil: [owner layoutChanged]. - true]].! Item was changed: ----- Method: ScrollPane>>hHideScrollBar (in category 'scrolling') ----- hHideScrollBar self hIsScrollbarShowing ifFalse: [^self]. + self removeMorph: hScrollBar.! - self removeMorph: hScrollBar. - retractableScrollBar ifFalse: [self resetExtent]. - - ! Item was changed: ----- Method: ScrollPane>>hShowScrollBar (in category 'scrolling') ----- hShowScrollBar self hIsScrollbarShowing ifTrue: [^self]. self hResizeScrollBar. self privateAddMorph: hScrollBar atIndex: 1. + retractableScrollBar ifTrue: [self comeToFront].! - retractableScrollBar - ifTrue: [self comeToFront] - ifFalse: [self resetExtent]. - ! Item was removed: - ----- Method: ScrollPane>>handleResizeAction: (in category 'geometry') ----- - handleResizeAction: aBlock - "Ensure layout properties after resizing takes place." - - | oldExtent | - oldExtent := self extent. - - aBlock value ifFalse: [^ self]. - - "Now reset widget sizes" - self extent ~= oldExtent ifTrue: [ - self - resizeScrollBars; - resizeScroller; - setScrollDeltas].! Item was changed: ----- Method: ScrollPane>>hideOrShowScrollBars (in category 'scrolling') ----- hideOrShowScrollBars self vHideOrShowScrollBar; + hHideOrShowScrollBar.! - hHideOrShowScrollBar; - resizeScrollBars.! Item was changed: ----- Method: ScrollPane>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self initializePreferences. hasFocus := false. self initializeScrollBars. "" self extent: self defaultExtent. + self updateMinimumExtent. - self - resizeScrollBars; - resizeScroller; - hideOrShowScrollBars; - updateMinimumExtent. self setDefaultParameters. self addKeyboardCaptureFilter: self.! Item was changed: ----- Method: ScrollPane>>layoutChanged (in category 'layout') ----- layoutChanged + + self setProperty: #doLayoutAgain toValue: true. + super layoutChanged.! - "Do not tell owner. We might keep our bounds." - - fullBounds := nil.! Item was changed: ----- Method: ScrollPane>>resetExtent (in category 'geometry') ----- resetExtent "Reset the extent. (may be overridden by subclasses which need to do more than this)" + + self flag: #deprecate. "mt: Remove all uses in Etoys." self resizeScroller! Item was changed: ----- Method: ScrollPane>>retractableOrNot (in category 'accessing retractable') ----- retractableOrNot "Change scroll bar operation" retractableScrollBar := retractableScrollBar not. retractableScrollBar ifTrue: [ self removeMorph: scrollBar; removeMorph: hScrollBar] ifFalse: [(submorphs includes: scrollBar) ifFalse: [self privateAddMorph: scrollBar atIndex: 1. self privateAddMorph: hScrollBar atIndex: 1]]. + self updateMinimumExtent.! - self - resizeScrollBars; - resizeScroller; - hideOrShowScrollBars; - updateMinimumExtent.! Item was changed: ----- Method: ScrollPane>>scrollBarOnLeft: (in category 'accessing') ----- scrollBarOnLeft: aBoolean + scrollBarOnLeft := aBoolean. + self layoutChanged.! - - self - resizeScrollBars; - resizeScroller; - setScrollDeltas.! Item was changed: ----- Method: ScrollPane>>scrollBarThickness: (in category 'accessing') ----- scrollBarThickness: anInteger scrollBarThickness := anInteger. self updateMinimumExtent. + self layoutChanged.! - - self - resizeScrollBars; - resizeScroller; - setScrollDeltas.! Item was changed: ----- Method: ScrollPane>>scrollToShow: (in category 'scrolling') ----- scrollToShow: aRectangle + | newOffset | + newOffset := self offsetToShow: aRectangle. + scroller offset = newOffset ifTrue: [^ self]. + scroller offset: newOffset. + self layoutChanged.! - scroller offset: (self offsetToShow: aRectangle). - self setScrollDeltas. - ! Item was changed: ----- Method: ScrollPane>>setScrollDeltas (in category 'geometry') ----- setScrollDeltas "Set the ScrollBar deltas, value and interval, based on the current scroll pane size, offset and range." + scroller ifNil: [^ self]. - scroller hasSubmorphs ifFalse: [^ self]. - "NOTE: fullbounds commented out now -- trying to find a case where this expensive step is necessary -- perhaps there is a less expensive way to handle that case." - "scroller fullBounds." "force recompute so that leftoverScrollRange will be up-to-date" self hideOrShowScrollBars. self vSetScrollDelta. + self hSetScrollDelta.! - self hSetScrollDelta.. - ! Item was changed: ----- Method: ScrollPane>>vHideScrollBar (in category 'scrolling') ----- vHideScrollBar self vIsScrollbarShowing ifFalse: [^self]. + self removeMorph: scrollBar.! - self removeMorph: scrollBar. - retractableScrollBar ifFalse: [self resetExtent]. - - ! Item was changed: ----- Method: ScrollPane>>vShowScrollBar (in category 'scrolling') ----- vShowScrollBar self vIsScrollbarShowing ifTrue: [^ self]. self vResizeScrollBar. self privateAddMorph: scrollBar atIndex: 1. + retractableScrollBar ifTrue: [self comeToFront]! - retractableScrollBar - ifTrue: [self comeToFront] - ifFalse: [self resetExtent] - ! Item was changed: ----- Method: TableLayout>>computeCellArrangement:in:horizontal:target: (in category 'layout') ----- computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level. Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row." + | cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill gap | - | cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill inset | maxCell := cellHolder key. cells := cellHolder value. properties wrapDirection == #none ifTrue: [wrap := SmallInteger maxVal] ifFalse: [wrap := aBool ifTrue: [newBounds width] ifFalse: [newBounds height]. wrap := wrap max: (maxCell x)]. spacing := properties cellSpacing. (spacing == #globalRect or: [spacing = #globalSquare]) ifTrue: ["Globally equal spacing is a very special case here, so get out fast and easy" ^self computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing]. output := WriteStream on: Array new. + gap := properties cellGap asPoint. + aBool ifFalse: [gap := gap transposed]. - inset := properties cellInset asPoint. - aBool ifFalse: [inset := inset transposed]. first := last := nil. maxExtent := 0 @ 0. sum := 0. index := 1. n := 0. hFill := vFill := false. [index <= cells size] whileTrue: [w := sum. cell := cells at: index. cellMax := maxExtent max: cell cellSize. "e.g., minSize" sum := (spacing == #localRect or: [spacing == #localSquare]) ifTrue: ["Recompute entire size of current row" max := spacing == #localSquare ifTrue: [cellMax x max: cellMax y] ifFalse: [cellMax x]. (n + 1) * max] ifFalse: [sum + cell cellSize x]. + (sum + (n * gap x) > wrap and: [first notNil]) - (sum + (n * inset x) > wrap and: [first notNil]) ifTrue: + ["It doesn't fit and we're now starting a new line" - ["It doesn't fit and we're not starting a new line" (spacing == #localSquare or: [spacing == #localRect]) ifTrue: [spacing == #localSquare ifTrue: [maxExtent := (maxExtent x max: maxExtent y) asPoint]. first do: [:c | c cellSize: maxExtent]]. + w := w + ((n - 1) * gap x). - w := w + ((n - 1) * inset x). "redistribute extra space" first nextCell + ifNotNil: [first nextCell do: [:c | c addExtraSpace: gap x @ 0]]. - ifNotNil: [first nextCell do: [:c | c addExtraSpace: inset x @ 0]]. last := LayoutCell new. last cellSize: w @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. + output position = 0 ifFalse: [last addExtraSpace: 0 @ gap y]. - output position = 0 ifFalse: [last addExtraSpace: 0 @ inset y]. output nextPut: last. first := nil. maxExtent := 0 @ 0. sum := 0. n := 0. hFill := vFill := false] ifFalse: ["It did fit; use next item from input" first ifNil: [first := last := cell] ifNotNil: [last nextCell: cell. last := cell]. index := index + 1. n := n + 1. maxExtent := cellMax. hFill := hFill or: [cell hSpaceFill]. vFill := vFill or: [cell vSpaceFill]]]. first ifNotNil: [last := LayoutCell new. + sum := sum + ((n - 1) * gap x). - sum := sum + ((n - 1) * inset x). first nextCell + ifNotNil: [first nextCell do: [:c | c addExtraSpace: gap x @ 0]]. - ifNotNil: [first nextCell do: [:c | c addExtraSpace: inset x @ 0]]. last cellSize: sum @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. + output position = 0 ifFalse: [last addExtraSpace: 0 @ gap y]. - output position = 0 ifFalse: [last addExtraSpace: 0 @ inset y]. output nextPut: last]. output := output contents. properties listSpacing == #equal ifTrue: ["Make all the heights equal" max := output inject: 0 into: [:size :c | size max: c cellSize y]. output do: [:c | c cellSize: c cellSize x @ max]]. ^output! Item was changed: ----- Method: TableLayout>>computeCellSizes:in:horizontal: (in category 'layout') ----- computeCellSizes: aMorph in: newBounds horizontal: aBool "Step 1: Compute the minimum extent for all the children of aMorph" + | cells block minSize maxSize maxCell insetExtra | - | cells block minSize maxSize maxCell | cells := WriteStream on: (Array new: aMorph submorphCount). minSize := properties minCellSize asPoint. maxSize := properties maxCellSize asPoint. aBool ifTrue:[ minSize := minSize transposed. maxSize := maxSize transposed]. maxCell := 0@0. + insetExtra := properties cellInset. + insetExtra isRectangle + ifTrue: [insetExtra := insetExtra left + insetExtra right @ (insetExtra top + insetExtra bottom)] + ifFalse: [insetExtra := insetExtra*2 asPoint]. block := [:m| | size cell | m disableTableLayout ifFalse:[ + size := m minExtent asIntegerPoint + insetExtra. - size := m minExtent asIntegerPoint. cell := LayoutCell new target: m. aBool ifTrue:[ cell hSpaceFill: m hResizing == #spaceFill. cell vSpaceFill: m vResizing == #spaceFill. ] ifFalse:[ cell hSpaceFill: m vResizing == #spaceFill. cell vSpaceFill: m hResizing == #spaceFill. size := size transposed. ]. size := (size min: maxSize) max: minSize. cell cellSize: size. maxCell := maxCell max: size. cells nextPut: cell]]. properties reverseTableCells ifTrue:[aMorph submorphsReverseDo: block] ifFalse:[aMorph submorphsDo: block]. ^maxCell -> cells contents! Item was changed: ----- Method: TableLayout>>computeGlobalCellArrangement:in:horizontal:wrap:spacing: (in category 'layout') ----- computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level. Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row." + | output maxExtent n cell first last hFill vFill gap | - | output maxExtent n cell first last hFill vFill | output := (WriteStream on: Array new). + gap := properties cellGap asPoint. first := last := nil. maxExtent := cells inject: 0@0 into:[:size :c| size max: c cellSize "e.g., minSize"]. spacing == #globalSquare ifTrue:[maxExtent := (maxExtent x max: maxExtent y) asPoint]. + n := ((wrap + gap x) // (maxExtent x + gap x)) max: 1. - n := (wrap // maxExtent x) max: 1. hFill := vFill := false. 1 to: cells size do:[:i| cell := cells at: i. hFill := hFill or:[cell hSpaceFill]. vFill := vFill or:[cell vSpaceFill]. cell cellSize: maxExtent. first ifNil:[first := last := cell] ifNotNil:[last nextCell: cell. last := cell]. + (i \\ n) = 0 ifTrue:[ "It doesn't fit and we're now starting a new line" + "redistribute extra space" + first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: gap x @ 0]]. - (i \\ n) = 0 ifTrue:[ last := LayoutCell new. last cellSize: (maxExtent x * n) @ (maxExtent y). last hSpaceFill: hFill. last vSpaceFill: vFill. hFill := vFill := false. last nextCell: first. + output position = 0 ifFalse: [last addExtraSpace: 0 @ gap y]. output nextPut: last. first := nil]]. first ifNotNil:[ last := LayoutCell new. + first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: gap x @ 0]]. last cellSize: (maxExtent x * n) @ (maxExtent y). self flag: #arNote."@@@: n is not correct!!" last nextCell: first. + output position = 0 ifFalse: [last addExtraSpace: 0 @ gap y]. output nextPut: last]. + ^output contents! - ^output contents - ! Item was changed: ----- Method: TableLayout>>layoutLeftToRight:in: (in category 'optimized') ----- layoutLeftToRight: aMorph in: newBounds "An optimized left-to-right list layout" + | inset insetExtra gap extent block posX posY centering extraPerCell amount minX minY maxX maxY n width extra last cell size height sum vFill first cellRect | - | inset extent block posX posY centering extraPerCell amount minX minY maxX maxY n width extra last cell size height sum vFill first | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. + inset := properties cellInset. + insetExtra := inset isRectangle + ifTrue: [insetExtra := inset left + inset right @ (inset top + inset bottom)] + ifFalse: [insetExtra := inset*2 asPoint]. + (inset isNumber and: [inset isZero]) ifTrue: [inset := nil]. + gap := properties cellGap asPoint x. - inset := properties cellInset asPoint x. extent := newBounds extent. n := 0. vFill := false. sum := 0. width := height := 0. first := last := nil. block := [:m | | sizeX props sizeY | props := m layoutProperties ifNil: [m]. props disableTableLayout ifFalse: [n := n + 1. cell := LayoutCell new target: m. props hResizing == #spaceFill ifTrue: [cell hSpaceFill: true. extra := m spaceFillWeight. cell extraSpace: extra. sum := sum + extra] ifFalse: [cell hSpaceFill: false]. props vResizing == #spaceFill ifTrue: [vFill := true]. + size := m minExtent + insetExtra. - size := m minExtent. - size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. cell cellSize: sizeX. last ifNil: [first := cell] ifNotNil: [last nextCell: cell]. last := cell. width := width + sizeX. sizeY > height ifTrue: [height := sizeY]]]. properties reverseTableCells ifTrue: [aMorph submorphsReverseDo: block] ifFalse: [aMorph submorphsDo: block]. + n > 1 ifTrue: [width := width + ((n - 1) * gap)]. - n > 1 ifTrue: [width := width + ((n - 1) * inset)]. (properties hResizing == #shrinkWrap and: [properties rubberBandCells or: [sum isZero]]) ifTrue: [extent := width @ (extent y max: height)]. (properties vResizing == #shrinkWrap and: [properties rubberBandCells or: [vFill not]]) ifTrue: [extent := (extent x max: width) @ height]. posX := newBounds left. posY := newBounds top. "Compute extra vertical space" extra := extent y - height. extra := extra max: 0. extra > 0 ifTrue: [vFill ifTrue: [height := extent y] ifFalse: [centering := properties wrapCentering. centering == #bottomRight ifTrue: [posY := posY + extra]. centering == #center ifTrue: [posY := posY + (extra // 2)]]]. "Compute extra horizontal space" extra := extent x - width. extra := extra max: 0. extraPerCell := 0. extra > 0 ifTrue: [sum isZero ifTrue: ["extra space but no #spaceFillers" centering := properties listCentering. centering == #bottomRight ifTrue: [posX := posX + extra]. centering == #center ifTrue: [posX := posX + (extra // 2)]] ifFalse: [extraPerCell := extra asFloat / sum asFloat]]. n := 0. extra := last := 0. cell := first. [cell isNil] whileFalse: [n := n + 1. width := cell cellSize. (extraPerCell > 0 and: [cell hSpaceFill]) ifTrue: [extra := (last := extra) + (extraPerCell * cell extraSpace). amount := extra truncated - last truncated. width := width + amount]. + cellRect := (posX @ posY extent: width @ height). + inset ifNotNil: [cellRect := cellRect insetBy: inset]. + cell target layoutInBounds: cellRect. + posX := posX + width + gap. - cell target layoutInBounds: (posX @ posY extent: width @ height). - posX := posX + width + inset. cell := cell nextCell]! Item was changed: ----- Method: TableLayout>>layoutTopToBottom:in: (in category 'optimized') ----- layoutTopToBottom: aMorph in: newBounds "An optimized top-to-bottom list layout" + | inset insetExtra gap extent block posX posY centering extraPerCell amount minX minY maxX maxY n height extra last cell size width sum vFill first cellRect | - | inset extent block posX posY centering extraPerCell amount minX minY maxX maxY n height extra last cell size width sum vFill first | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. + inset := properties cellInset. + insetExtra := inset isRectangle + ifTrue: [insetExtra := inset left + inset right @ (inset top + inset bottom)] + ifFalse: [insetExtra := inset*2 asPoint]. + (inset isNumber and: [inset isZero]) ifTrue: [inset := nil]. + gap := properties cellGap asPoint y. - inset := properties cellInset asPoint y. extent := newBounds extent. n := 0. vFill := false. sum := 0. width := height := 0. first := last := nil. block := [:m | | sizeY sizeX props | props := m layoutProperties ifNil: [m]. props disableTableLayout ifFalse: [n := n + 1. cell := LayoutCell new target: m. props vResizing == #spaceFill ifTrue: [cell vSpaceFill: true. extra := m spaceFillWeight. cell extraSpace: extra. sum := sum + extra] ifFalse: [cell vSpaceFill: false]. props hResizing == #spaceFill ifTrue: [vFill := true]. + size := m minExtent + insetExtra. - size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. cell cellSize: sizeY. first ifNil: [first := cell] ifNotNil: [last nextCell: cell]. last := cell. height := height + sizeY. sizeX > width ifTrue: [width := sizeX]]]. properties reverseTableCells ifTrue: [aMorph submorphsReverseDo: block] ifFalse: [aMorph submorphsDo: block]. + n > 1 ifTrue: [height := height + ((n - 1) * gap)]. - n > 1 ifTrue: [height := height + ((n - 1) * inset)]. (properties vResizing == #shrinkWrap and: [properties rubberBandCells or: [sum isZero]]) ifTrue: [extent := (extent x max: width) @ height]. (properties hResizing == #shrinkWrap and: [properties rubberBandCells or: [vFill not]]) ifTrue: [extent := width @ (extent y max: height)]. posX := newBounds left. posY := newBounds top. "Compute extra horizontal space" extra := extent x - width. extra := extra max: 0. extra > 0 ifTrue: [vFill ifTrue: [width := extent x] ifFalse: [centering := properties wrapCentering. centering == #bottomRight ifTrue: [posX := posX + extra]. centering == #center ifTrue: [posX := posX + (extra // 2)]]]. "Compute extra vertical space" extra := extent y - height. extra := extra max: 0. extraPerCell := 0. extra > 0 ifTrue: [sum isZero ifTrue: ["extra space but no #spaceFillers" centering := properties listCentering. centering == #bottomRight ifTrue: [posY := posY + extra]. centering == #center ifTrue: [posY := posY + (extra // 2)]] ifFalse: [extraPerCell := extra asFloat / sum asFloat]]. n := 0. extra := last := 0. cell := first. [cell isNil] whileFalse: [n := n + 1. height := cell cellSize. (extraPerCell > 0 and: [cell vSpaceFill]) ifTrue: [extra := (last := extra) + (extraPerCell * cell extraSpace). amount := extra truncated - last truncated. height := height + amount]. + cellRect := (posX @ posY extent: width @ height). + inset ifNotNil: [cellRect := cellRect insetBy: inset]. + cell target layoutInBounds: cellRect. + posY := posY + height + gap. - cell target layoutInBounds: (posX @ posY extent: width @ height). - posY := posY + height + inset. cell := cell nextCell]! Item was changed: ----- Method: TableLayout>>minExtentHorizontal: (in category 'optimized') ----- minExtentHorizontal: aMorph "Return the minimal size aMorph's children would require given the new bounds" + | insetExtra gap minX minY maxX maxY n size width height | - | inset minX minY maxX maxY n size width height | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. + insetExtra := properties cellInset. + insetExtra isRectangle + ifTrue: [insetExtra := insetExtra left + insetExtra right @ (insetExtra top + insetExtra bottom)] + ifFalse: [insetExtra := insetExtra*2 asPoint]. + gap := properties cellGap asPoint. - inset := properties cellInset asPoint. n := 0. width := height := 0. aMorph submorphsDo: [:m | | sizeX sizeY | m disableTableLayout ifFalse: [n := n + 1. + size := m minExtent + insetExtra. - size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. width := width + sizeX. sizeY > height ifTrue: [height := sizeY]]]. + n > 1 ifTrue: [width := width + ((n - 1) * gap x)]. - n > 1 ifTrue: [width := width + ((n - 1) * inset x)]. ^minExtentCache := width @ height! Item was changed: ----- Method: TableLayout>>minExtentVertical: (in category 'optimized') ----- minExtentVertical: aMorph "Return the minimal size aMorph's children would require given the new bounds" + | insetExtra gap minX minY maxX maxY n size width height | - | inset minX minY maxX maxY n size width height | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. + insetExtra := properties cellInset. + insetExtra isRectangle + ifTrue: [insetExtra := insetExtra left + insetExtra right @ (insetExtra top + insetExtra bottom)] + ifFalse: [insetExtra := insetExtra*2 asPoint]. + gap := properties cellGap asPoint. - inset := properties cellInset asPoint. n := 0. width := height := 0. aMorph submorphsDo: [:m | | sizeY sizeX | m disableTableLayout ifFalse: [n := n + 1. + size := m minExtent + insetExtra. - size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. height := height + sizeY. sizeX > width ifTrue: [width := sizeX]]]. + n > 1 ifTrue: [height := height + ((n - 1) * gap y)]. - n > 1 ifTrue: [height := height + ((n - 1) * inset y)]. ^minExtentCache := width @ height! Item was changed: ----- Method: TableLayout>>placeCells:in:horizontal:target: (in category 'layout') ----- placeCells: arrangement in: newBounds horizontal: aBool target: aMorph "Place the morphs within the cells accordingly" | xDir yDir anchor yDist place cell xDist cellRect corner inset | inset := properties cellInset. (inset isNumber and: [inset isZero]) ifTrue: [inset := nil]. aBool ifTrue: ["horizontal layout" properties listDirection == #rightToLeft ifTrue: [xDir := -1 @ 0. properties wrapDirection == #bottomToTop ifTrue: [yDir := 0 @ -1. anchor := newBounds bottomRight] ifFalse: [yDir := 0 @ 1. anchor := newBounds topRight]] ifFalse: [xDir := 1 @ 0. properties wrapDirection == #bottomToTop ifTrue: [yDir := 0 @ -1. anchor := newBounds bottomLeft] ifFalse: [yDir := 0 @ 1. anchor := newBounds topLeft]]] ifFalse: ["vertical layout" properties listDirection == #bottomToTop ifTrue: [xDir := 0 @ -1. properties wrapDirection == #rightToLeft ifTrue: [yDir := -1 @ 0. anchor := newBounds bottomRight] ifFalse: [yDir := 1 @ 0. anchor := newBounds bottomLeft]] ifFalse: [xDir := 0 @ 1. anchor := properties wrapDirection == #rightToLeft ifTrue: [yDir := -1 @ 0. newBounds topRight] ifFalse: [yDir := 1 @ 0. newBounds topLeft]]]. 1 to: arrangement size do: [:i | cell := arrangement at: i. cell extraSpace ifNotNil: [anchor := anchor + (cell extraSpace y * yDir)]. yDist := cell cellSize y * yDir. "secondary advance direction" place := anchor. cell := cell nextCell. [cell isNil] whileFalse: [cell extraSpace ifNotNil: [place := place + (cell extraSpace x * xDir)]. xDist := cell cellSize x * xDir. "primary advance direction" corner := place + xDist + yDist. cellRect := Rectangle origin: (place min: corner) corner: (place max: corner). inset ifNotNil: [cellRect := cellRect insetBy: inset]. cell target layoutInBounds: cellRect. place := place + xDist. cell := cell nextCell]. anchor := anchor + yDist]! Item was changed: LayoutProperties subclass: #TableLayoutProperties + instanceVariableNames: 'cellInset cellPositioning cellSpacing cellGap layoutInset listCentering listDirection listSpacing reverseTableCells rubberBandCells wrapCentering wrapDirection minCellSize maxCellSize' - instanceVariableNames: 'cellInset cellPositioning cellSpacing layoutInset listCentering listDirection listSpacing reverseTableCells rubberBandCells wrapCentering wrapDirection minCellSize maxCellSize' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Layouts'! Item was added: + ----- Method: TableLayoutProperties>>cellGap (in category 'table defaults') ----- + cellGap + "ifNil is just for migration of old instances." + ^ cellGap ifNil: [0]! Item was added: + ----- Method: TableLayoutProperties>>cellGap: (in category 'accessing') ----- + cellGap: aNumber + cellGap := aNumber! Item was changed: ----- Method: TableLayoutProperties>>initialize (in category 'initialize') ----- initialize super initialize. cellSpacing := listSpacing := wrapDirection := #none. cellPositioning := #center. listCentering := wrapCentering := #topLeft. listDirection := #topToBottom. reverseTableCells := rubberBandCells := false. + layoutInset := cellInset := minCellSize := cellGap := 0. - layoutInset := cellInset := minCellSize := 0. maxCellSize := 1073741823. "SmallInteger maxVal" ! Item was added: + ----- Method: TextMorph>>doLayoutIn: (in category 'layout') ----- + doLayoutIn: layoutBounds + "Compute paragraph here to reduce visual flickering. Also update the layout of any submorphs, which can be added via text anchors. + + autoFit + wrapFlag -> hResizing: #rigid + vResizing: #shrinkWrap + autoFIt + no wrapFlag -> hResizing: #shrinkWrap + vResizing: #shrinkWrap + no autoFit + wrapFlag -> hResizing: #rigid + vRresizing: #rigid + no autoFit + no wrapFlag -> hResizing: #rigid + vRresizing: #rigid" + + self submorphsDo: [:m | m fullBounds]. + self paragraph. + fullBounds := self privateFullBounds.! Item was changed: ----- Method: TextMorph>>extent: (in category 'geometry') ----- extent: aPoint | newExtent priorEditor | bounds extent = aPoint ifTrue: [^ self]. priorEditor := editor. self isAutoFit ifTrue: [wrapFlag ifFalse: [^ self]. "full autofit can't change" + newExtent := aPoint truncated. - newExtent := aPoint truncated max: self minimumExtent. newExtent x = self extent x ifTrue: [^ self]. "No change of wrap width" self releaseParagraphReally. "invalidate the paragraph cache" super extent: newExtent. priorEditor ifNil: [self fit] "since the width has changed..." ifNotNil: [self installEditorToReplace: priorEditor]] + ifFalse: [super extent: aPoint truncated. - ifFalse: [super extent: (aPoint truncated max: self minimumExtent). wrapFlag ifFalse: [^ self]. "no effect on composition" self composeToBounds] ! Item was changed: ----- Method: TextMorph>>fit (in category 'private') ----- fit "Adjust my bounds to fit the text. Should be a no-op if autoFit is not specified. Required after the text changes, or if wrapFlag is true and the user attempts to change the extent." + | newExtent para cBounds lastOfLines heightOfLast | - | newExtent para cBounds lastOfLines heightOfLast wid | self isAutoFit ifTrue: + [ + newExtent := self paragraph extent max: 1 @ self defaultLineHeight. - [wid := (text notNil and: [text size > 2]) ifTrue: [5] ifFalse: [40]. - newExtent := (self paragraph extent max: wid @ ( self defaultLineHeight)) + (0 @ 2). newExtent := newExtent + (2 * self borderWidth). margins ifNotNil: [newExtent := ((0 @ 0 extent: newExtent) expandBy: margins) extent]. newExtent ~= bounds extent ifTrue: [(container isNil and: [successor isNil]) ifTrue: [para := paragraph. "Save para (layoutChanged smashes it)" super extent: newExtent. paragraph := para]]. container notNil & successor isNil ifTrue: [cBounds := container bounds truncated. "23 sept 2000 - try to allow vertical growth" lastOfLines := self paragraph lines last. heightOfLast := lastOfLines bottom - lastOfLines top. (lastOfLines last < text size and: [lastOfLines bottom + heightOfLast >= self bottom]) ifTrue: [container releaseCachedState. cBounds := cBounds origin corner: cBounds corner + (0 @ heightOfLast)]. self privateBounds: cBounds]]. "These statements should be pushed back into senders" self paragraph positionWhenComposed: self position. successor ifNotNil: [successor predecessorChanged]. self changed "Too conservative: only paragraph composition should cause invalidation."! Item was added: + ----- Method: TextMorph>>hResizing (in category 'layout-properties') ----- + hResizing + + self layoutProperties ifNotNil: [:props | + ^ props hResizing]. + + (self isAutoFit and: [self isWrapped]) + ifTrue: [^ #rigid]. "or #spaceFill" + (self isAutoFit and: [self isWrapped not]) + ifTrue: [^ #shrinkWrap]. + (self isAutoFit not and: [self isWrapped]) + ifTrue: [^ #rigid]. "or #spaceFill" + (self isAutoFit not and: [self isWrapped not]) + ifTrue: [^ #rigid]. "or #spaceFill"! Item was added: + ----- Method: TextMorph>>hResizing: (in category 'layout-properties') ----- + hResizing: aSymbol + + super hResizing: aSymbol. + + aSymbol == #shrinkWrap + ifTrue: [self autoFit: true; wrapFlag: false]; + ifFalse: ["#rigid or #spaceFill -- Prefer to not cut out text." + self autoFit: self vResizing == #shrinkWrap; wrapFlag: true]. + + self releaseParagraph.! Item was changed: ----- Method: TextMorph>>handleInteraction:fromEvent: (in category 'editing') ----- handleInteraction: interactionBlock fromEvent: evt "Perform the changes in interactionBlock, noting any change in selection and possibly a change in the size of the paragraph (ar 9/22/2001 - added for TextPrintIts)" + + | oldEditor oldParagraph oldText oldSelection | - | oldEditor oldParagraph oldText | oldEditor := editor. oldParagraph := paragraph. oldText := oldParagraph text copy. + oldSelection := oldParagraph selectionRects. "already copy" + "Note old selection." + self selectionChanged: oldSelection. + + interactionBlock value. - self selectionChanged. "Note old selection" - interactionBlock value. - (oldParagraph == paragraph) ifTrue:[ "this will not work if the paragraph changed" editor := oldEditor. "since it may have been changed while in block" ]. + + "Note new selection." + paragraph selectionRects in: [:newSelection | + newSelection ~= oldSelection ifTrue: [ + self selectionChanged: newSelection]]. + - self selectionChanged. "Note new selection" (oldText = paragraph text and: [ oldText runs = paragraph text runs ]) ifFalse:[ self paragraph composeAll. self updateFromParagraph ]. self setCompositionWindow.! Item was changed: ----- Method: TextMorph>>isAutoFit (in category 'accessing') ----- isAutoFit + + ^ autoFit ifNil: [autoFit := true]! - "Migrating old instances. The #isNil check may be removed in the future." - ^ autoFit isNil or: [autoFit]! Item was changed: ----- Method: TextMorph>>minHeight (in category 'layout') ----- minHeight | result | + "Layout specific. If either height or width are shrink-wrapping, we have to leave the other dimension as is. Otherwise, those results would be incorrect. Note that you can still set #extent: so smaller values to recompute the paragraph." + self vResizing == #shrinkWrap + ifTrue: [self fullBounds. ^ self height]. + textStyle ifNil: [^ 16]. result := (textStyle lineGrid + 2) + (self borderWidth*2). margins ifNil: [^ result]. ^ margins isRectangle ifTrue: [result + margins top + margins bottom] ifFalse: [margins isPoint ifTrue: [result + margins y + margins y] ifFalse: [result + (2*margins)]]! Item was changed: ----- Method: TextMorph>>minWidth (in category 'layout') ----- minWidth | result | + "Layout specific. If either height or width are shrink-wrapping, we have to leave the other dimension as is. Otherwise, those results would be incorrect. Note that you can still set #extent: so smaller values to recompute the paragraph." + self hResizing == #shrinkWrap + ifTrue: [self fullBounds. ^ self width]. + textStyle ifNil: [^ 9]. result := 9 + (self borderWidth*2). margins ifNil: [^ result]. ^ margins isRectangle ifTrue: [result + margins left + margins right] ifFalse: [margins isPoint ifTrue: [result + margins x + margins x] ifFalse: [result + (2*margins)]]! Item was changed: ----- Method: TextMorph>>selectionChanged (in category 'private') ----- selectionChanged + + self selectionChanged: self paragraph selectionRects.! - "Invalidate all the selection rectangles. - Make sure that any drop shadow is accounted for too." - self paragraph selectionRects - do: [:r | self - invalidRect: (self expandFullBoundsForDropShadow: (r intersect: self fullBounds))]! Item was added: + ----- Method: TextMorph>>selectionChanged: (in category 'private') ----- + selectionChanged: rects + "Invalidate all the selection rectangles. By using either fullBounds or outerBounds, we make sure that any drop shadow is accounted for too." + + | myBounds | + rects ifEmpty: [^ self]. + myBounds := fullBounds ifNil: [self outerBounds]. + rects do: [:r | self invalidRect: (r intersect: myBounds)].! Item was changed: ----- Method: TextMorph>>updateFromParagraph (in category 'private') ----- updateFromParagraph "A change has taken place in my paragraph, as a result of editing and I must be updated. If a line break causes recomposition of the current paragraph, or it the selection has entered a different paragraph, then the current editor will be released, and must be reinstalled with the resulting new paragraph, while retaining any editor state, such as selection, undo state, and current typing emphasis." | newStyle sel oldLast oldEditor back | paragraph ifNil: [^self]. wrapFlag ifNil: [wrapFlag := true]. editor ifNotNil: [oldEditor := editor. sel := editor selectionInterval. editor storeSelectionInParagraph]. text := paragraph text. paragraph textStyle = textStyle ifTrue: [self fit] ifFalse: ["Broadcast style changes to all morphs" newStyle := paragraph textStyle. (self firstInChain text: text textStyle: newStyle) recomposeChain. editor ifNotNil: [self installEditorToReplace: editor]]. (self isAutoFit and: [self isWrapped not]) ifTrue: [self extent: self paragraph extent; composeToBounds] + ifFalse: [self layoutChanged]. - ifFalse: [super layoutChanged]. sel ifNil: [^self]. "If selection is in top line, then recompose predecessor for possible ripple-back" predecessor ifNotNil: [sel first <= (self paragraph lines first last + 1) ifTrue: [oldLast := predecessor lastCharacterIndex. predecessor paragraph recomposeFrom: oldLast to: text size delta: 0. oldLast = predecessor lastCharacterIndex ifFalse: [predecessor changed. "really only last line" self predecessorChanged]]]. ((back := predecessor notNil and: [sel first <= self paragraph firstCharacterIndex]) or: [successor notNil and: [sel first > (self paragraph lastCharacterIndex + 1)]]) ifTrue: ["The selection is no longer inside this paragraph. Pass focus to the paragraph that should be in control." back ifTrue: [predecessor recomposeChain] ifFalse: [self recomposeChain]. self firstInChain withSuccessorsDo: [:m | (sel first between: m firstCharacterIndex and: m lastCharacterIndex + 1) ifTrue: [m installEditorToReplace: oldEditor. ^self passKeyboardFocusTo: m]]. self error: 'Inconsistency in text editor' "Must be somewhere in the successor chain"]. editor ifNil: ["Reinstate selection after, eg, style change" self installEditorToReplace: oldEditor]. "self setCompositionWindow." ! Item was added: + ----- Method: TextMorph>>vResizing (in category 'layout-properties') ----- + vResizing + + self layoutProperties ifNotNil: [:props | + ^ props vResizing]. + + (self isAutoFit and: [self isWrapped]) + ifTrue: [^ #shrinkWrap]. + (self isAutoFit and: [self isWrapped not]) + ifTrue: [^ #shrinkWrap]. + (self isAutoFit not and: [self isWrapped]) + ifTrue: [^ #rigid]. "or #spaceFill" + (self isAutoFit not and: [self isWrapped not]) + ifTrue: [^ #rigid]. "or #spaceFill"! Item was added: + ----- Method: TextMorph>>vResizing: (in category 'layout-properties') ----- + vResizing: aSymbol + + super vResizing: aSymbol. + + self autoFit: aSymbol == #shrinkWrap. + + self wrapDirection: (aSymbol == #shrinkWrap + ifTrue: [#topToBottom] + ifFalse: [#none]). + + self releaseParagraph.! Item was added: + ----- Method: TextMorph>>wrapDirection (in category 'layout-properties') ----- + wrapDirection + + self layoutProperties ifNotNil: [:props | + ^ props wrapDirection]. + + ^ self vResizing == #shrinkWrap + ifTrue: [#topToBottom] + ifFalse: [#none]! Item was removed: - ----- Method: TextMorphForEditView>>updateFromParagraph (in category 'private') ----- - updateFromParagraph - super updateFromParagraph. - editView setScrollDeltas.! Item was changed: ----- Method: TransformMorph>>layoutChanged (in category 'geometry') ----- layoutChanged "A submorph could have moved, thus changing my localBounds. Invalidate the cache." localBounds := nil. + super layoutChanged.! - "Only discard my fullBounds. Do not tell my owner." - fullBounds := nil.! Item was changed: ----- Method: WorldState>>displayWorld:submorphs: (in category 'update cycle') ----- displayWorld: aWorld submorphs: submorphs "Update this world's display." | deferredUpdateMode handsToDraw allDamage handDamageRects worldDamageRects | + aWorld fullBounds. "send #ownerChanged to submorphs." submorphs do: [:m | m fullBounds]. "force re-layout if needed" self checkIfUpdateNeeded ifFalse: [^ self]. "display is already up-to-date" deferredUpdateMode := self doDeferredUpdatingFor: aWorld. deferredUpdateMode ifFalse: [self assuredCanvas]. worldDamageRects := self drawWorld: aWorld submorphs: submorphs invalidAreasOn: self assuredCanvas. "repair world's damage on canvas" "self handsDo:[:h| h noticeDamageRects: worldDamageRects]." handsToDraw := self selectHandsToDrawForDamage: worldDamageRects. handDamageRects := handsToDraw collect: [:h | h savePatchFrom: canvas]. allDamage := worldDamageRects, handDamageRects. handsToDraw reverseDo: [:h | canvas fullDrawMorph: h]. "draw hands onto world canvas" "*make this true to flash damaged areas for testing*" Preferences debugShowDamage ifTrue: [aWorld flashRects: allDamage color: Color black]. canvas finish: allDamage. "quickly copy altered rects of canvas to Display:" deferredUpdateMode ifTrue: [self forceDamageToScreen: allDamage] ifFalse: [canvas showAt: aWorld viewBox origin invalidRects: allDamage]. handsToDraw do: [:h | h restoreSavedPatchOn: canvas]. "restore world canvas under hands" Display deferUpdates: false; forceDisplayUpdate. !

1 0

Re: [squeak-dev] Problem storing Lua code in dynamically created class side method.
by Jakob Reschke 22 Aug '19

22 Aug '19

(including the list in addresses again) Am Mi., 21. Aug. 2019 um 23:53 Uhr schrieb gettimothy <gettimothy(a)zoho.com>: > "1. Can't you just replace each ' in your Lua text by '' (two single > quotes) before compiling the Smalltalk method string? It escapes the single > quotes in the string." > > How? I tried wrapping it with String Concatenation and it failed to > compile. > > ", oldtext, ". > > > methodTemplateLua := 'lua ^ ''{1}'''. methodSourceLua := methodTemplateLua format: {lua copyReplaceTokens: '''' "four single quotes" with: '''''' "six single quotes"}. Or for more comfortable reading: lua copyReplaceTokens: (String with: $') with: (String with: $' with: $') Still, I would avoid tinkering with the code and go with the (class) instance variable approach if possible.

2 1

The Trunk: KernelTests-nice.370.mcz
by commits＠source.squeak.org 22 Aug '19

22 Aug '19

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.370.mcz ==================== Summary ==================== Name: KernelTests-nice.370 Author: nice Time: 22 August 2019, 12:34:59.288205 am UUID: b84345c4-295e-488a-a3bb-0e82f786d2f9 Ancestors: KernelTests-nice.369 Provide more systematic mixed float/int comparison tests for a good coverage of new spur64 primitive implementation. This new implementation follows the ideas proposed for resoution of https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/417 Move this material in FloatTest rather than SmallIntegerTest. =============== Diff against KernelTests-nice.369 =============== Item was changed: ClassTestCase subclass: #FloatTest + instanceVariableNames: 'exactInteger float greaterInexactInt smallerInexactInt greaterFloat smallerFloat boxedFloat greaterBoxedFloat smallerBoxedFloat' - instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'KernelTests-Numbers'! !FloatTest commentStamp: 'fbs 3/8/2004 22:13' prior: 0! I provide a test suite for Float values. Examine my tests to see how Floats should behave, and see how to use them.! Item was added: + ----- Method: FloatTest>>setUp (in category 'running') ----- + setUp + exactInteger := 1 << (Float precision + 2). + float := exactInteger asFloat. + greaterInexactInt := exactInteger + 1. + smallerInexactInt := exactInteger - 1. + greaterFloat := float successor. + smallerFloat := float predecessor. + + boxedFloat := Float new: 2. + boxedFloat basicAt: 1 put: (float basicAt: 1). + boxedFloat basicAt: 2 put: (float basicAt: 2). + greaterBoxedFloat := Float new: 2. + greaterBoxedFloat basicAt: 1 put: (greaterFloat basicAt: 1). + greaterBoxedFloat basicAt: 2 put: (greaterFloat basicAt: 2). + smallerBoxedFloat := Float new: 2. + smallerBoxedFloat basicAt: 1 put: (smallerFloat basicAt: 1). + smallerBoxedFloat basicAt: 2 put: (smallerFloat basicAt: 2).! Item was added: + ----- Method: FloatTest>>testComparisonSmallFromBoxed (in category 'tests - compare') ----- + testComparisonSmallFromBoxed + "Comparison should work the same, boxed or not" + + self assert: boxedFloat = float. + self deny: boxedFloat ~= float. + self deny: boxedFloat = smallerFloat. + self assert: boxedFloat ~= greaterFloat. + + self assert: boxedFloat < greaterFloat. + self assert: boxedFloat <= greaterFloat. + self deny: boxedFloat > greaterFloat. + self deny: boxedFloat >= greaterFloat. + + self deny: boxedFloat < smallerFloat. + self deny: boxedFloat <= smallerFloat. + self assert: boxedFloat > smallerFloat. + self assert: boxedFloat >= smallerFloat.! Item was added: + ----- Method: FloatTest>>testComparisonSmallWithBoxed (in category 'tests - compare') ----- + testComparisonSmallWithBoxed + "Comparison should work the same, boxed or not" + + self assert: float = boxedFloat. + self deny: float ~= boxedFloat. + self deny: float = smallerBoxedFloat. + self assert: float ~= greaterBoxedFloat. + + self assert: float < greaterBoxedFloat. + self assert: float <= greaterBoxedFloat. + self deny: float > greaterBoxedFloat. + self deny: float >= greaterBoxedFloat. + + self deny: float < smallerBoxedFloat. + self deny: float <= smallerBoxedFloat. + self assert: float > smallerBoxedFloat. + self assert: float >= smallerBoxedFloat.! Item was added: + ----- Method: FloatTest>>testExactComparisonFromSmallInt (in category 'tests - compare') ----- + testExactComparisonFromSmallInt + "Those tests works when using naive (integer asFloat = float) comparison. + This is because the conversion asFloat are exact." + + {float. boxedFloat} do: [:f | + self assert: exactInteger = f. + self deny: exactInteger ~= f. + self assert: exactInteger <= f. + self deny: exactInteger < f. + self assert: exactInteger >= f. + self deny: exactInteger > f]. + + {greaterFloat. greaterBoxedFloat} do: [:f | + self deny: exactInteger = f. + self assert: exactInteger ~= f. + self assert: exactInteger <= f. + self assert: exactInteger < f. + self deny: exactInteger >= f. + self deny: exactInteger > f]. + + {smallerFloat. smallerBoxedFloat} do: [:f | + self deny: exactInteger = f. + self assert: exactInteger ~= f. + self deny: exactInteger <= f. + self deny: exactInteger < f. + self assert: exactInteger >= f. + self assert: exactInteger > f].! Item was added: + ----- Method: FloatTest>>testExactComparisonWithSmallInt (in category 'tests - compare') ----- + testExactComparisonWithSmallInt + "Those tests works when using naive (integer asFloat = float) comparison. + This is because the conversion asFloat are exact." + + {float. boxedFloat} do: [:f | + self assert: f = exactInteger. + self deny: f ~= exactInteger. + self assert: f <= exactInteger. + self deny: f < exactInteger. + self assert: f >= exactInteger. + self deny: f > exactInteger]. + + {greaterFloat. greaterBoxedFloat} do: [:f | + self deny: f = exactInteger. + self assert: f ~= exactInteger. + self deny: f <= exactInteger. + self deny: f < exactInteger. + self assert: f >= exactInteger. + self assert: f > exactInteger]. + + {smallerFloat. smallerBoxedFloat} do: [:f | + self deny: f = exactInteger. + self assert: f ~= exactInteger. + self assert: f <= exactInteger. + self assert: f < exactInteger. + self deny: f >= exactInteger. + self deny: f > exactInteger].! Item was added: + ----- Method: FloatTest>>testInexactComparisonFromSmallInt (in category 'tests - compare') ----- + testInexactComparisonFromSmallInt + "Those tests would fail if using naive (integer asFloat = float) comparison. + This is because the conversion asFloat are inexact and loose bits." + + {float. boxedFloat} do: [:f | + self deny: smallerInexactInt = f. + self assert: greaterInexactInt ~= f. + + self assert: greaterInexactInt > f. + self deny: greaterInexactInt <= f. + self assert: smallerInexactInt < f. + self deny: smallerInexactInt >= f].! Item was added: + ----- Method: FloatTest>>testInexactComparisonOKFromSmallInt (in category 'tests - compare') ----- + testInexactComparisonOKFromSmallInt + "asFloat conversion is monotonic: + intA < intB ==> (intA asFloat <= intB asFloat). + Thus those tests would work if using naive (integer asFloat op: float) comparison, + even if asFloat conversion is inexact." + + {greaterFloat . greaterBoxedFloat} do: [:f | + self deny: smallerInexactInt = f. + self assert: smallerInexactInt ~= f. + + self assert: smallerInexactInt < f. + self assert: smallerInexactInt <= f. + self deny: smallerInexactInt > f. + self deny: smallerInexactInt >= f].! Item was added: + ----- Method: FloatTest>>testInexactComparisonOKWithSmallInt (in category 'tests - compare') ----- + testInexactComparisonOKWithSmallInt + "asFloat conversion is monotonic: + intA < intB ==> (intA asFloat <= intB asFloat). + Thus those tests would work if using naive (integer asFloat op: float) comparison, + even if asFloat conversion is inexact." + + {smallerFloat . smallerBoxedFloat} do: [:f | + self deny: f = greaterInexactInt. + self assert: f ~= greaterInexactInt. + + self assert: f < greaterInexactInt. + self assert: f <= greaterInexactInt. + self deny: f > greaterInexactInt. + self deny: f >= greaterInexactInt].! Item was added: + ----- Method: FloatTest>>testInexactComparisonWithSmallInt (in category 'tests - compare') ----- + testInexactComparisonWithSmallInt + "Those tests would fail if using naive (integer asFloat = float) comparison. + This is because the conversion asFloat are inexact and loose bits." + + {float. boxedFloat} do: [:f | + self deny: f = greaterInexactInt. + self assert: f ~= smallerInexactInt. + + self assert: f < greaterInexactInt. + self deny: f >= greaterInexactInt. + self assert: f > smallerInexactInt. + self deny: f <= smallerInexactInt].! Item was removed: - ----- Method: SmallIntegerTest>>testCompareWithBoxedFloat (in category 'tests - comparing') ----- - testCompareWithBoxedFloat - "In 64 bits, naive asFloat conversion should not be used" - - | bf sf si | - Smalltalk wordSize = 8 ifFalse: [^self]. - si := 1<<(Float precision + 2)+1. - sf := si asFloat. - (bf := BoxedFloat64 new: 2) basicAt: 1 put: (sf basicAt: 1);basicAt: 2 put: (sf basicAt: 2). - - self deny: si = bf. - self deny: bf = si.! Item was removed: - ----- Method: SmallIntegerTest>>testCompareWithSmallFloat (in category 'tests - comparing') ----- - testCompareWithSmallFloat - "In 64 bits, naive asFloat conversion should not be used" - - | sf si | - Smalltalk wordSize = 8 ifFalse: [^self]. - si := 1<<(Float precision + 2)+1. - sf := si asFloat. - self deny: sf = si. - self deny: si = sf.!

1 0

Problem storing Lua code in dynamically created class side method.
by gettimothy 21 Aug '19

21 Aug '19

Hi all. I am attempting to store the Wikimedia Lua Modules as Classes in my image. The idea being that when the Parser encounters a Module #invoke I can hand it off to the appropriate class and have it invoke Lua and return content to me. I have extracted the Wikimedia Modules to a postgres table named 'modules' and I am hitting that table and iterating over it to dynamically create the classes I need. The code is a modified version of what I used to scrape the Squeak Wiki. scrapeModulesToNewClass |rows | rows := ((WikitextParserConnectionPool default executeQuery: 'select page_id, page_title, old_text from modules limit 2') at:1) rows. rows do: [:each | |pageid pagetitle oldtext lua methodTemplatePageId methodTemplatePageTitle methodTemplateLua methodSourcePageId methodSourcePageTitle methodSourceLua newclassname| pageid := each at:1. pagetitle := each at:2. oldtext := each at:3. lua := oldtext . "I have been attempting String shenanigans here in attempts to get this to work" lua inspect. methodTemplatePageId := 'pageId ^', $', '{1}' ,$'. methodTemplatePageTitle := 'pageTitle ^', $', '{1}' ,$'. methodTemplateLua := 'lua ^', $', '{1}' ,$'. methodSourcePageId := methodTemplatePageId format:{pageid}. methodSourcePageTitle := methodTemplatePageTitle format:{pagetitle}. methodSourceLua := methodTemplateLua format:{lua}. newclassname := ('WikitextModule', pageid asString) asSymbol. WikitextParserModule subclass: newclassname instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'WikitextParser-Modules'. (Smalltalk at: newclassname) compile: methodSourcePageId. (Smalltalk at: newclassname) compile: methodSourcePageTitle. (Smalltalk at: newclassname) compile: methodSourceLua. "Transcript show: newclassname; cr." ] Works fine until (Smalltalk at: newclassname) compile: methodSourceLua. Here's why: lua ^'-- This module provides easy processing of arguments passed to Scribunto from -- #invoke. It is intended for use by other Lua modules, and should not be -- called from #invoke directly. local libraryUtil = require('libraryUtil End of block expected ->') local checkType = libraryUtil.checkType .......... end return arguments' The Method compilation fails. Should I even attempt to escape this thing? Remember, I am going to have to do an OSProcess lua call to run this stuff. I suppose I could just store the PGRow in the class, but that feels weird. Thanks in advance.

2 1

Re: [squeak-dev] The Trunk: Collections-pre.822.mcz
by Chris Muller 21 Aug '19

21 Aug '19

My main objection is about growing the "mutator" nomenclature further instead of trimming it back. I'm working on a GraphQL framework. GraphQL has a first-class notion of "mutations". https://graphql.org/learn/queries/ Currently, we have almost zero mention of the word "mutator" in the image. I would appreciate if, instead of germinating the overloading the word, we uproot it and keep the nomenclature for this Smalltalk tooling confined to "getter" and "setter" that we have now. So, instead of #asMutator and #isMutator, how about #asSimpleSetter and #isSimpleSetter? We can end up removing a method instead of adding one. We already have many existing methods which are dealing with this conversion, all of which use the traditional Smalltalk / developer linguisitic of "setter". Browsing through all the "setter" nomenclature we have in a message names browser, including Utilities class>>#getterSelectorFor: Utilities class>>#setterSelectorFor: Utilities class>>#simpleSetterFor: which instruct Etoys users to use existing methods on String, #asSetterSelector or #asSimpleSetter. Of special note is SyntaxMorph>>#isStandardSetterKeyword: which, by its use of a utility-method implementation, acknowledges that this behavior is _application-specific_. I, myself, would just write: someSelector asSimpleSetter = someSelector "same as isMutator / isSimpleSetter" instead of #isSimpleSetter, but can appreciate both styles. They both better avoid the awkwardness of "mutator" as a general, reliable behavior when: #at: isMutator "true" while #at:put: isMutator "false" Best, Chris On Thu, Mar 21, 2019 at 1:16 AM <patrick.rein(a)hpi.uni-potsdam.de> wrote: > > Which one are you refering to? I only see Symbol>>#asMutator in Collections in the method category converting. It is also used in a few other places beyond generating instance variable accessors. > > Bests, > Patrick > > >#asMutator: is for "generate instVar accessors" code-generation, and > >that's why it's in the Tools package. > > > >IMHO, if #isMutator belongs anywhere, it isn't in Collections. > > > >Regards, > > Chris > > > > > > > >On Wed, Mar 20, 2019 at 3:08 PM Chris Muller <asqueaker(a)gmail.com> wrote: > >> > >> Assuming a single-keyword is a mutator? Object>>#at: is not a > >> mutator. #indexOf: is not. #first: is not. Obviously many more.. > >> > >> If API balance is the goal of this, perhaps #asMutator should be > >> removed instead. This feels application-specific... > >> > >> On Wed, Mar 20, 2019 at 2:05 PM <commits(a)source.squeak.org> wrote: > >> > > >> > Patrick Rein uploaded a new version of Collections to project The Trunk: > >> > http://source.squeak.org/trunk/Collections-pre.822.mcz > >> > > >> > ==================== Summary ==================== > >> > > >> > Name: Collections-pre.822 > >> > Author: pre > >> > Time: 20 March 2019, 8:05:20.383677 pm > >> > UUID: 483c4461-cee4-4a4f-82d3-fbc03e7201cc > >> > Ancestors: Collections-dtl.821 > >> > > >> > Adds #isMutator to Symbol which is analogous to asMutator. > >> > > >> > =============== Diff against Collections-dtl.821 =============== > >> > > >> > Item was added: > >> > + ----- Method: Symbol>>isMutator (in category 'testing') ----- > >> > + isMutator > >> > + > >> > + ^ self isKeyword and: [self numArgs = 1]! > >> > > >> > > > >

6 12

The Trunk: KernelTests-nice.369.mcz
by commits＠source.squeak.org 21 Aug '19

21 Aug '19

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-nice.369.mcz ==================== Summary ==================== Name: KernelTests-nice.369 Author: nice Time: 21 August 2019, 2:58:16.866438 am UUID: 33f5c49d-b6ed-4384-805d-fad3fa2e5159 Ancestors: KernelTests-nice.368 Provide non regression tests for https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/415 =============== Diff against KernelTests-nice.368 =============== Item was changed: + ----- Method: SmallIntegerTest>>testCompareWithBoxedFloat (in category 'tests - comparing') ----- - ----- Method: SmallIntegerTest>>testCompareWithBoxedFloat (in category 'testing - Class Methods') ----- testCompareWithBoxedFloat "In 64 bits, naive asFloat conversion should not be used" | bf sf si | Smalltalk wordSize = 8 ifFalse: [^self]. si := 1<<(Float precision + 2)+1. sf := si asFloat. (bf := BoxedFloat64 new: 2) basicAt: 1 put: (sf basicAt: 1);basicAt: 2 put: (sf basicAt: 2). self deny: si = bf. self deny: bf = si.! Item was changed: + ----- Method: SmallIntegerTest>>testCompareWithSmallFloat (in category 'tests - comparing') ----- - ----- Method: SmallIntegerTest>>testCompareWithSmallFloat (in category 'testing - Class Methods') ----- testCompareWithSmallFloat "In 64 bits, naive asFloat conversion should not be used" | sf si | Smalltalk wordSize = 8 ifFalse: [^self]. si := 1<<(Float precision + 2)+1. sf := si asFloat. self deny: sf = si. self deny: si = sf.! Item was added: + ----- Method: SmallIntegerTest>>testDivideMayOverflow (in category 'tests - arithmetic') ----- + testDivideMayOverflow + "Dividing a SmallInteger by another Integer may answer a Large Integer. + These cases have caused several VM bugs in the past, it's better to keep some assrtion around." + + self assert: (SmallInteger minVal / -1) isLarge. + self assert: (SmallInteger minVal / -1) = (SmallInteger maxVal + 1). + + self assert: (SmallInteger minVal quo: -1) isLarge. + self assert: (SmallInteger minVal quo: -1) = (SmallInteger maxVal + 1). + + self assert: (SmallInteger minVal // -1) isLarge. + self assert: (SmallInteger minVal // -1) = (SmallInteger maxVal + 1).!

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
29
Older →

Jump to page: