[squeak-dev] The Trunk: EToys-ct.482.mczcommits at source.squeak.org commits at source.squeak.orgTue Sep 13 07:07:14 UTC 2022
Christoph Thiede uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.482.mcz ==================== Summary ==================== Name: EToys-ct.482 Author: ct Time: 13 September 2022, 9:00:07.422523 am UUID: 5c9ae0b6-6679-e448-a2bc-54572f1904b8 Ancestors: EToys-ct.481 Gradually improves high-dpi support for Etoys (TileMorph, ScriptEditorMorph, FileList2). Complements Tools-ct.1176. =============== Diff against EToys-ct.481 =============== Item was changed: ----- Method: FileList2 class>>buildFileTypeButtons:actionRow:fileList: (in category '*Etoys-Squeakland-blue ui') ----- buildFileTypeButtons: window actionRow: actionRow fileList: aFileList | fileTypeInfo fileTypeButtons fileTypeRow aButton | fileTypeInfo := self endingSpecs. fileTypeRow := window addARowCentered: #(). fileTypeRow color: ScriptingSystem paneColor. + fileTypeRow layoutInset: 3 px @ 3 px. + fileTypeRow cellInset: 2 px @ 0 px. - fileTypeRow layoutInset: 3 @ 3. - fileTypeRow cellInset: 2 @ 0. fileTypeRow hResizing: #spaceFill. fileTypeButtons := fileTypeInfo collect: [:each | aButton := self buildButtonText: each first balloonText: nil receiver: aFileList selector: #update:fileTypeRow:morphUp:. aButton arguments: {actionRow. fileTypeRow. aButton}. aButton setProperty: #enabled toValue: true. aButton setProperty: #buttonText toValue: each first. aButton]. fileTypeRow addAllMorphs: fileTypeButtons. aFileList directoryChangeBlock: [:newDir | self enableTypeButtons: fileTypeButtons info: fileTypeInfo + forDir: newDir].! - forDir: newDir]. - ! Item was changed: ----- Method: FileList2 class>>buildLoadButtons:fileList:reallyLoad: (in category '*Etoys-Squeakland-blue ui') ----- buildLoadButtons: window fileList: aFileList reallyLoad: aBoolean | aRow okButton cancelButton | okButton := self buildButtonText: 'OK' translated balloonText: nil receiver: aFileList selector: (aBoolean ifTrue: [#okHitForProjectLoader] ifFalse: [#okHit]). + okButton width: 150 px. - okButton width: 150. cancelButton := self buildButtonText: 'Cancel' translated balloonText: nil receiver: aFileList selector: #cancelHit. + cancelButton width: 150 px. - cancelButton width: 150. "aFileList updateLoginButtonAppearance." aRow := window addARow: {aFileList loginButton. aFileList loginField. okButton. cancelButton}. aRow color: ScriptingSystem paneColor. aRow listCentering: #bottomRight. + aRow layoutInset: 3 px @ 3 px. + aRow cellInset: 6 px @ 3 px. - aRow layoutInset: 3 @ 3. - aRow cellInset: 6 @ 3. ^ aRow! Item was changed: ----- Method: FileList2 class>>buildPane:fileList:window:dirFilterType: (in category '*Etoys-Squeakland-blue ui') ----- buildPane: aWorld fileList: aFileList window: window dirFilterType: aSymbol | treeExtent filesExtent treePane fileListPane pane2a pane2b aRow | + aWorld width < 800 px + ifTrue: [treeExtent := 150 px @ 300 px. + filesExtent := 350 px @ 300 px] + ifFalse: [treeExtent := 250 px @ 300 px. + filesExtent := 350 px @ 300 px]. - aWorld width < 800 - ifTrue: [treeExtent := 150 @ 300. - filesExtent := 350 @ 300] - ifFalse: [treeExtent := 250 @ 300. - filesExtent := 350 @ 300]. (treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent; retractable: false; borderWidth: 0. fileListPane := aFileList morphicFileListPane extent: filesExtent; retractable: false; borderWidth: 0. + aRow := window addARow: {(window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCornersInEtoys; layoutInset: 3 px}) + layoutInset: 3 px. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCornersInEtoys; layoutInset: 3 px}) + layoutInset: 3 px}. - aRow := window addARow: {(window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCornersInEtoys; layoutInset: 3}) - layoutInset: 3. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCornersInEtoys; layoutInset: 3}) - layoutInset: 3}. aRow color: ScriptingSystem paneColor. window fullBounds. {pane2a. pane2b} do: [:each | + each borderWidth: 1 px. - each borderWidth: 1. each borderColor: ScriptingSystem borderColor]. ^ treePane.! Item was changed: ----- Method: FileList2 class>>buildSaveButtons:fileList: (in category '*Etoys-Squeakland-blue ui') ----- buildSaveButtons: window fileList: aFileList | buttonData buttons aRow | buttonData := Preferences enableLocalSave ifTrue: [#(#('Save' #okHit 'Save in the place specified above') #('Save on local disk only' #saveLocalOnlyHit 'saves in the Squeaklets folder') #('Cancel' #cancelHit 'return without saving') ) translatedNoop] ifFalse: [#(#('Save' #okHit 'Save in the place specified above') #('Cancel' #cancelHit 'return without saving') ) translatedNoop]. buttons := buttonData collect: [:each | self buildButtonText: each first translated balloonText: each third translated receiver: aFileList selector: each second]. aFileList updateLoginButtonAppearance. buttons := {aFileList loginButton. aFileList loginField. Morph new color: Color transparent; width: 50}, buttons. aRow := window addARow: buttons. aRow color: ScriptingSystem paneColor. aRow listCentering: #bottomRight. + aRow layoutInset: 3 px @ 3 px. + aRow cellInset: 6 px @ 3 px. - aRow layoutInset: 3 @ 3. - aRow cellInset: 6 @ 3. ^ aRow! Item was changed: ----- Method: FileList2 class>>fontForBlueFileListButtons (in category '*Etoys-Squeakland-blue ui') ----- fontForBlueFileListButtons "Answer the font to use in the buttons of the blue file-list dialogs used by olpc users of etoys." + ^ Preferences standardButtonFont! - ^ Preferences standardEToysFont! Item was changed: ----- Method: FileList2>>updateLoginButtonAppearance (in category '*Etoys-Squeakland-private') ----- updateLoginButtonAppearance | old oldField notLoggedInMessage | notLoggedInMessage := '(not logged in)' translated. old := self loginButton. oldField := self loginField. self loginField: (Morph new color: Color white). + self loginField borderWidth: 2 px. - self loginField borderWidth: 2. self loginField borderColor: ScriptingSystem baseColor. self loginField beSticky. + self loginField width: 150 px. + self loginField height: 30 px. - self loginField width: 150. - self loginField height: 30. self loginField clipSubmorphs: true. EtoysUtilities loggedIn ifTrue: [ self loginButton: (self class buildButtonText: 'Logout' translated balloonText: nil receiver: self selector: #logoutHit). self loginButton color: ScriptingSystem baseColor. self loginField addMorphCentered: (StringMorph contents: (Utilities authorNamePerSe ifNil: [notLoggedInMessage]) font: Preferences standardEToysButtonFont). self loginButton setBalloonText: 'Log out from the Squeakland server' translated. self loginField setBalloonText: 'Your Squeakland user name' translated. ] ifFalse: [ self loginButton: (self class buildButtonText: 'Login' translated balloonText: nil receiver: self selector: #loginHit). self loginButton color: ScriptingSystem baseColor. self loginField addMorphCentered: (StringMorph contents: notLoggedInMessage font: Preferences standardEToysButtonFont). self loginButton setBalloonText: 'Log in to share projects on the Squeakland server' translated. self loginField setBalloonText: 'Your Squeakland user name' translated ]. self loginButton setNamePropertyTo: 'login'. + self loginButton width: 150 px. - self loginButton width: 150. old ifNotNil: [ old owner addMorph: self loginButton inFrontOf: old. old delete]. oldField ifNotNil: [ oldField owner addMorph: self loginField inFrontOf: oldField. + oldField delete].! - oldField delete]. - ! Item was changed: ----- Method: ScriptEditorMorph>>buttonRowForEditor (in category 'buttons') ----- buttonRowForEditor "Answer a row of buttons that comprise the header at the top of the Scriptor" | aRow aString aStatusMorph aButton aTile aMorph goldBoxButton aBox | + aRow := AlignmentMorph newRow color: ScriptingSystem baseColor; layoutInset: 1 px. - aRow := AlignmentMorph newRow color: ScriptingSystem baseColor; layoutInset: 1. aRow hResizing: #spaceFill. aRow vResizing: #shrinkWrap. self addDismissButtonTo: aRow. + aRow addTransparentSpacerOfSize: 9 px. - aRow addTransparentSpacerOfSize: 9. "Player's name" aString := playerScripted externalName. aMorph := StringMorph contents: aString font: ScriptingSystem fontForTiles. aMorph setNameTo: 'title'. aRow addMorphBack: aMorph. + aRow addTransparentSpacerOfSize: 6 px. - aRow addTransparentSpacerOfSize: 6. "Script's name" aBox := AlignmentMorph newRow. aBox hResizing: #shrinkWrap; vResizing: #shrinkWrap. aBox color: (Color r: 0.839 g: 1.0 b: 0.806). + aBox borderWidth: 1 px. - aBox borderWidth: 1. aBox borderColor: (Color r: 0.645 g: 0.774 b: 0.613). aButton := UpdatingStringMorph new. aButton useStringFormat; target: self; getSelector: #scriptTitle; setNameTo: 'script name'; font: ScriptingSystem fontForNameEditingInScriptor; putSelector: #setScriptNameTo:; setProperty: #okToTextEdit toValue: true; step; yourself. aBox addMorph: aButton. aRow addMorphBack: aBox. aBox setBalloonText: 'Click here to edit the name of the script.' translated. "aRow addTransparentSpacerOfSize: 9." aRow addVariableTransparentSpacer. "Try It button" self hasParameter ifFalse: [aRow addMorphBack: ((ThreePhaseButtonMorph labelSymbol: #TryIt target: self actionSelector: #tryMe arguments: #()) actWhen: #whilePressed; balloonTextSelector: #tryMe). + aRow addTransparentSpacerOfSize: 3 px]. - aRow addTransparentSpacerOfSize: 3]. "Step button, only for non-Kedama" (self playerScripted isPrototypeTurtlePlayer or: [self hasParameter]) ifFalse: [aRow addMorphBack: (aButton := ThreePhaseButtonMorph labelSymbol: #StepMe target: self actionSelector: #stepMe arguments: #()). aButton balloonTextSelector: #stepMe. + aRow addTransparentSpacerOfSize: 3 px]. - aRow addTransparentSpacerOfSize: 3]. "Status controller" self hasParameter ifTrue: [aTile := TypeListTile new choices: Vocabulary typeChoicesForUserVariables dataType: nil. aTile addArrows. aTile setLiteral: self typeForParameter. aRow addMorphBack: aTile. aTile borderColor: Color red. aTile color: ScriptingSystem uniformTileInteriorColor. aTile setBalloonText: 'Drag from here to get a parameter tile' translated. aTile addCaretsAsAppropriate: true] ifFalse: [aRow addMorphBack: (aStatusMorph := self scriptInstantiation statusControlMorph)]. + "aRow addTransparentSpacerOfSize: 3 px." - "aRow addTransparentSpacerOfSize: 3." aRow addVariableTransparentSpacer. "Gold-box" aRow addMorphBack: (goldBoxButton := IconicButton new). goldBoxButton borderWidth: 0; labelGraphic: (ScriptingSystem formAtKey: 'RoundGoldBox'); color: Color transparent; actWhen: #buttonDown; target: self; actionSelector: #offerGoldBoxMenu; shedSelvedge; setBalloonText: 'click here to get a palette of useful tiles to use in your script.' translated. + aRow addTransparentSpacerOfSize: 6 px @ 1 px. - aRow addTransparentSpacerOfSize: 6 at 1. "Menu Button" aButton := self menuButton. aButton actionSelector: #offerScriptorMenu. aRow addMorphBack: aButton. (playerScripted existingScriptInstantiationForSelector: scriptName) ifNotNil: [:inst | inst updateStatusMorph: aStatusMorph]. ^ aRow! Item was changed: ----- Method: ScriptEditorMorph>>createThreadShowing (in category 'menu commands') ----- createThreadShowing | vertices | self deleteThreadShowing. vertices := OrderedCollection new. self tileRows do: [:row | | b | row first isTurtleRow ifTrue: [ b := row first bounds. + vertices add: ((b topLeft + (4 px @ 0)) + ((0 * 0.1 * b width) @ 0)). - vertices add: ((b topLeft + (4 @ 0)) + ((0 * 0.1 * b width) @ 0)). 0 to: 9 do: [:i | + vertices add: ((b topLeft + (4 px @ 4 px))+ ((i * 0.1 * b width ) @ 0)). + vertices add: ((b bottomLeft + (4 px @ -4 px)) + ((i * 0.1 * b width) @ 0)). - vertices add: ((b topLeft + (4 @ 4))+ ((i * 0.1 * b width ) @ 0)). - vertices add: ((b bottomLeft + (4 @ -4)) + ((i * 0.1 * b width) @ 0)). ]. + vertices add: ((b bottomLeft + (4 px @ 0)) + ((9 * 0.1 * b width) @ 0)). - vertices add: ((b bottomLeft + (4 @ 0)) + ((9 * 0.1 * b width) @ 0)). ] ifFalse: [ b := row first bounds. vertices add: ((b origin x + b corner x) // 2) @ (b origin y). + vertices add: ((b origin x + b corner x) // 2) @ (b origin y + 4 px). + vertices add: ((b origin x + b corner x) // 2) @ (b corner y - 4 px). - vertices add: ((b origin x + b corner x) // 2) @ (b origin y + 4). - vertices add: ((b origin x + b corner x) // 2) @ (b corner y - 4). vertices add: ((b origin x + b corner x) // 2) @ (b corner y). ]. ]. + threadPolygon := PolygonMorph vertices: vertices color: Color black borderWidth: 2 px borderColor: Color black. - threadPolygon := PolygonMorph vertices: vertices color: Color black borderWidth: 2 borderColor: Color black. threadPolygon makeOpen. + threadPolygon openInWorld.! - threadPolygon openInWorld. - ! Item was changed: ----- Method: ScriptEditorMorph>>defaultBorderWidth (in category 'initialization') ----- defaultBorderWidth "answer the default border width for the receiver" + ^ 1 px! - ^ 1! Item was changed: ----- Method: ScriptEditorMorph>>explainStatusAlternatives (in category 'customevents-other') ----- explainStatusAlternatives "Explain the scripting-status alternatives." + ScriptingSystem putUpInfoPanelFor:(ScriptingSystem statusHelpStringFor: playerScripted) title: 'Script Status' translated extent: 800 px @ 500 px! - ScriptingSystem putUpInfoPanelFor:(ScriptingSystem statusHelpStringFor: playerScripted) title: 'Script Status' translated extent: 800 at 500! Item was changed: ----- Method: ScriptEditorMorph>>extent: (in category 'other') ----- extent: x | newExtent tw menu | newExtent := x max: self minWidth @ self minHeight. (tw := self findA: ScrollPane) ifNil: ["This was the old behavior" ^ super extent: newExtent]. (self hasProperty: #autoFitContents) ifTrue: [ menu := MenuMorph new defaultTarget: self. menu addUpdating: #autoFitString target: self action: #autoFitOnOff. menu addTitle: 'To resize the script, uncheck the box below' translated. menu popUpEvent: nil in: self world . ^ self]. "Allow the user to resize to any size" tw extent: ((newExtent x max: self firstSubmorph width) + @ (newExtent y - self firstSubmorph height)) - (self borderWidth * 2) + (-4 px @ -4 px). "inset?" - @ (newExtent y - self firstSubmorph height)) - (self borderWidth * 2) + (-4 @ -4). "inset?" ^ super extent: newExtent! Item was changed: ----- Method: ScriptEditorMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" self listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap; cellPositioning: #topLeft; setProperty: #autoFitContents toValue: true; minHeight: TileMorph defaultH; + layoutInset: 2 px. - layoutInset: 2. self useRoundedCornersInEtoys. self borderColor: ScriptingSystem borderColor. self setNameTo: 'Script Editor' translated. firstTileRow := 1. "index of first tile-carrying submorph" self addNewRow. + showingMethodPane := false.! - showingMethodPane := false. - ! Item was changed: ----- Method: ScriptEditorMorph>>setupMethodMorph (in category '*Etoys-Squeakland-buttons') ----- setupMethodMorph "create textual source instead" | aCodePane | aCodePane := MethodHolder isolatedCodePaneForClass: playerScripted class selector: scriptName. aCodePane hResizing: #spaceFill; vResizing: #spaceFill; + minHeight: 100 px. - minHeight: 100. self hResizing: #shrinkWrap; vResizing: #shrinkWrap. self addMorphBack: aCodePane. self fullBounds. self listDirection: #topToBottom; hResizing: #rigid; vResizing: #rigid; rubberBandCells: true; minWidth: self width. showingMethodPane := true. self currentWorld startSteppingSubmorphsOf: self! Item was changed: ----- Method: TileMorph>>arrowDelta (in category 'mouse handling') ----- arrowDelta "Answer the amount by which a number I display should increase at a time" | readout | (readout := self findA: UpdatingStringMorph) ifNotNil: [^readout floatPrecision ]. + ^ 1 px! - ^ 1! Item was changed: ----- Method: TileMorph>>basicWidth (in category 'misc') ----- basicWidth "Provide a nominal minimum, exclusive of arrows and independent of label width" ^ operatorOrExpression + ifNotNil: [3 px] + ifNil: [18 px]! - ifNotNil: [3] - ifNil: [18]! Item was changed: ----- Method: TileMorph>>buildHPopArrows (in category '*Etoys-Squeakland-arrows popup') ----- buildHPopArrows | panel left right | self outmostScriptEditor ifNil: [^ nil]. (retractArrow isNil and: [suffixArrow isNil]) ifTrue: [^ nil]. panel := Morph new. panel cornerStyle: #rounded. left := SketchMorph new form: (ScriptingSystem formAtKey: #LargeLeftArrow). right := SketchMorph new form: (ScriptingSystem formAtKey: #LargeRightArrow). panel color: color. panel sticky: true. panel layoutPolicy: TableLayout new. panel listDirection: #leftToRight. panel hResizing: #shrinkWrap. panel vResizing: #shrinkWrap. + panel cellInset: 4 px. + panel layoutInset: 2 px. - panel cellInset: 4. - panel layoutInset: 2. retractArrow ifNotNil: [panel addMorphBack: left]. suffixArrow ifNotNil: [panel addMorphBack: right]. panel on: #mouseLeave send: #hidePopArrows to: self. left on: #mouseUp send: #popArrowRetractArrowHit: to: self. right on: #mouseUp send: #popArrowSuffixArrowHit: to: self. ^ panel! Item was changed: ----- Method: TileMorph>>buildVPopArrows (in category '*Etoys-Squeakland-arrows popup') ----- buildVPopArrows | panel up down | upArrow ifNil: [^ nil]. panel := Morph new. panel cornerStyle: #rounded. up := SketchMorph new form: (ScriptingSystem formAtKey: #LargeUpArrow). down := SketchMorph new form: (ScriptingSystem formAtKey: #LargeDownArrow). panel color: color. panel sticky: true. panel layoutPolicy: TableLayout new. panel listDirection: #topToBottom. panel hResizing: #shrinkWrap. panel vResizing: #shrinkWrap. + panel cellInset: 4 px. + panel layoutInset: 2 px. - panel cellInset: 4. - panel layoutInset: 2. panel addMorphBack: up. panel addMorphBack: down. panel on: #mouseLeave send: #hidePopArrows to: self. up on: #mouseDown send: #popArrowUp: to: self. up on: #mouseMove send: #popArrowMouseMove: to: self. down on: #mouseDown send: #popArrowDown: to: self. down on: #mouseMove send: #popArrowMouseMove: to: self. ^ panel! Item was changed: ----- Method: TileMorph>>convertAlignment (in category 'private') ----- convertAlignment "Convert the receiver's alignment rules" | where frame | owner ifNotNil:[ owner class == TilePadMorph ifTrue:[ owner layoutPolicy: TableLayout new. owner hResizing: #shrinkWrap. owner vResizing: #spaceFill. ]. ]. self layoutPolicy: TableLayout new. + self cellInset: 2 px @ 0. + self layoutInset: 1 px @ 0. - self cellInset: 2 at 0. - self layoutInset: 1 at 0. self listDirection: #leftToRight. self wrapCentering: #center. self hResizing: #shrinkWrap. self vResizing: #spaceFill. "Now convert up and down arrow" (upArrow notNil and:[upArrow owner == self "e.g., not converted" and:[downArrow notNil and:[downArrow owner == self]]]) ifTrue:[ "where to insert the frame" where := (submorphs indexOf: upArrow) min: (submorphs indexOf: downArrow). frame := Morph new color: Color transparent. frame layoutPolicy: TableLayout new; listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap; + cellInset: 0 @ 1 px; + layoutInset: 0 @ 1 px. - cellInset: 0 at 1; - layoutInset: 0 at 1. self privateAddMorph: frame atIndex: where. frame addMorphBack: upArrow; addMorphBack: downArrow. + ].! - ]. - ! Item was changed: ----- Method: TileMorph>>defaultBorderWidth (in category 'initialization') ----- defaultBorderWidth "answer the default border width for the receiver" + ^ 1 px! - ^ 1! Item was changed: ----- Method: TileMorph>>emblazonPlayerNameOnReferenceTileWithin: (in category '*Etoys-Squeakland-initialization') ----- emblazonPlayerNameOnReferenceTileWithin: scriptorOrViewer "Make the string within the receiver be the right thing." | newLabel usePad | newLabel := actualObject externalName. Preferences implicitSelfInTiles ifTrue: [scriptorOrViewer ifNotNil: [scriptorOrViewer playerScripted == actualObject ifTrue: [newLabel := '']]]. (newLabel notEmpty and: [self isPossessive]) ifTrue: [newLabel := newLabel, '''s' translated]. self line1: newLabel. usePad := owner isKindOf: TilePadMorph. newLabel ifEmpty: [usePad ifTrue: [owner hResizing: #rigid; width: 0; clipSubmorphs: true]. self hResizing: #rigid; width: 0; borderWidth: 0] ifNotEmpty: [usePad ifTrue: [owner hResizing: #shrinkWrap; clipSubmorphs: false]. + self hResizing: #shrinkWrap; borderWidth: 1 px] - self hResizing: #shrinkWrap; borderWidth: 1] ! Item was changed: ----- Method: TileMorph>>initialize (in category 'initialization') ----- initialize "initialize the state of the receiver" super initialize. "" + self extent: 1 px @ 1 px. - self extent: 1 @ 1. self typeColor: (Color r: 0.8 g: 1.0 b: 0.6). type := #literal. "#literal, #slotRef, #objRef, #operator, #expression" slotName := ''. literal := 1. self layoutPolicy: TableLayout new. self minCellSize: 0 @ TileMorph defaultH. + self cellInset: 2 px @ 0. + self layoutInset: 1 px @ 0. - self cellInset: 2 @ 0. - self layoutInset: 1 @ 0. self listDirection: #leftToRight. self wrapCentering: #center. self hResizing: #shrinkWrap. self vResizing: #spaceFill! Item was changed: ----- Method: TileMorph>>layoutChanged (in category 'layout') ----- layoutChanged | vpanel hpanel popArrows | super layoutChanged. self labelMorph ifNil: [^ self]. popArrows := self activeHand ifNil: [^ self] ifNotNil: [:ac | ac valueOfProperty: #popArrows ifAbsent: [^ self]]. popArrows first == self ifFalse: [^ self]. vpanel := popArrows second. hpanel := popArrows third. vpanel ifNotNil: [vpanel openInWorld. vpanel center: self labelMorph center. + vpanel right: self labelMorph left - 2 px]. - vpanel right: self labelMorph left - 2]. hpanel ifNotNil: [hpanel openInWorld. hpanel center: self labelMorph center. + hpanel left: self labelMorph right + 2 px]! - hpanel left: self labelMorph right + 2]! Item was changed: ----- Method: TileMorph>>line1: (in category 'private') ----- line1: line1 "Emblazon the receiver with the requested label. If the receiver already has a label, make the new label be of the same class" | m desiredW classToUse lab f | classToUse := (lab := self labelMorph) ifNotNil: [lab class] ifNil: [StringMorph]. self removeAllMorphs. f := ScriptingSystem fontForTiles. (type = #operator and: [#(+ - * / // \\ < <= > >= = ~=) includes: operatorOrExpression]) ifTrue: [ f := f emphasized: 1]. m := classToUse contents: line1 font: f. + desiredW := m width + 6 px. - desiredW := m width + 6. self extent: (desiredW max: self minimumWidth) @ self class defaultH. m position: self center - (m extent // 2). self addMorph: m. ! Item was changed: ----- Method: TileMorph>>setVisibilityOfUpDownCarets: (in category '*Etoys-Squeakland-arrows') ----- setVisibilityOfUpDownCarets: showCarets "If the argument is true, make all the 'up and down' carets, such as those that let you change the value of a number or of a boolean constant, visible; if false, remove them from sight. " (submorphs detect: [:m | m hasProperty: #arrows] ifNone: [nil]) ifNotNil: [:wrapper | showCarets + ifTrue: [wrapper width: 9 px] - ifTrue: [wrapper width: 9] ifFalse: [wrapper width: 0]]! Item was changed: ----- Method: TileMorph>>test (in category 'private') ----- test | pos | "Set the position of all my submorphs. Compute my bounds. Caller must call layoutChanged or set fullBounds to nil." fullBounds ifNil: [ pos := self topLeft. self submorphsDo: [:sub | | hh | hh := (self class defaultH - sub height) // 2. "center in Y" + sub privateBounds: (pos + (2 px @ hh) extent: sub extent). + pos x: (sub right min: 1200 px)]. "2 pixels spacing on left" + bounds := bounds topLeft corner: pos + (2 px @ self class defaultH). - sub privateBounds: (pos + (2 at hh) extent: sub extent). - pos x: (sub right min: 1200)]. "2 pixels spacing on left" - bounds := bounds topLeft corner: pos + (2 @ self class defaultH). fullBounds := bounds. ]. owner class == TilePadMorph ifTrue: [owner bounds: bounds]. ^ fullBounds!
More information about the Squeak-dev mailing list |