'From etoys3.0 of 24 February 2008 [latest update: #1986] on 1 May 2008 at 10:27:51 am'! !AllPlayersTool methodsFor: 'menus' stamp: 'KR 5/1/2008 08:41'! addCustomMenuItems: aMenu hand: aHand "Add further items to the menu" aMenu add: 'reinvigorate' translated target: self action: #reinvigorate. Preferences eToyFriendly ifFalse: [aMenu add: 'inspect' translated target: self action: #inspect]! ! !ButtonProperties methodsFor: 'menu' stamp: 'KR 5/1/2008 09:44'! setActWhen | selections | #('mouseDown' 'mouseUp' 'mouseStillDown') translatedNoop. selections _ #(mouseDown mouseUp mouseStillDown). actWhen _ (SelectionMenu labels: (selections collect: [:t | t translated]) selections: selections) startUpWithCaption: 'Choose one of the following conditions' translated ! ! !EToyProjectRenamerMorph methodsFor: 'as yet unclassified' stamp: 'KR 5/1/2008 08:39'! cancelButton ^self buttonNamed: 'Cancel' translated action: #doCancel color: self buttonColor help: 'Cancel this Publish operation.' translated! ! !EToyProjectRenamerMorph methodsFor: 'as yet unclassified' stamp: 'KR 5/1/2008 08:39'! okButton ^self buttonNamed: 'OK' translated action: #doOK color: self buttonColor help: 'Change my name and continue publishing.' translated! ! !FileList2 class methodsFor: 'blue ui' stamp: 'KR 5/1/2008 08:35'! buildSaveButtons: window fileList: aFileList | buttonData buttons aRow | buttonData := Preferences enableLocalSave ifTrue: [#(#('Save' #okHit 'Save in the place specified below, and in the Squeaklets folder on your local disk') #('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 below, and in the Squeaklets folder on your local disk') #('Cancel' #cancelHit 'return without saving') ) translatedNoop]. buttons := buttonData collect: [:each | self buildButtonText: each first translated balloonText: each third translated receiver: aFileList selector: each second]. aRow := window addARow: buttons. aRow color: ScriptingSystem paneColor. aRow listCentering: #bottomRight. aRow layoutInset: 3 @ 3. aRow cellInset: 6 @ 3. ^ aRow! ! !Flaps class methodsFor: '*connectorsShapes-flaps' stamp: 'KR 5/1/2008 10:11'! newClassDiagramConnectorsFlap "Answer a newly-created flap which adheres to the left edge of the screen and which holds prototypes of Connectors parts relevant to UML class diagrams." " Flaps newClassDiagramConnectorsFlap openInWorld; setToPopOutOnDragOver: false. " | aFlapTab aStrip | aStrip _ self preferredConnectorsFlapBinClass newPartsBinWithOrientation: #leftToRight andColor: (Color blue muchLighter alpha: 0.3) from: self quadsDefiningClassDiagramConnectorsFlap buttonClass: self preferredConnectorsButtonClass. aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setName: 'Class Diagrams' translated edge: #bottom color: Color blue muchLighter. aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip beFlap: true. aStrip extent: (self currentWorld width @ 78). aStrip submorphsDo: [ :ea | ea updateImage ]. ^aFlapTab ! ! !Flaps class methodsFor: '*connectorsShapes-flaps' stamp: 'KR 5/1/2008 10:10'! newNCPartsBinFlap "Answer a newly-created flap which adheres to the left edge of the screen." "Flaps newNCPartsBinFlap openInWorld; setToPopOutOnDragOver: false." | aFlapTab aStrip | aStrip _ self preferredConnectorsFlapBinClass newPartsBinWithOrientation: #topToBottom andColor: (Color orange muchLighter alpha: 0.8) from: #() buttonClass: self preferredConnectorsButtonClass. aFlapTab _ FlapTab new referent: aStrip beSticky. aFlapTab setName: 'My Flap' translated edge: #left color: Color orange lighter. aFlapTab position: (self currentWorld width - aFlapTab width) @ ((Display height - aFlapTab height) * 2 // 3). aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu. aStrip extent: (120 @ self currentWorld height). aStrip beFlap: true. aStrip color: (Color orange muchLighter alpha: 0.8). ^ aFlapTab ! ! !Flaps class methodsFor: '*green' stamp: 'KR 5/1/2008 10:16'! destroyFlapDotDotDot "Prompt the user for a flap, and destroy the one chosen" | aMenu | aMenu _ MenuMorph new. aMenu title: 'Destroy flap named...' translated. self globalFlapTabsIfAny do: [:aFlapTab | aMenu add: aFlapTab flapID target: aFlapTab selector: #destroyFlap]. aMenu popUpInWorld. ! ! !NCAAConnectorMorph methodsFor: 'menus' stamp: 'KR 5/1/2008 08:56'! changeBorderWidthInteractively: evt "Copied from BorderedMorph" | handle origin aHand newWidth oldWidth | aHand _ evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin _ aHand position. oldWidth _ self borderWidth. handle _ HandleMorph new forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth _ (newPoint - origin) r / 10.0. self borderWidth: (newWidth max: 0)] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNilDo: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'border change'; undoTarget: self selector: #borderWidth: argument: oldWidth; redoTarget: self selector: #borderWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor farther from this point to increase border width. Click when done.' translated hand: evt hand. handle startStepping! ! !NCAAConnectorMorph methodsFor: 'menus' stamp: 'KR 5/1/2008 08:56'! changeLineWidthInteractively: evt "Copied from BorderedMorph" | handle origin aHand newWidth oldWidth | aHand _ evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin _ aHand position. oldWidth _ self lineWidth. handle _ HandleMorph new forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newWidth _ (newPoint - origin) r / 15.0. self lineWidth: (newWidth max: 1)] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNilDo: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'line width change'; undoTarget: self selector: #lineWidth: argument: oldWidth; redoTarget: self selector: #lineWidth: argument: newWidth)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor farther from this point to increase line width. Click when done.' translated hand: evt hand. handle startStepping! ! !NCBasicShapeMorph methodsFor: 'menus' stamp: 'KR 5/1/2008 08:58'! promptForFont TextStyle promptForFont: 'Choose font:' translated andSendTo: self withSelector: #setAllFontsTo:! ! !NCBasicShapeMorph methodsFor: 'menus' stamp: 'KR 5/1/2008 08:58'! promptForFontFor: aMorph TextStyle promptForFont: 'Choose font for text:' translated andSendTo: aMorph withSelector: #beAllFont:! ! !NCConstraintMorph methodsFor: 'menus' stamp: 'KR 5/1/2008 09:35'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine; add: 'attach to...' translated action: #attachToSelectedMorph:; add: 'display attachments' translated action: #displayInputs; addLine. false ifTrue: [aCustomMenu add: 'add arbitrary shape...' translated target: self selector: #addSelectedMorph:. self class preMadeShapeNames isEmpty ifFalse: [aCustomMenu add: 'add pre-made shape...' translated subMenu: self selectShapeMenu]. aCustomMenu add: 'delete shape...' translated target: self selector: #deleteSelectedMorph:; addLine]. "connectToAbsolutePoint:" #('connect to center' 'connect to nearest attachment point' 'connect to nearest point' 'connect to nearest point to center' 'connect to relative point:' 'no connection preference' ) translatedNoop. #(#connectToCenter #connectToNearestAttachmentPoint #connectToNearestPoint #connectToNearestPointToCenter #connectToRelativePoint: #noConnectionPreference ) do: [:sel | aCustomMenu addUpdating: #connectionWordingFor: target: self selector: #choosePreferredConnection: argumentList: {sel}]. self dieWithInput ifFalse: [aCustomMenu addUpdating: #connectionWordingFor: target: self selector: #choosePreferredConnection: argumentList: #(#connectToNothing )]! ! !NCGlyphEditor methodsFor: 'button actions' stamp: 'KR 5/1/2008 08:59'! chooseFont | menu | menu _ MenuMorph entitled: 'Choose Font' translated. TextStyle actualTextStyles keysAndValuesDo: [ :styleName :style | style isTTCStyle ifTrue: [ | ttfont | ttfont _ style fontOfSize: 18. menu add: styleName target: self selector: #font: argument: ttfont. menu lastItem font: ttfont; setBalloonText: styleName ]]. menu popUpInWorld: self currentWorld! ! !NCGlyphEditor methodsFor: 'button actions' stamp: 'KR 5/1/2008 08:54'! install | name sample | sample _ self sampleGlyph. sample ifNil: [ ^self ]. name _ FillInTheBlankMorph request: 'Install with what name?' translated. name isEmpty ifTrue: [ ^self ]. sample defaultScale: self arrowScale. NCAAConnectorMorph arrowDictionary at: name put: sample; changed: #arrowsChanged. ! ! !NCGlyphEditor methodsFor: 'initialization' stamp: 'KR 5/1/2008 08:52'! initialize | buttonBar | super initialize. rotation _ 0. arrowScale _ 2.0@2.0. showDots _ false. self layoutPolicy: ProportionalLayout new; extent: 710@610; color: Color white. buttonBar _ AlignmentMorph newRow color: (Color blue muchLighter paler); layoutInset: 5; listCentering: #centered; cellInset: 10. #(('Choose font' chooseFont) ('Rotate' rotateGlyph) ('Toggle dots' toggleDots) ('Make morph' createCurveMorph) ('Install' install) ('Write code' writeConstructor) ('Clear clicks' clearClicks) ('Arrow scales' adjustArrowScales) ('Sample' sample)) translatedNoop withIndexDo: [ :arr :i | buttonBar addMorphBack: ((SimpleButtonMorph newWithLabel: arr first translated) cornerStyle: #square; layoutInset: 4@4; color: (Color blue muchLighter); borderStyle: ((BorderStyle complexFramed) width: 3); target: self; actionSelector: arr second) ]. buttonBar addMorphBack: (UpdatingStringMorph on: self selector: #arrowScale). buttonBar layoutChanged; fullBounds. self addMorph: buttonBar fullFrame: (LayoutFrame fractions: (0@0 corner: 1@0.05)). ! ! !NCLineMorph methodsFor: 'arrows' stamp: 'KR 5/1/2008 08:56'! changeArrowScaleInteractively: evt | handle origin aHand oldScales scaleDelta newScales | aHand _ evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin _ aHand position. oldScales _ self arrowScales. handle _ HandleMorph new forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). scaleDelta _ ((newPoint - origin) / 100.0). newScales _ oldScales + scaleDelta. self arrowScales: newScales. ] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNilDo: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: 'arrow scale change'; undoTarget: self selector: #arrowScales: argument: oldScales; redoTarget: self selector: #arrowScales: argument: newScales)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor farther from this point to increase the size of the arrows. Click when done.' translated hand: evt hand. handle startStepping! ! !PluggableTextMorph methodsFor: 'menu commands' stamp: 'KR 5/1/2008 08:56'! toggleAnnotationPaneSize | handle origin aHand siblings newHeight lf prevBottom m ht | self flag: #bob. "CRUDE HACK to enable changing the size of the annotations pane" owner ifNil: [^self]. siblings _ owner submorphs. siblings size > 3 ifTrue: [^self]. siblings size < 2 ifTrue: [^self]. aHand _ self primaryHand. origin _ aHand position. handle _ HandleMorph new forEachPointDo: [:newPoint | handle removeAllMorphs. newHeight _ (newPoint - origin) y asInteger min: owner height - 50 max: 16. lf _ siblings last layoutFrame. lf bottomOffset: newHeight. prevBottom _ newHeight. siblings size - 1 to: 1 by: -1 do: [ :index | m _ siblings at: index. lf _ m layoutFrame. ht _ lf bottomOffset - lf topOffset. lf topOffset: prevBottom. lf bottomOffset = 0 ifFalse: [ lf bottomOffset: (prevBottom + ht). ]. prevBottom _ prevBottom + ht. ]. owner layoutChanged. ] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNilDo: [:halo | halo addHandles]. ]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor farther from this point to increase pane. Click when done.' translated hand: aHand. handle startStepping ! ! !PolygonMorph methodsFor: 'menu' stamp: 'KR 5/1/2008 08:57'! customizeArrows: evt | handle origin aHand | aHand _ evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin _ aHand position. handle _ HandleMorph new forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). self arrowSpec: (newPoint - origin) / 5.0] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNilDo: [:halo | halo addHandles].]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor left and right to change arrow length and style. Move it up and down to change width. Click when done.' translated hand: evt hand. handle startStepping! ! !SimpleButtonMorph methodsFor: 'menu' stamp: 'KR 5/1/2008 09:45'! setActWhen | selections | #('buttonDown' 'buttonUp' 'whilePressed' 'startDrag') translatedNoop. selections _ #(buttonDown buttonUp whilePressed startDrag). actWhen := (SelectionMenu labels: (selections collect: [:t | t translated]) selections: selections) startUpWithCaption: 'Choose one of the following conditions' translated! ! !StringButtonMorph methodsFor: 'menu' stamp: 'KR 5/1/2008 09:46'! setActWhen | selections | #('buttonDown' 'buttonUp' 'whilePressed') translatedNoop. selections _ #(buttonDown buttonUp whilePressed). actWhen _ (SelectionMenu labelList: (selections collect: [:t | t translated]) selections: selections) startUpWithCaption: 'Choose one of the following conditions' translated. ! ! !TextMorph methodsFor: 'menu' stamp: 'KR 5/1/2008 08:57'! changeMargins: evt | handle origin aHand oldMargin newMargin | aHand _ evt ifNil: [self primaryHand] ifNotNil: [evt hand]. origin _ aHand position. oldMargin _ margins. handle _ HandleMorph new forEachPointDo: [:newPoint | handle removeAllMorphs. handle addMorph: (LineMorph from: origin to: newPoint color: Color black width: 1). newMargin _ (newPoint - origin max: 0@0) // 5. self margins: newMargin] lastPointDo: [:newPoint | handle deleteBalloon. self halo ifNotNilDo: [:halo | halo addHandles]. self rememberCommand: (Command new cmdWording: ('margin change for ' translated,self nameForUndoWording); undoTarget: self selector: #margins: argument: oldMargin; redoTarget: self selector: #margins: argument: newMargin; yourself)]. aHand attachMorph: handle. handle setProperty: #helpAtCenter toValue: true. handle showBalloon: 'Move cursor down and to the right to increase margin inset. Click when done.' translated hand: evt hand. handle startStepping! ! !NCDisplayTextMorph methodsFor: 'accessing' stamp: 'KR 5/1/2008 08:58'! promptForFont self editor selection isEmptyOrNil ifTrue: [ self editor selectAll ]. TextStyle promptForFont: 'Choose font:' translated andSendTo: self withSelector: #beAllFont:! ! !TextStyle class methodsFor: 'user interface' stamp: 'KR 5/1/2008 09:01'! promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: currentFont "Morphic Only!! prompt for a font and if one is provided, send it to aTarget using a message with selector aSelector." "TextStyle promptForFont: 'Choose system font:' translated andSendTo: Preferences withSelector: #setSystemFontTo: " "Derived from a method written by Robin Gibson" | menu subMenu currentTextStyle | currentTextStyle := currentFont ifNotNil: [currentFont textStyleName]. menu := MenuMorph entitled: aPrompt. self actualTextStyles keysSortedSafely do: [:styleName | subMenu := self fontMenuForStyle: styleName target: aTarget selector: aSelector highlight: currentFont. menu add: styleName subMenu: subMenu. menu lastItem font: ((self named: styleName) fontOfSize: 18). styleName = currentTextStyle ifTrue: [menu lastItem color: Color blue darker]]. menu popUpInWorld: self currentWorld! !