'From Squeak3.10beta of 22 July 2007 [latest update: #7159] on 29 June 2018 at 11:53:44 am'!
UpdatingSimpleButtonMorph subclass: #ScriptableButton
	instanceVariableNames: 'scriptSelector'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'EToys-Scripting'!
!ScriptableButton commentStamp: '<historical>' prior: 0!
A button intended for use with the card architecture and the user-scripting system.!


!ScriptableButton methodsFor: 'accessing' stamp: 'sw 10/30/2000 11:02'!
label
	"Answer a string representing the label of the receiver, returning an empty string if necessary"

	| aStringMorph |
	^ (aStringMorph := self findA: StringMorph)
		ifNil:		['']
		ifNotNil:	[aStringMorph contents]! !

!ScriptableButton methodsFor: 'accessing' stamp: 'sw 10/30/2000 10:59'!
label: aString
	"Set the receiver's label as indicated"

	| aLabel |
	(aLabel := self findA: StringMorph)
		ifNotNil:
			[aLabel contents: aString]
		ifNil:
			[aLabel := StringMorph contents: aString font: TextStyle defaultFont.
			self addMorph: aLabel].

	self extent: aLabel extent + (borderWidth + 6).
	aLabel position: self center - (aLabel extent // 2).

	aLabel lock! !

!ScriptableButton methodsFor: 'accessing' stamp: 'tk 9/28/2001 21:09'!
scriptSelector
	^ scriptSelector! !

!ScriptableButton methodsFor: 'accessing' stamp: 'tk 9/28/2001 21:09'!
scriptSelector: aSymbol
	scriptSelector := aSymbol! !


!ScriptableButton methodsFor: 'button' stamp: 'bf 9/20/2004 11:10'!
doButtonAction
	"The user has pressed the button.  Dispatch to the actual user script, if any."

	scriptSelector ifNil: [^ super doButtonAction].
	self pasteUpMorph player performScriptIfCan: scriptSelector! !


!ScriptableButton methodsFor: 'halos and balloon help' stamp: 'sw 10/10/2000 08:09'!
wantsScriptorHaloHandle
	"Answer whether the receiver would like to have a Scriptor halo handle put up on its behalf.  Initially, only the ScriptableButton says yes"

	^ true! !


!ScriptableButton methodsFor: 'label' stamp: 'yo 11/4/2002 22:13'!
label: aString font: aFontOrNil
	"Set the receiver's label and font as indicated"

	| oldLabel m aFont |
	(oldLabel := self findA: StringMorph)
		ifNotNil: [oldLabel delete].
	aFont := aFontOrNil ifNil: [TextStyle defaultFont].
	m := StringMorph contents: aString font: aFont.
	self extent: (m width + 6) @ (m height + 6).
	m position: self center - (m extent // 2).
	self addMorph: m.
	m lock
! !


!ScriptableButton methodsFor: 'menu' stamp: 'sw 10/30/2000 11:02'!
setLabel
	"Invoked from a menu, let the user change the label of the button"

	| newLabel |
	newLabel := FillInTheBlank
		request:
'Enter a new label for this button'
		initialAnswer: self label.
	newLabel isEmpty ifFalse: [self label: newLabel font: nil].
! !


!ScriptableButton methodsFor: 'miscellaneous' stamp: 'dgd 9/6/2003 17:37'!
initializeToStandAlone
	super initializeToStandAlone.
	self borderWidth: 1;
		borderColor: Color black;
		useRoundedCorners;
		color: Color yellow;
		label: 'Press me' translated! !


!ScriptableButton methodsFor: 'script' stamp: 'yo 2/10/2005 20:09'!
editButtonsScript
	"The user has touched my Scriptor halo-handle.  Bring up a Scriptor on the script of the button."

	| cardsPasteUp cardsPlayer anEditor |
	cardsPasteUp := self pasteUpMorph.
	(cardsPlayer := cardsPasteUp assuredPlayer) assureUniClass.
	anEditor := scriptSelector ifNil: 
					[scriptSelector := cardsPasteUp scriptSelectorToTriggerFor: self.
					cardsPlayer newTextualScriptorFor: scriptSelector.
					cardsPlayer scriptEditorFor: scriptSelector
					]
				ifNotNil: 
					[(cardsPlayer class selectors includes: scriptSelector) 
						ifTrue: [cardsPlayer scriptEditorFor: scriptSelector]
						ifFalse: 
							["Method somehow got removed; I guess we start afresh"

							scriptSelector := nil.
							^self editButtonsScript]].
	anEditor showingMethodPane ifTrue: [anEditor toggleWhetherShowingTiles].
	self currentHand attachMorph: anEditor! !

!ScriptableButton methodsFor: 'script' stamp: 'yo 2/10/2005 20:04'!
isLikelyRecipientForMouseOverHalos

	self player ifNil: [^ false].
	self player getHeading = 0.0 ifTrue: [^ false].
	^ true.
! !


!ScriptableButton methodsFor: 'thumbnail' stamp: 'sw 10/30/2000 16:07'!
demandsThumbnailing
	"Answer whether the receiver, if in a thumbnailable parts bin, wants to be thumbnailed whether or not size requires it.  This is set to true here because the recent event rework somehow made it possible for a scriptable button to be draggable from a parts bin otherwise, maddeningly"

	^ true! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ScriptableButton class
	instanceVariableNames: ''!

!ScriptableButton class methodsFor: 'authoring prototype' stamp: 'dgd 9/6/2003 17:38'!
authoringPrototype
	"Answer a scriptable button that can serve as a prototype for a parts bin"

	^ super authoringPrototype
		borderWidth: 1;
		borderColor: Color black;
		useRoundedCorners;
		color: Color yellow;
		label: 'Press me' translated;
		setNameTo: ('script{1}' translated format: {'1'});
		yourself

"ScriptableButton authoringPrototype openInHand"! !


!ScriptableButton class methodsFor: 'class initialization' stamp: 'asm 4/11/2003 10:56'!
initialize

	self registerInFlapsRegistry.	! !

!ScriptableButton class methodsFor: 'class initialization' stamp: 'asm 4/11/2003 10:58'!
registerInFlapsRegistry
	"Register the receiver in the system's flaps registry"
	self environment
		at: #Flaps
		ifPresent: [:cl | cl registerQuad: #(ScriptableButton		authoringPrototype	'Button' 		'A Scriptable button')
						forFlapNamed: 'PlugIn Supplies'.
						cl registerQuad: #(ScriptableButton		authoringPrototype	'Button' 		'A Scriptable button')
						forFlapNamed: 'Scripting'.
						cl registerQuad: #(ScriptableButton		authoringPrototype		'Scriptable Button'	'A button whose script will be a method of the background Player')
						forFlapNamed: 'Stack Tools'.
						cl registerQuad: #(ScriptableButton		authoringPrototype	'Button' 		'A Scriptable button')
						forFlapNamed: 'Supplies'.]! !

!ScriptableButton class methodsFor: 'class initialization' stamp: 'asm 4/11/2003 12:40'!
unload
	"Unload the receiver from global registries"

	self environment at: #Flaps ifPresent: [:cl |
	cl unregisterQuadsWithReceiver: self] ! !


!ScriptableButton class methodsFor: 'name' stamp: 'nk 8/23/2004 18:12'!
descriptionForPartsBin
	^ self partName:	'Button'
		categories:		#('Scripting' 'Basic')
		documentation:	'A button to use with tile scripting; its script will be a method of its containing playfield'! !


!ScriptableButton class methodsFor: 'printing' stamp: 'sw 10/30/2000 10:29'!
defaultNameStemForInstances
	"Answer the default name stem to use for instances of the receiver"

	^ 'button'! !


!ScriptableButton class methodsFor: 'scripting' stamp: 'sw 9/26/2001 04:26'!
additionsToViewerCategories
	"Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."

	^ #((button (

			(slot label 'The wording on the button' String readWrite Player getLabel Player setLabel:)
			(slot color 'The color of the object' Color readWrite Player getColor  Player  setColor:)
			(slot height  'The height' Number readWrite Player getHeight  Player  setHeight:) 
			(slot borderColor 'The color of the object''s border' Color readWrite Player getBorderColor Player  setBorderColor:)
			(slot borderWidth 'The width of the object''s border' Number readWrite Player getBorderWidth Player setBorderWidth:)
			(slot  height  'The height' Number readWrite Player getHeight  Player  setHeight:)
			(slot roundedCorners 'Whether corners should be rounded' Boolean readWrite Player getRoundedCorners Player setRoundedCorners:) 
			(slot actWhen 'When the script should fire' ButtonPhase  readWrite Player getActWhen Player setActWhen: ))))! !


ScriptableButton initialize!