'From etoys2.2 of 24 September 2007 [latest update: #1760] on 6 November 2007 at 8:55:44 pm'! "Change Set: userTextObject-sw Date: 7 November 2007 Author: Scott Wallace Provide, in the Supplies flap and the Objects tool, and as the base class for pasted text, a default text object that: - grows/shrinks horizontally as the user types/erases. - switches to 'wrap' mode if the user manually resizes. - switches to 'wrap' mode if the edge of the container is reached. Add the notion of a #translatable property for TextMorphs; User-Text objects obtained from Supplies, etc., have it. When any TextMorph has such a property, then when locale changes it gets its localeChanged method triggered. The property can be set interactively from a new checkbox in the text-morphs halo menu. Also extends the be-all-font menu item from Connectors to generic TextMorph."! TextMorph subclass: #UserText instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Basic'! !UserText commentStamp: 'sw 11/6/2007 20:16' prior: 0! A text object intended to carry user-created textual content. The default mode is to be non-wrapping, so that the only wrapping that takes place will be that imposed by explicit carriage-returns in the text. The user can manually (from menu) change the wrap setting, and it is also automatically switched to wrap-mode if the user manually resizes the text-object (with the halo) and also if the user, by typing, makes the text object extend off the right edge of the screen.! !EventRecordingSpace methodsFor: 'sugar flaps' stamp: 'sw 10/30/2007 21:46'! sugarPartsBinQuads "Answer definitions for the contents of the supplies bin within the sugar-nav-bar of the event theatre." ^ #( (ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of available objects') (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'Stop, Step, and Go buttons for controlling all your scripts at once. The tool can also be "opened up" to control each script in your project individually.') (AllPlayersTool allPlayersToolForActiveWorld 'Players' 'A tool listing all the scripted objects in the project.') (TrashCanMorph new 'Trash' 'A tool for discarding objects') (TextMorph nonwrappingPrototype 'Text' 'Text that you can edit into anything you desire.') (RecordingControls authoringPrototype 'Sound Recorder' 'A device for making sound recordings.') (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle') (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle') (PolygonMorph authoringPrototype 'Triangle' 'A three-sided polygon') (StarMorph authoringPrototype 'Star' 'A star') (BookMorph authoringPrototype 'Book' 'A multi-paged structure') (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.') (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control') (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')) asOrderedCollection! ! !Flaps class methodsFor: 'flaps registry' stamp: 'sw 10/30/2007 21:46'! defaultsQuadsDefiningSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap. previously in quadsDefiningSuppliesFlap" ^ { {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. {#TextMorph . #nonwrappingPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}. {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}. {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}. {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop} } asOrderedCollection! ! !Flaps class methodsFor: 'predefined flaps' stamp: 'sw 10/30/2007 21:36'! defaultsQuadsDefiningPlugInSuppliesFlap "Answer a list of quads which define the objects to appear in the default Supplies flap used in the Plug-in image" ^ { {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of available objects' translatedNoop}. {#AllScriptsTool. #AllScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'Stop, Step, and Go buttons for controlling all your scripts at once. The tool can also be "opened up" to control each script in your project individually.' translatedNoop}. {#AllPlayersTool. #allPlayersToolForActiveWorld. 'Players' translatedNoop. 'A tool listing all the scripted objects in the project.' translatedNoop}. {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}. {#TextMorph . #nonwrappingPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}. {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. {#PolygonMorph. #trianglePrototype. 'Triangle' translatedNoop. 'A three-sided polygon. Shift-click to get handles to allow you to reshape the triangle.' translatedNoop}. {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop} } asOrderedCollection! ! !HandMorph methodsFor: 'paste buffer' stamp: 'sw 11/6/2007 20:11'! pasteMorph "The user requested 'paste'; depending on the type of data on the clipboard, launch an appropropriate morph that embodies the clipboard content, and open it on the screen." | aPastee form text | aPastee := nil. form := ExtendedClipboardInterface current readFormClipboardData. form ifNotNil: [aPastee := SketchMorph withForm: form]. aPastee ifNil: [text := ExtendedClipboardInterface current readTextClipboardData ifNil: [Clipboard clipboardText]. text isEmpty ifFalse: [aPastee := TextMorph nonwrappingPrototype. aPastee contents: text. text embeddedMorphs ifNotNilDo: [:morphs | morphs do: [:m | m forkDownloadWhenFinished: [aPastee composeToBounds]]. aPastee composeToBounds]. aPastee width > ActiveWorld width ifTrue: [aPastee wrapFlag: true. aPastee width: ((2 * ActiveWorld width) // 3). aPastee refreshParagraph]]]. aPastee ifNil: [aPastee := self objectToPaste]. aPastee ifNil: [^ self]. self attachMorph: aPastee. aPastee align: aPastee center with: self position. aPastee player ifNotNil: [aPastee player startRunning]! ! !Project methodsFor: 'language' stamp: 'sw 11/6/2007 18:48'! updateLocaleDependentsWithPreviousSupplies: aCollection gently: gentlyFlag "Set the project's natural language as indicated" | morphs | morphs := IdentitySet new: 400. ActiveWorld allMorphsAndBookPagesInto: morphs. morphs do: [:morph | morph isTileScriptingElement ifTrue: [morph localeChanged]. (morph isKindOf: TextMorph) ifTrue: [morph localeChanged]. "NB: only those marked as translatable will be translated..." morph class == ObjectsTool ifTrue: [morph localeChanged]]. Flaps disableGlobalFlaps: false. Preferences sugarNavigator ifTrue: [Flaps addAndEnableEToyFlapsWithPreviousEntries: aCollection. ActiveWorld addGlobalFlaps] ifFalse: [Preferences eToyFriendly ifTrue: [Flaps addAndEnableEToyFlaps. ActiveWorld addGlobalFlaps] ifFalse: [Flaps enableGlobalFlaps]]. (Project current isFlapIDEnabled: 'Navigator' translated) ifFalse: [Flaps enableDisableGlobalFlapWithID: 'Navigator' translated]. ParagraphEditor initializeTextEditorMenus. MenuIcons initializeTranslations. gentlyFlag ifTrue: [ LanguageEnvironment localeChangedGently. ] ifFalse: [ LanguageEnvironment localeChanged. ]. #(PartsBin ParagraphEditor BitEditor FormEditor StandardSystemController) do: [ :key | Smalltalk at: key ifPresent: [ :class | class initialize ]]. ActiveWorld reformulateUpdatingMenus. "self setFlaps. self setPaletteFor: aLanguageSymbol." ! ! !TextMorph methodsFor: 'menu' stamp: 'sw 11/6/2007 20:22'! promptForFont "Allow the user to choose a single font for the entire text." self editor selection isEmptyOrNil ifTrue: [ self editor selectAll ]. TextStyle promptForFont: 'Choose font:' translated andSendTo: self withSelector: #beAllFont:! ! !TextMorph methodsFor: '*connectorsshapes-menu' stamp: 'sw 11/6/2007 20:20'! addCustomMenuItems: aCustomMenu hand: aHandMorph "Add object-specific menu items to a menu." | outer | super addCustomMenuItems: aCustomMenu hand: aHandMorph. self addFitAndWrapItemsTo: aCustomMenu. self addTextMenuItemsTo: aCustomMenu event: ActiveEvent. aCustomMenu add: 'text properties...' translated action: #changeTextColor. aCustomMenu add: 'text margins...' translated action: #changeMargins:. aCustomMenu add: 'add predecessor' translated action: #addPredecessor:. aCustomMenu add: 'add successor' translated action: #addSuccessor:. self addTranslationItemsTo: aCustomMenu. (Preferences noviceMode or: [Preferences simpleMenus]) ifFalse: [aCustomMenu add: 'code pane menu...' translated action: #yellowButtonActivity. aCustomMenu add: 'code pane shift menu...' translated action: #shiftedYellowButtonActivity]. outer _ self owner. outer ifNotNil: [ outer isLineMorph ifTrue: [container isNil ifTrue: [aCustomMenu add: 'follow owner''s curve' translated action: #followCurve] ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection. aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]] ifFalse: [self fillsOwner ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff] ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff]. self avoidsOcclusions ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff] ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]]. aCustomMenu addLine. aCustomMenu add: 'holder for characters' translated action: #holderForCharacters ! ! !TextMorph methodsFor: 'localization' stamp: 'sw 11/6/2007 18:45'! localeChanged "Remember contents for previous locale and change contents to new locale if existing. Sent from Project>>updateLocaleDependents" | locale oldContents | self translatable ifFalse: [^ self]. locale := self valueOfProperty: #locale ifAbsent: [#none]. oldContents := self translations at: locale ifAbsent: [nil]. oldContents = self contents ifFalse: [ self translations at: LocaleID previous put: self contents copy. self setProperty: #locale toValue: LocaleID previous]. self setLocale: LocaleID current! ! !TextMorph methodsFor: 'localization' stamp: 'sw 11/6/2007 18:16'! toggleTranslatable "Toggle whether the receiver's contents should be translated automatically upon a locale change." self translatable: self translatable not! ! !TextMorph methodsFor: 'localization' stamp: 'sw 11/6/2007 18:09'! translatable "Answer whether the contents of the receiver should automaticaly be translated upon language switch." ^ self hasProperty: #translatable! ! !TextMorph methodsFor: 'localization' stamp: 'sw 11/6/2007 18:10'! translatableString "Answer a string characterizing whether or not I am translatable" ^ (self translatable ifTrue: [''] ifFalse: ['']), 'translatable' translated! ! !TextMorph methodsFor: 'localization' stamp: 'sw 11/6/2007 18:16'! translatable: aBoolean "Set the receiver's translatable property as indicated" self translatable ifTrue: [self removeProperty: #translatable] ifFalse: [self setProperty: #translatable toValue: true]! ! !TextMorph methodsFor: 'menus' stamp: 'sw 11/6/2007 18:22'! addFitAndWrapItemsTo: aMenu "Add items relating to fitting and wrapping to the menu provided, providing menu-lines before and after the group added." aMenu addLine. aMenu addUpdating: #autoFitString target: self action: #autoFitOnOff. aMenu balloonTextForLastItem: 'When checked, bounds are automatically adjusted to fit the contents.' translated. aMenu addUpdating: #wrapString target: self action: #wrapOnOff. aMenu balloonTextForLastItem: 'When checked, text is automatically wrapped to fit horizontally within the boundaries specifed.' translated. aMenu addUpdating: #translatableString target: self action: #toggleTranslatable. aMenu balloonTextForLastItem: 'When checked, contents will automatically be translated upon a locale change' translated. aMenu addLine.! ! !TextMorph methodsFor: 'menus' stamp: 'sw 11/6/2007 20:26'! addTextMenuItemsTo: aCustomMenu event: evt "Add text-related items to a menu." aCustomMenu addLine. aCustomMenu add: 'font for entire text...' translated action: #promptForFont. ^ aCustomMenu! ! !TextMorph class methodsFor: 'parts bin' stamp: 'sw 10/30/2007 22:16'! supplementaryPartsDescriptions "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol" ^ { DescriptionForPartsBin formalName: 'Text (border)' translatedNoop categoryList: #() documentation: 'A text field with border' translatedNoop globalReceiverSymbol: #TextMorph nativitySelector: #borderedPrototype. " DescriptionForPartsBin formalName: 'Text (fancy)' translatedNoop categoryList: {'Text' translatedNoop} documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop globalReceiverSymbol: #TextMorph nativitySelector: #fancyPrototype." DescriptionForPartsBin formalName: 'Text' translatedNoop categoryList: {'Basic' translatedNoop} documentation: 'A raw piece of text which you can edit into anything you want' translatedNoop globalReceiverSymbol: #TextMorph nativitySelector: #nonwrappingPrototype. } ! ! !TextMorph class methodsFor: '*connectorstext-parts bin' stamp: 'sw 11/2/2007 02:01'! nonwrappingPrototype "Answer the default-text-object de jour; at this time, it's actually an instance of the NCDisplayTextMorph, from the Connectors package." | text style index baseFont textMorph | text := Text fromString: 'Text' translated. baseFont _ Preferences standardEToysFont. style _ baseFont textStyle. index _ style fontIndexOfPointSize: 24. text addAttribute: (TextFontChange fontNumber: index). textMorph := UserText new. textMorph contentsWrapped: text; setTextStyle: style; margins: 0@0; wrapFlag: false; fit; refreshParagraph. ^ textMorph " TextMorph nonwrappingPrototype openInHand " ! ! !UserText methodsFor: 'menus' stamp: 'sw 11/4/2007 01:35'! addYellowButtonMenuItemsTo: aCustomMenu event: evt "Add menu items to a yellow-button menu abuiliding." super addYellowButtonMenuItemsTo: aCustomMenu event: evt. self addBasicMenuItemsTo: aCustomMenu event: evt. self addCustomMenuItems: aCustomMenu hand: evt hand. self addTextMenuItemsTo: aCustomMenu event: evt! ! !UserText methodsFor: 'initialization' stamp: 'sw 11/6/2007 19:52'! beAllFont: aFont "Set the receiver such that the given font is installed throughout." self editor selection isEmptyOrNil ifTrue: [ self editor selectAll ]. textStyle _ TextStyle fontArray: (Array with: aFont). self releaseCachedState; changed! ! !UserText methodsFor: 'initialization' stamp: 'sw 11/6/2007 18:45'! initialize "Initialize the receiver." super initialize. wrapFlag _ false. self margins: 6@0. self autoFit: true. self translatable: true! ! !UserText methodsFor: 'drawing' stamp: 'sw 11/6/2007 19:50'! drawOn: aCanvas "Render the receiver on the given canvas." super drawOn: aCanvas. aCanvas isShadowDrawing ifTrue: [^ self]. self hasFocus ifTrue: [aCanvas frameRectangle: (self fullBounds insetBy: 0) color: Preferences keyboardFocusColor]! ! !UserText methodsFor: 'font' stamp: 'sw 11/6/2007 19:51'! fontName: fontname pointSize: size "Set receiver to accommodate the given font name and size." super fontName: fontname pointSize: size. self updateFromParagraph! ! !UserText methodsFor: 'font' stamp: 'sw 11/6/2007 19:52'! fontName: fontname size: size "Set the given font-name and size to be used in the receiver's text." super fontName: fontname size: size. self updateFromParagraph.! ! !UserText methodsFor: 'editing' stamp: 'sw 11/6/2007 19:50'! highlightRectChanged "The highlight rectangle changed... react." (self outerBounds areasOutside: (self innerBounds insetBy: 3)) do: [ :rect | self invalidRect: rect ]! ! !UserText methodsFor: 'private' stamp: 'sw 11/2/2007 23:18'! installEditorToReplace: priorEditor "Install an editor for my paragraph. This constitutes 'hasFocus'. If priorEditor is not nil, then initialize the new editor from its state. We may want to rework this so it actually uses the prior editor." | stateArray | priorEditor ifNotNil: [stateArray _ priorEditor stateArray]. editor _ self editorClass new morph: self. editor changeParagraph: self paragraph. priorEditor ifNotNil: [editor stateArrayPut: stateArray]. self highlightRectChanged. self selectionChanged. ^ editor! ! !UserText methodsFor: 'private' stamp: 'sw 11/6/2007 19:52'! releaseEditor "Release the text editor, and signal that the highlight rectangle needs to be updated." super releaseEditor. self highlightRectChanged ! ! !UserText methodsFor: 'private' stamp: 'sw 11/6/2007 19:54'! updateFromParagraph "Update the receiver's contents from its paragraph" super updateFromParagraph. self hasFocus ifFalse: [^ self]. (self isAutoFit and: [ wrapFlag not]) ifTrue: [ self refreshParagraph]. self editor ! ! !UserText methodsFor: 'event handling' stamp: 'sw 11/3/2007 23:29'! keyStroke: evt "Handle a keystroke event." | newSel | super keyStroke: evt. ActiveHand keyboardFocus == self ifFalse: [self releaseEditor. ^ self]. newSel := self editor selectionInterval. "restore editor state" self refreshParagraph. self editor selectFrom: newSel first to: newSel last. wrapFlag ifFalse: [self fullBounds right > owner right ifTrue: [self wrapFlag: true. self right: owner right. self refreshParagraph. self editor selectFrom: text string size + 1 to: text string size]] ! ! !UserText methodsFor: 'event handling' stamp: 'sw 11/4/2007 01:37'! refreshParagraph "Release any existing editor, then release the paragraph and reinistantiate it so that it will grow with its selection; if under edit, restore the editing state." | priorEditor | priorEditor := editor. "Save editor state" self releaseParagraph. "Release paragraph so it will grow with selection." self paragraph. "Re-instantiate to set new bounds" priorEditor ifNotNil: [ self installEditorToReplace: priorEditor]. "restore editor state" ! ! !UserText methodsFor: 'event handling' stamp: 'sw 11/6/2007 19:54'! trackFocusFromEvent: evt "Track focus." evt hand keyboardFocus == self ifFalse: [self hasFocus ifTrue: [ self highlightRectChanged. self releaseEditor]]! ! !UserText methodsFor: 'events-processing' stamp: 'sw 11/6/2007 19:53'! rejectsEvent: anEvent "Answer whether the receiver rejects a given event." self trackFocusFromEvent: anEvent. ^ (super rejectsEvent: anEvent) or: [ anEvent isKeyboard and: [ (self handlesKeyboard: anEvent) not ] ]! ! !UserText methodsFor: 'resizing' stamp: 'sw 11/3/2007 21:48'! setExtentFromHalo: anExtent "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed." self wrapFlag: true. ^ super setExtentFromHalo: anExtent! ! "Postscript:" | wasEnabled | wasEnabled := Preferences eToyFriendly. Preferences enable: #eToyFriendly. Flaps registeredFlapsQuads at: 'PlugIn Supplies' put: Flaps defaultsQuadsDefiningPlugInSuppliesFlap. Flaps replaceGlobalFlapwithID: 'Supplies'. wasEnabled ifFalse: [Preferences disable: #eToyFriendly]. SugarLibrary clearDefault. SugarNavigatorBar refreshButRetainOldContents.!