'From Squeak3.1alpha of 5 February 2001 [latest update: #3840] on 15 March 2001 at 9:41:09 am'! "Change Set: buttonProps3 Date: 14 March 2001 Author: Bob Arning - make it easier to style button text while in properties panel - allow different costumes for mouse enter/down"! Object subclass: #ButtonProperties instanceVariableNames: 'target actionSelector arguments actWhen wantsRolloverIndicator mouseDownTime nextTimeToFire visibleMorph delayBetweenFirings mouseOverHaloWidth mouseOverHaloColor mouseDownHaloWidth mouseDownHaloColor stateCostumes currentLook ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Buttons'! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/15/2001 09:35'! addTextToButton: aStringOrText | tm existing | existing _ self currentTextMorphsInButton. existing do: [ :x | x delete]. aStringOrText ifNil: [^self]. tm _ TextMorph new contents: aStringOrText. tm fullBounds; lock; align: tm center with: visibleMorph center; setProperty: #textAddedByButtonProperties toValue: true; setToAdhereToEdge: #center. "maybe the user would like personal control here" "visibleMorph extent: (tm extent * 1.5) rounded." visibleMorph addMorphFront: tm. ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/15/2001 09:18'! currentLook ^currentLook ifNil: [currentLook _ #normal]! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/14/2001 18:18'! currentTextInButton | existing | existing _ self currentTextMorphsInButton. existing isEmpty ifTrue: [^nil]. ^existing first ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/14/2001 18:17'! currentTextMorphsInButton ^visibleMorph submorphsSatisfying: [ :x | x hasProperty: #textAddedByButtonProperties ] ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/14/2001 19:01'! figureOutScriptSelector self halt! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/14/2001 18:19'! lockAnyText self currentTextMorphsInButton do: [ :x | x lock: true].! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/14/2001 18:43'! mouseDownLook: aFormOrMorph self setLook: #mouseDown to: aFormOrMorph ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/14/2001 18:43'! mouseEnterLook: aFormOrMorph self setLook: #mouseEnter to: aFormOrMorph ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/15/2001 09:13'! privateSetLook: aSymbol to: aFormOrMorph | f | f _ (aFormOrMorph isKindOf: Form) ifTrue: [ aFormOrMorph ] ifFalse: [ aFormOrMorph imageForm ]. self stateCostumes at: aSymbol put: f! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/15/2001 09:14'! setLook: aSymbol to: aFormOrMorph (self stateCostumes includesKey: #normal) ifFalse: [ self privateSetLook: #normal to: visibleMorph. ]. self privateSetLook: aSymbol to: aFormOrMorph. ! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/14/2001 18:30'! stateCostumes ^stateCostumes ifNil: [stateCostumes _ Dictionary new]! ! !ButtonProperties methodsFor: 'accessing' stamp: 'RAA 3/14/2001 18:19'! unlockAnyText self currentTextMorphsInButton do: [ :x | x lock: false].! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/15/2001 09:21'! displayCostume: aSymbol self currentLook == aSymbol ifTrue: [^true]. self stateCostumes at: aSymbol ifPresent: [ :aForm | currentLook _ aSymbol. visibleMorph wearCostume: aForm. ^true ]. ^false ! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/14/2001 19:01'! editButtonsScript: evt "The user has touched my Scriptor halo-handle. Bring up a Scriptor on the script of the button." | cardsPasteUp cardsPlayer anEditor scriptSelector | cardsPasteUp _ self pasteUpMorph. (cardsPlayer _ cardsPasteUp assuredPlayer) assureUniClass. scriptSelector _ self figureOutScriptSelector. scriptSelector ifNil: [ scriptSelector _ cardsPasteUp scriptSelectorToTriggerFor: self. anEditor _ cardsPlayer newTextualScriptorFor: scriptSelector. evt hand attachMorph: anEditor. ^self ]. (cardsPlayer class selectors includes: scriptSelector) ifTrue: [ anEditor _ cardsPlayer scriptEditorFor: scriptSelector. evt hand attachMorph: anEditor. ^self ]. "Method somehow got removed; I guess we start aftresh" scriptSelector _ nil. ^ self editButtonsScript! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/14/2001 18:40'! mouseDown: evt self displayCostume: #mouseDown. mouseDownTime _ Time millisecondClockValue. nextTimeToFire _ nil. delayBetweenFirings ifNotNil: [ nextTimeToFire _ mouseDownTime + delayBetweenFirings. ]. self wantsRolloverIndicator ifTrue: [ visibleMorph addMouseActionIndicatorsWidth: mouseDownHaloWidth color: mouseDownHaloColor. ]. actWhen == #mouseDown ifFalse: [^self]. (visibleMorph containsPoint: evt cursorPoint) ifFalse: [^self]. self doButtonAction: evt. "===== aMorph . now _ Time millisecondClockValue. oldColor _ color. actWhen == #buttonDown ifTrue: [self doButtonAction] ifFalse: [ self updateVisualState: evt; refreshWorld]. dt _ Time millisecondClockValue - now max: 0. dt < 200 ifTrue: [(Delay forMilliseconds: 200-dt) wait]. self mouseStillDown: evt. ====="! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/14/2001 18:39'! mouseEnter: evt self displayCostume: #mouseEnter. self wantsRolloverIndicator ifTrue: [ visibleMorph addMouseActionIndicatorsWidth: mouseOverHaloWidth color: mouseOverHaloColor. ]. ! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/14/2001 18:39'! mouseLeave: evt self displayCostume: #normal. visibleMorph deleteAnyMouseActionIndicators. ! ! !ButtonProperties methodsFor: 'events' stamp: 'RAA 3/15/2001 09:21'! mouseUp: evt (self displayCostume: #mouseEnter) ifFalse: [self displayCostume: #normal]. ! ! !ButtonProperties methodsFor: 'copying' stamp: 'RAA 3/15/2001 09:15'! veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. "target _ target. Weakly copied" "actionSelector _ actionSelector. a Symbol" "arguments _ arguments. All weakly copied" actWhen _ actWhen veryDeepCopyWith: deepCopier. "oldColor _ oldColor veryDeepCopyWith: deepCopier." visibleMorph _ visibleMorph veryDeepCopyWith: deepCopier. delayBetweenFirings _ delayBetweenFirings. mouseDownHaloColor _ mouseDownHaloColor. stateCostumes _ stateCostumes veryDeepCopyWith: deepCopier. currentLook _ currentLook.! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/15/2001 09:25'! acceptDroppingMorph: aMorph event: evt in: aSubmorph | why | aSubmorph color: Color transparent. why _ aSubmorph valueOfProperty: #intentOfDroppedMorphs. why == #changeTargetMorph ifTrue: [ self targetProperties replaceVisibleMorph: aMorph. myTarget _ aMorph. self rebuild. ^true ]. why == #changeTargetTarget ifTrue: [ (aMorph setAsActionInButtonProperties: self targetProperties) ifFalse: [ ^false ]. ^true ]. why == #changeTargetMouseDownLook ifTrue: [ self targetProperties mouseDownLook: aMorph. ^false ]. why == #changeTargetMouseEnterLook ifTrue: [ self targetProperties mouseEnterLook: aMorph. ^false ]. ^false ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/14/2001 18:20'! addTextToTarget | newText initial curr | initial _ '???'. (curr _ self targetProperties currentTextInButton) ifNotNil: [ initial _ curr contents ]. newText _ FillInTheBlank request: 'Text for this button' initialAnswer: initial. newText isEmptyOrNil ifTrue: [^self]. self targetProperties addTextToButton: newText; unlockAnyText. ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/15/2001 09:23'! allowDropsInto: aMorph withIntent: aSymbol aMorph on: #mouseEnterDragging send: #mouseEnterDraggingEvt:morph: to: self; on: #mouseLeaveDragging send: #mouseLeaveDraggingEvt:morph: to: self; setProperty: #handlerForDrops toValue: self; setProperty: #intentOfDroppedMorphs toValue: aSymbol; borderWidth: 1; borderColor: Color gray ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/14/2001 18:22'! doAccept self targetProperties lockAnyText. super doAccept.! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/15/2001 08:57'! doMainProperties self targetProperties lockAnyText. super doMainProperties.! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/15/2001 09:01'! paneForButtonTargetReport | r | r _ self inARow: { self lockedString: 'Target: '. UpdatingStringMorph new useStringFormat; getSelector: #target; target: self targetProperties; growable: true; minimumWidth: 24; lock. }. r hResizing: #shrinkWrap. self allowDropsInto: r withIntent: #changeTargetTarget. r setBalloonText: 'Drop another morph here to change the target and action of this button. (Only some morphs will work)'. ^self inARow: {r} ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/15/2001 09:22'! paneForChangeMouseDownLook | r | r _ self inARow: { self lockedString: ' Mouse-down look '. }. self allowDropsInto: r withIntent: #changeTargetMouseDownLook. r setBalloonText: 'Drop another morph here to change the visual appearance of this button when the mouse is clicked in it.'. ^r ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/15/2001 09:03'! paneForChangeMouseEnterLook | r | r _ self inARow: { self lockedString: ' Mouse-enter look '. }. self allowDropsInto: r withIntent: #changeTargetMouseEnterLook. r setBalloonText: 'Drop another morph here to change the visual appearance of this button when the mouse enters it.'. ^r ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/15/2001 09:00'! paneForChangeVisibleMorph | r | r _ self inARow: { self lockedString: ' Change morph '. }. r on: #mouseDown send: #mouseDownEvent:for: to: self. self allowDropsInto: r withIntent: #changeTargetMorph. r setBalloonText: 'Drop another morph here to change the visual appearance of this button. Or click here to get a menu of possible replacement morphs.'. ^r ! ! !ButtonPropertiesMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/15/2001 09:04'! rebuild | buttonColor | myTarget ensuredButtonProperties. self targetProperties unlockAnyText. "makes styling the text easier" self removeAllMorphs. self addAColumn: { self lockedString: 'Button Properties for ',myTarget name. }. self addAColumn: { self paneForButtonTargetReport. }. self addAColumn: { self paneForButtonSelectorReport. }. self addAColumn: { (self inARow: { self paneForActsOnMouseDownToggle. self paneForActsOnMouseUpToggle. }) hResizing: #shrinkWrap. }. self addAColumn: { self inARow: { (self paneForWantsFiringWhileDownToggle) hResizing: #shrinkWrap. self paneForRepeatingInterval. }. }. self addAColumn: { (self inAColumn: { self paneForWantsRolloverToggle. }) hResizing: #shrinkWrap. }. self addARow: { self paneForMouseOverColorPicker. self paneForMouseDownColorPicker. }. self addARow: { self paneForChangeMouseEnterLook. self paneForChangeMouseDownLook. }. buttonColor _ color lighter. self addARow: { self inAColumn: { self addARow: { self buttonNamed: 'Add label' action: #addTextToTarget color: buttonColor help: 'add some text to the button'. self buttonNamed: 'Remove label' action: #removeTextFromTarget color: buttonColor help: 'remove text from the button'. }. self addARow: { self buttonNamed: 'Accept' action: #doAccept color: buttonColor help: 'keep changes made and close panel'. self buttonNamed: 'Cancel' action: #doCancel color: buttonColor help: 'cancel changes made and close panel'. self transparentSpacerOfSize: 10@3. self buttonNamed: 'Main' action: #doMainProperties color: color lighter help: 'open a main properties panel for the morph'. self buttonNamed: 'Remove' action: #doRemoveProperties color: color lighter help: 'remove the button properties of this morph'. }. }. self inAColumn: { self paneForChangeVisibleMorph }. }. ! ! !SketchMorph methodsFor: 'accessing' stamp: 'RAA 3/15/2001 09:11'! wearCostume: anotherMorph self form: anotherMorph form. ! !