'From etoys4.0 of 5 November 2008 [latest update: #2326] on 4 October 2009 at 1:29:56 am'!
"Change Set:		suffixArrowTweak-sw
Date:			4 October 2009
Author:			Scott Wallace

Fix for the follow-on issue in the reopened version of SQ-450 missing expand-arrows.

Now deals with the special case of a bearing-to or distance-to tile being dropped into a TEST pane."!


!CategoryViewer methodsFor: 'support' stamp: 'sw 10/4/2009 01:29'!
booleanPhraseFromPhrase: phrase
	"Answer, if possible, a boolean-valued phrase derived from the phrase provided"

	|  retrieverOp retrieverTile |
	(phrase isKindOf: ParameterTile orOf: FunctionTile) ifTrue: [^ phrase booleanComparatorPhrase].

	phrase isBoolean ifTrue: [^ phrase].
	((scriptedPlayer respondsTo: #costume) 
		and:[scriptedPlayer costume isInWorld not]) ifTrue: [^ Array new].

	((phrase isMemberOf: PhraseTileMorph) and: [phrase submorphs size > 1] and: [#(bearingTo: distanceToPlayer:) includes: phrase submorphs second operatorOrExpression])
		ifTrue:
			[^ self booleanPhraseFromNumericGetterWithArgument: phrase].

	((retrieverTile _ phrase submorphs last) isKindOf: TileMorph) ifFalse: [^ phrase].
	retrieverOp _ retrieverTile operatorOrExpression.

	(Vocabulary vocabularyForType: phrase resultType)
		affordsCoercionToBoolean ifTrue: [
			retrieverOp =  #getPatchValueIn: ifTrue: [
				^ self booleanPhraseForGetPatchValueOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
			].
			retrieverOp =  #getRedComponentIn: ifTrue: [
				^ self booleanPhraseForGetColorComponentOfType: phrase resultType componentName: #red  retrieverOp: retrieverOp player: phrase actualObject.
			].
			retrieverOp =  #getGreenComponentIn: ifTrue: [
				^ self booleanPhraseForGetColorComponentOfType: phrase resultType componentName: #green  retrieverOp: retrieverOp player: phrase actualObject.
			].
			retrieverOp =  #getBlueComponentIn: ifTrue: [
				^ self booleanPhraseForGetColorComponentOfType: phrase resultType componentName: #blue retrieverOp: retrieverOp player: phrase actualObject.
			].
			retrieverOp = #getUphillIn: ifTrue: [
				^ self booleanPhraseForGetUpHillOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
			].
			retrieverOp = #getDistanceTo: ifTrue: [
				^ self booleanPhraseForGetDistanceToOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
			].
			retrieverOp = #getAngleTo: ifTrue: [
				^ self booleanPhraseForGetAngleToOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
			].
			retrieverOp = #bounceOn: ifTrue: [
				^ self booleanPhraseForBounceOnOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
			].
"			(retrieverOp = #bounceOn:color: or: [retrieverOp = #bounceOnColor:]) ifTrue: [
				^ self booleanPhraseForBounceOnColorOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
			]."
			"retrieverOp = #getTurtleAt: ifTrue: [
				^ self booleanPhraseForGetTurtleAtOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
			]."
			retrieverOp = #getTurtleOf: ifTrue: [
				^ self booleanPhraseForGetTurtleOfOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
			].

			^ self booleanPhraseForRetrieverOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.

		].
	^ phrase! !

!CategoryViewer methodsFor: 'as yet unclassified' stamp: 'sw 10/4/2009 01:23'!
booleanPhraseFromNumericGetterWithArgument: phrase 
	"Answer a morph derived from the incoming phrase, a bearingTo: or distanceToPlayer: phrase, which will be suitable for dropping into a TEST area. "

	
	| outerPhrase  rel finalTile |
	rel := Vocabulary numberVocabulary comparatorForSampleBoolean.
	outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: #Number argType: #Number.

	outerPhrase firstSubmorph addMorph: phrase.
	outerPhrase firstSubmorph changeTableLayout.
	finalTile _ ScriptingSystem tileForArgType: #Number.	"comes with arrows"
	outerPhrase submorphs last addMorph: finalTile.
	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel). 
	^ outerPhrase! !