'From Squeakland 3.8.5976 of 25 August 2004 [latest update: #388] on 17 February 2005 at 4:58:49 pm'!
"Change Set:		OtherTranslationFixes2
Date:			17 February 2005
Author:			Yoshiki Ohshima

Misc fixes to make it better."!


!Morph methodsFor: 'menus' stamp: 'yo 2/17/2005 16:58'!
setArrowheads
	"Let the user edit the size of arrowheads for this object"

	| aParameter result  |
	aParameter _ self renderedMorph valueOfProperty:  #arrowSpec ifAbsent:
		[Preferences parameterAt: #arrowSpec ifAbsent: [5 @ 4]].
	result _ Morph obtainArrowheadFor: 'Head size for arrowheads: ' translated defaultValue: aParameter asString.
	result ifNotNil:
			[self renderedMorph  setProperty: #arrowSpec toValue: result]
		ifNil:
			[Beeper beep]! !

!Morph methodsFor: 'meta-actions' stamp: 'yo 2/12/2005 15:25'!
indicateAllSiblings
	"Indicate all the receiver and all its siblings by flashing momentarily."

	| aPlayer allBoxes |
	(aPlayer _ self topRendererOrSelf player) belongsToUniClass ifFalse: [^ self "error: 'not uniclass'"].
	allBoxes _ aPlayer class allInstances
		select: [:m | m costume world == ActiveWorld]
		thenCollect: [:m | m costume boundsInWorld].

	5 timesRepeat:
		[Display flashAll: allBoxes andWait: 120]! !


!HaloMorph methodsFor: 'private' stamp: 'yo 2/12/2005 19:24'!
addDirectionHandles

	| centerHandle d w directionShaft patch patchColor crossHairColor |
	self showingDirectionHandles ifFalse: [^ self].

	directionArrowAnchor _ (target point: target referencePosition in: self world) rounded.
	patch _ target imageFormForRectangle: (Rectangle center: directionArrowAnchor extent: 3@3).
	patchColor _ patch colorAt: 1@1.

	(directionShaft _ LineMorph newSticky makeForwardArrow)
		borderWidth: 2; borderColor: (Color green orColorUnlike: patchColor).
	self positionDirectionShaft: directionShaft.
	self addMorphFront: directionShaft.
	directionShaft setCenteredBalloonText: 'Set forward direction' translated;
		on: #mouseDown send: #doDirection:with: to: self;
		on: #mouseMove send: #trackDirectionArrow:with: to: self;
		on: #mouseUp send: #setDirection:with: to: self.

	d _ 15.  "diameter"  w _ 3.  "borderWidth"
	crossHairColor _ Color red orColorUnlike: patchColor.
	(centerHandle _ EllipseMorph newBounds: (0@0 extent: d@d) color: Color transparent)
			borderWidth: w; borderColor: (Color blue orColorUnlike: patchColor);
			addMorph: (LineMorph from: (d//2)@w to: (d//2)@(d-w-1) color: crossHairColor width: 1) lock;
			addMorph: (LineMorph from: w@(d//2) to: (d-w-1)@(d//2) color: crossHairColor width: 1) lock;
			align: centerHandle bounds center with: directionArrowAnchor.
	self addMorph: centerHandle.
	centerHandle setCenteredBalloonText: 'Set rotation center' translated;
			on: #mouseDown send: #prepareToTrackCenterOfRotation:with: to: self;
			on: #mouseMove send: #trackCenterOfRotation:with: to: self;
			on: #mouseUp send: #setCenterOfRotation:with: to: self
! !


!PasteUpMorph methodsFor: 'misc' stamp: 'yo 2/17/2005 16:58'!
mouseX
	"Answer the x-coordinate of the mouse, in my coordinate system"

	^ self isInWorld
		ifTrue:
			[((self pointFromWorld: self cursorPoint) x) - self cartesianOrigin x]
		ifFalse:
			[0]! !

!PasteUpMorph methodsFor: 'misc' stamp: 'yo 2/17/2005 16:58'!
mouseY
	"Answer the y-coordinate of the mouse, in my coordinate system"

	^ self isInWorld
		ifTrue:
			[self cartesianOrigin y - ((self pointFromWorld: self cursorPoint) y)]
		ifFalse:
			[0]! !


!Player methodsFor: 'scripts-kernel' stamp: 'yo 2/12/2005 19:53'!
addIdiosyncraticMenuItemsTo: aMenu forSlotSymol: slotSym
	"The menu provided has the receiver as its argument, and is used as the menu for the given slot-symbol in a line of a Viewer.  Add special-case items"

	(#(copy getNewClone newClone) includes: slotSym) ifTrue:
		[aMenu add: 'give me a copy now' translated action: #handTheUserACopy].

"	(slotSym == #dropShadow) ifTrue:
		[aMenu add: 'set shadow offset' translated action: #setShadowOffset].

	(slotSym == #useGradientFill) ifTrue:
		[aMenu add: 'set gradient origin...' translated action: #setGradientOffset.
		aMenu add: 'set gradient direction...' translated action: #setGradientDirection]."
! !

!Player methodsFor: 'slot getters/setters' stamp: 'yo 2/12/2005 20:18'!
getMouseX
	^ self costume renderedMorph mouseX! !

!Player methodsFor: 'slot getters/setters' stamp: 'yo 2/12/2005 20:26'!
getMouseY
	^ self costume renderedMorph mouseY.
! !

!Player methodsFor: 'slots-user' stamp: 'yo 2/12/2005 18:58'!
fancyWatcherFor: aGetter
	"Anser a labeled readout for viewing a value textuallyi"

	| aWatcher aColor aLine itsName aSelector aLabel |
	aWatcher _ self unlabeledWatcherFor: aGetter.
	aColor _ Color r: 0.387 g: 0.581 b: 1.0.
	aLine _ WatcherWrapper newRow.
	aLine player: self variableName: (aSelector _ Utilities inherentSelectorForGetter: aGetter).
	itsName _ aWatcher externalName.
	aWatcher setNameTo: 'readout'.
	aLine addMorphFront: (self tileReferringToSelf
				borderWidth: 0; layoutInset: 4@0;
				typeColor: aColor; 
				color: aColor; bePossessive).
	aLabel _ StringMorph contents: aSelector translated, ' = ' font: ScriptingSystem fontForTiles.
	aLabel setProperty: #watcherLabel toValue: true.
	aLine addMorphBack: aLabel.
	aLine addMorphBack: aWatcher.
	aLine setNameTo: itsName.

	^ aLine! !

!Player methodsFor: 'slots-user' stamp: 'yo 2/12/2005 20:09'!
offerGetterTiles: slotName 
	"For a player-type slot, offer to build convenient compound tiles that otherwise would be hard to get"

	| typeChoices typeChosen thePlayerThereNow slotChoices slotChosen getterTiles aCategoryViewer playerGetter |
	typeChoices := Vocabulary typeChoices.
	typeChosen := (SelectionMenu labelList: (typeChoices collect: [:t | t translated]) lines: #() selections: typeChoices) 
				startUpWithCaption: ('Choose the TYPE
of data to get from
{1}''s {2}' translated format: {self externalName. slotName translated}).
	typeChosen isEmptyOrNil ifTrue: [^self].
	thePlayerThereNow := self perform: (Utilities getterSelectorFor: slotName).
	thePlayerThereNow 
		ifNil: [thePlayerThereNow := self presenter standardPlayer].
	slotChoices := thePlayerThereNow slotNamesOfType: typeChosen.
	slotChoices isEmpty 
		ifTrue: [^self inform: 'sorry -- no slots of that type' translated].
	slotChoices _ slotChoices asSortedArray.
	slotChosen := (SelectionMenu labelList: (slotChoices collect: [:t | t translated]) selections: slotChoices) 
				startUpWithCaption: ('Choose the datum
you want to extract from {1}''s {2}' translated format: {self externalName. slotName translated}).
	slotChosen isEmptyOrNil ifTrue: [^self].
	"Now we want to tear off tiles of the form
		holder's valueAtCursor's foo"
	getterTiles := nil.
	aCategoryViewer := CategoryViewer new initializeFor: thePlayerThereNow
				categoryChoice: 'basic'.
	getterTiles := aCategoryViewer 
				getterTilesFor: (Utilities getterSelectorFor: slotChosen)
				type: typeChosen.
	aCategoryViewer := CategoryViewer new initializeFor: self
				categoryChoice: 'basic'.
	playerGetter := aCategoryViewer 
				getterTilesFor: (Utilities getterSelectorFor: slotName)
				type: #Player.
	getterTiles submorphs first acceptDroppingMorph: playerGetter event: nil.	"the pad"	"simulate a drop"
	getterTiles makeAllTilesGreen.
	getterTiles justGrabbedFromViewer: false.
	(getterTiles firstSubmorph)
		changeTableLayout;
		hResizing: #shrinkWrap;
		vResizing: #spaceFill.
	ActiveHand attachMorph: getterTiles! !

!Player methodsFor: 'viewer' stamp: 'yo 2/11/2005 15:48'!
infoFor: anElement inViewer: aViewer 
	"The user made a gesture asking for info/menu relating"

	| aMenu elementType aSelector |
	elementType := self elementTypeFor: anElement
				vocabulary: aViewer currentVocabulary.
	elementType = #systemSlot | (elementType == #userSlot) 
		ifTrue: [^self slotInfoButtonHitFor: anElement inViewer: aViewer].
	aMenu := MenuMorph new defaultTarget: self.
	aMenu defaultTarget: self.
	aSelector := anElement asSymbol.
	elementType == #userScript 
		ifTrue: 
			[aMenu 
				add: 'destroy "' translated , anElement , '"'
				selector: #removeScriptWithSelector:
				argument: aSelector.
			aMenu 
				add: 'rename  "' translated, anElement , '"'
				selector: #renameScript:
				argument: aSelector.
			aMenu 
				add: 'textual scripting pane' translated
				selector: #makeIsolatedCodePaneForSelector:
				argument: aSelector.
			aSelector numArgs > 0 
				ifTrue: 
					[aMenu 
						add: 'remove parameter' translated
						selector: #ceaseHavingAParameterFor:
						argument: aSelector]
				ifFalse: 
					[aMenu 
						add: 'add parameter' translated
						selector: #startHavingParameterFor:
						argument: aSelector.
					aMenu 
						add: 'button to fire this script' translated
						selector: #tearOffButtonToFireScriptForSelector:
						argument: aSelector].
			aMenu 
				add: 'edit balloon help' translated
				selector: #editDescriptionForSelector:
				argument: aSelector].
	aMenu 
		add: 'show categories....' translated
		target: aViewer
		selector: #showCategoriesFor:
		argument: aSelector.
	aMenu items isEmpty 
		ifTrue: 
			["Never 0 at the moment because of show categories addition"

			aMenu add: 'ok' translated action: nil].
	aMenu addTitle: anElement asString , ' (' , elementType translated , ')'.
	aMenu popUpInWorld: aViewer world! !


!Project methodsFor: 'SuperSwiki' stamp: 'yo 2/12/2005 19:25'!
tellAFriend: emailAddressOrNil
	| urlForLoading |
"
Project current tellAFriend
"

	(urlForLoading _ self urlForLoading) ifNil: [
		urlForLoading _ self url		"fallback for dtp servers"
	].
	urlForLoading isEmptyOrNil ifTrue: [
		^self inform: 'Since this project has not been saved yet,
I cannot tell someone where it is.' translated
	].
	HTTPClient tellAFriend: emailAddressOrNil url: urlForLoading name: self name! !


!SketchMorph methodsFor: 'menu' stamp: 'yo 2/12/2005 19:11'!
addBorderToShape: evt
	| str borderWidth borderedForm r |
	str _ FillInTheBlank
		request: 'Please enter the desired border width' translated
		initialAnswer: '0'.
	borderWidth _ Integer readFrom: (ReadStream on: str).
	(borderWidth between: 1 and: 10) ifFalse: [^ self].

	"Take care of growing appropriately.  Does this lose the reg point?"
	borderedForm _ originalForm shapeBorder: Color black width: borderWidth.
	r _ borderedForm rectangleEnclosingPixelsNotOfColor: Color transparent.
	self form: (borderedForm copy: r).
! !

!SketchMorph methodsFor: 'menu' stamp: 'yo 2/12/2005 19:08'!
recolorPixelsOfColor: evt
	"Let the user select a color to be remapped, and then a color to map that color to, then carry it out."

	| c d newForm map newC |
	self inform: 'choose the color you want to replace' translated.
	self changeColorTarget: self selector: #rememberedColor: originalColor: nil hand: evt hand.   "color to replace"
	c _ self rememberedColor ifNil: [Color red].
	self inform: 'now choose the color you want to replace it with' translated.
	self changeColorTarget: self selector:  #rememberedColor: originalColor: c hand: evt hand.  "new color"
	newC _ self rememberedColor ifNil: [Color blue].
	d _ originalForm depth.
	newForm _ Form extent: originalForm extent depth: d.
	map _ (Color cachedColormapFrom: d to: d) copy.
	map at: (c indexInMap: map) put: (newC pixelValueForDepth: d).
	newForm copyBits: newForm boundingBox
		from: originalForm at: 0@0
		colorMap: map.
	self form: newForm.
! !

!SketchMorph methodsFor: 'menu' stamp: 'yo 2/12/2005 19:11'!
reduceColorPalette: evt
	"Let the user ask for a reduced number of colors in this sketch"

	| str nColors |
	str _ FillInTheBlank
		request: 'Please enter a number greater than one.
(note: this cannot be undone, so answer zero
to abort if you need to make a backup first)' translated
		initialAnswer: '256'.
	nColors _ Integer readFrom: (ReadStream on: str).
	(nColors between: 2 and: 256) ifFalse: [^ self].

	originalForm _ originalForm copyWithColorsReducedTo: nColors.
	rotatedForm _ nil.
	self changed! !

!SketchMorph methodsFor: 'menu' stamp: 'yo 2/12/2005 19:04'!
setRotationStyle
	| selections labels sel reply |
	selections _ #(normal leftRight upDown none).
	labels _ #('rotate smoothly' 'left-right flip only' 'top-down flip only' 'don''t rotate').
	sel _ labels at: (selections indexOf: self rotationStyle ifAbsent:[1]).
	labels _ labels collect:[:lbl| sel = lbl ifTrue:['<on>', lbl translated] ifFalse:['<off>', lbl translated]].
	reply _ (SelectionMenu labelList: labels selections: selections) startUp.
	reply ifNotNil: [self rotationStyle: reply].
! !


!SystemWindow methodsFor: 'initialization' stamp: 'yo 2/12/2005 19:21'!
createCollapseBox
	^ self createBox labelGraphic: self class collapseBoxImage;
		 extent: self boxExtent;
		 actionSelector: #collapseOrExpand;
		 setBalloonText: 'collapse this window' translated.
! !